@bplus
Thanks! The routine does take into account vertical as well as horizontal drag movement, but maybe I'm not understanding your question correctly. Let's apply the mouse routine to a cheap-ASCII chess example. I made CHR$(219) a queen and lets drag her all around SCREEN 0!
I know, I miss the days when CHR$(219) was a king, but now it's a drag queen, oh well.
Pete
Thanks! The routine does take into account vertical as well as horizontal drag movement, but maybe I'm not understanding your question correctly. Let's apply the mouse routine to a cheap-ASCII chess example. I made CHR$(219) a queen and lets drag her all around SCREEN 0!
Code: (Select All)
Type mousevar
mx As Integer ' Row.
my As Integer ' Column.
wh As Integer ' Wheel.
lb_status As Integer ' Left Button Status.
rb_status As Integer ' Right Button Status.
mb_status As Integer ' Middle Button Status.
click As Integer ' Number of timed left button clicks.
CursorStyle As Integer ' 0 Default, 1 Link style. (Hand).
mousekey As String ' Auto Keyboard Input.
End Type
Dim m As mousevar
i = 3: j = 1: a$ = "None" ' Seed.
piece_y = _Height \ 2: piece_x = _Width \ 2
Locate piece_y, piece_x: Print Chr$(219);
Do
_Limit 60
If j > 80 Then i = i + 1: j = 1: If i > 24 Then End
Select Case m.click
Case 1: a$ = "Single": If m.lb_status = 2 Then a$ = "Drag"
Case 2: a$ = "Double"
Case 3: a$ = "Triple"
End Select
Select Case m.wh
Case 0: b$ = "--"
Case 1: b$ = "Dn"
Case -1: b$ = "Up"
End Select
Locate 1, 3: Print "Row:"; m.my;: Locate 1, 11: Print "Col:"; m.mx;
Locate 1, 23: Print "Lt:"; m.lb_status; " Rt:"; m.rb_status; " Md:"; m.mb_status; " Whl: "; b$; " Last Left Click: "; a$; " ";
mouse m
If m.my = piece_y And m.mx = piece_x Then
_MouseShow "LINK"
Else
If mb.lb_status <> 2 Then _MouseShow "DEFAULT"
End If
Select Case m.lb_status
Case 1
If m.my = piece_y And m.mx = piece_x Then move = 1
Case 2
If move Then ' Drag.
Locate piece_y, piece_x: Print " ";
Locate m.my, m.mx: Print Chr$(219);
piece_y = m.my: piece_x = m.mx
End If
Case -2
move = 0 ' Button released. Drag event over.
End Select
Loop
Sub mouse (m As mousevar)
' Local vars: i%, j%, k%, button_active, button_status
Static As Integer oldmx, oldmy, button_active, last_active, button_status
Static As Long mtimer
If m.wh Then m.wh = 0
While _MouseInput
m.wh = m.wh + _MouseWheel
Wend
m.mx = _MouseX
m.my = _MouseY
i% = _MouseButton(1)
j% = _MouseButton(2)
k% = _MouseButton(3)
If i% And button_active = 0 Then
button_active = 1 ' Left button pressed.
ElseIf j% And button_active = 0 Then
button_active = 2 ' Right button pressed.
ElseIf k% And button_active = 0 Then
button_active = 3 ' Middle button pressed.
ElseIf button_active And i% + j% + k% = 0 Then
button_active = 0
End If
Select Case button_active
Case 0
Select Case button_status
Case -2
button_status = 0 ' The clicked event and the release triggered any event structured to occur on release.
Case -1
button_status = -2 ' The clicked event triggered any event structured to occur when the button is released.
Case 0
' Button has not been pressed yet.
Case 1
button_status = -1 ' Rare but button was released before the next required cycle, so cycle is continued here.
Case 2
button_status = -2 ' The drag event is over because the button was released.
End Select
Case Else
Select Case button_status ' Note drag is determined in the text highlighting routine.
Case -1
' An event occurred and the button is still down.
If button_active = 1 Then ' Only left button for drag events.
If oldmx <> m.mx Or oldmy <> m.my Then
button_status = 2 ' Drag.
End If
End If
Case 0
button_status = 1 ' Button just pressed.
If m.click = 0 And button_active = 1 Then
mtimer = Timer + .75
If mtimer > 86400 Then mtimer = mtimer - 86400 ' Midnight correction.
End If
m.click = Abs(m.click) + 1
Case 1
button_status = -1 ' The button is down and triggered any event structured to occur on initial press. The status will remain -1 as long as the button is depressed.
End Select
End Select
m.lb_status = 0: m.rb_status = 0: m.mb_status = 0 ' Left button was released so drag is over.
Select Case button_active
Case 0
Select Case last_active
Case 1: m.lb_status = button_status
Case 2: m.rb_status = button_status
Case 3: m.mb_status = button_status
End Select
Case 1 ' Left
m.lb_status = button_status
If Abs(m.click) And button_status < 1 Then m.click = -Abs(m.click) Else m.click = Abs(m.click)
Case 2 ' Right
m.rb_status = button_status
Case 3 ' Middle
m.mb_status = button_status
End Select
If Timer > mtimer Then m.click = 0
oldmx = m.mx: oldmy = m.my: last_active = button_active
End SubI know, I miss the days when CHR$(219) was a king, but now it's a drag queen, oh well.
Pete