Employed two different mapping approaches I've used over the years. Also added a button maker, so it will be easier to add buttons to any program I make, in the future.
Pete
Code: (Select All)
Dim Shared mapping
ReDim Shared y_btl(0), y_bbr(0), x_btl(0), x_bbr(0), button$(0), mRow$(0), nob
Rem Input "Choose a button mapping method 1 or 2: ", mapping
If mapping <> 2 Then mapping = 0
_KeyClear
Palette 5, 63
Color 0, 5: Cls
a$ = " Button 1 ": button_maker a$, 10, 51
a$ = " Button 2 ": button_maker a$, 10, 66
a$ = " Button 3 ": button_maker a$, 15, 51
a$ = " Button 4 ": button_maker a$, 15, 66
PCopy 0, 1
Locate 1, 1
_ControlChr Off
Do
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$()
If drag Then
If olddrag <> drag Then
If drag > 0 Then Print "Drag Right. Status ="; Else Print "Drag Left. Status = ";
Print drag
olddrag = drag
End If
Else
olddrag = 0
End If
If oldlb <> lb Then
Select Case lb
Case 0: Print "Left Button Up - Button Status ="; lb
Case -1: Print "Left Button Down - Button Status = "; lb
Case 1: Print "Left Button Pressed - Button Status ="; lb
Case 2: Print "Left Button Released - Button Status ="; lb
End Select
If lb = 0 Then Print "Number of clicks ="; clkcnt
End If
If oldmb <> mb Then
Select Case mb
Case 0: Print "Middle Button Up - Button Status ="; mb
Case -1: Print "Middle Button Down - Button Status = "; mb
Case 1: Print "Middle Button Pressed - Button Status ="; mb
Case 2: Print "Middle Button Released - Button Status ="; mb
End Select
End If
If oldrb <> rb Then
Select Case rb
Case 0: Print "Right Button Up - Button Status ="; rb
Case -1: Print "Right Button Down - Button Status = "; rb
Case 1: Print "Right Button Pressed - Button Status ="; rb
Case 2: Print "Right Button Released - Button Status ="; rb
End Select
End If
If oldmw <> mw Then
If mw < 0 Then Print "Mouse Wheel Up - Wheel Status ="; mw
If mw > 0 Then Print "Mouse Wheel Down - Wheel Status ="; mw
End If
If oldalt% <> alt% Then
If alt% < 0 Then Print "Alt Button Down" Else Print "Alt Button Released"
End If
If oldctrl% <> ctrl% Then
If ctrl% < 0 Then Print "Ctrl Button Down" Else Print "Ctrl Button Released"
End If
If oldshift% <> shift% Then
If shift% < 0 Then Print "Shift Button Down" Else Print "Shift Button Released"
End If
If oldalt <> alt And alt < 0 Then
Print "Alt Key Pressed";
If AltToggle Then Print " / Alt Toggle Status: On" Else Print " / Alt Toggle Status: Off"
End If
If k& < 0 Then oldb$ = ""
Select Case Len(b$)
Case 1
If oldb$ <> b$ Then Print "You Pressed: ";: x = CVI(MKI$(Asc(b$))): Print Chr$(x); " Chr$(" + LTrim$(Str$(x)) + ")"
oldb$ = b$
Case 2
If oldb$ <> b$ Then Print "You Pressed: "; "nul + " + LTrim$(Str$(Asc(Mid$(b$, 2, 1)))) + " Chr$(0) + " + Chr$(34) + Mid$(b$, 2, 1) + Chr$(34)
oldb$ = b$
End Select
oldlb = lb: oldrb = rb: oldmb = mb: oldmw = mw: oldalt% = alt%: oldctrl% = ctrl%: oldshift% = shift%: oldalt = alt
If CsrLin > _Height - 2 Then Cls: PCopy 1, 0
Loop
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$())
Dim As Integer b_hover, i, oldmw
Static As Integer oldmy, oldmx, hover, mwy, oldmwy, b_active
Static z1 As Single
_Limit 60
If alt Then alt = 0
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Exit Sub
Else
k& = _KeyHit
If k& = 100307 Or k& = 100308 Then
alt = -1
AltToggle = 1 - AltToggle
Exit Sub
End If
If k& > 0 Then
b$ = MKI$(k&)
If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and alt.
If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
Else
b$ = ""
End If
End If
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1
Else
lb = 0
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel
Wend
my = _MouseY
mx = _MouseX
b_hover = 0
If mapping Then
If Len(mRow$(my)) Then
If Mid$(mRow$(my), mx, 1) <> Chr$(32) Then
b_hover = Asc(Mid$(mRow$(my), mx, 1)) - 96
End If
End If
Else
For i = 1 To nob ' number of buttons.
If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then
b_hover = i
Exit For
End If
Next
End If
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0
If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1 Else If ctrl% Then ctrl% = 0
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1 Else If alt% Then alt% = 0
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1: z1 = Timer
clkcnt = clkcnt + 1
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
Do
If b_active Then
If b_hover Then
If lb = 1 Or lb = 0 Then ' Button clicked. Flash effect.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
If lb = 1 Then Color 1, 5 Else Color 9, 5
j = Len(button$(b_active))
Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x_btl(b_active): Print Chr$(192) + String$(j, 196) + Chr$(217);
Rem Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);
Color c1, c2
Locate s1, s2
End If
Else
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
Color 8, 5
j = Len(button$(b_active))
Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x_btl(b_active): Print Chr$(192) + String$(j, 196) + Chr$(217);
Rem Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);
Color c1, c2
Locate s1, s2
b_active = 0
End If
Exit Do
Else
If b_hover And oldmy <> 0 And b_active = 0 Then
b_active = b_hover
Else
Exit Do
End If
End If
Loop
oldmy = my: oldmx = mx
End Sub
Sub cal_mapit (a$, mapid)
Static initiate As Integer, mapnbr As Integer
If initiate = 0 Then
initiate = 1
ReDim mRow$(_Height)
mapnbr = 96
End If
If mRow$(CsrLin) = "" Then mRow$(CsrLin) = Space$(_Width)
Select Case mapid
Case 1
mapnbr = mapnbr + 1 ' Advance.
y_btl(mapnbr - 96) = CsrLin: x_btl(mapnbr - 96) = Pos(0)
Case 2
y_bbr(mapnbr - 96) = CsrLin: x_bbr(mapnbr - 96) = Pos(0) + Len(a$)
Case 3
mapnbr = mapnbr + 1 ' Advance.
y_bbr(mapnbr - 96) = y_btl(mapnbr - 96)
x_bbr(mapnbr - 96) = Pos(0)
Color 15, 1
Case 4
Color 1, 5
End Select
Mid$(mRow$(CsrLin), Pos(0)) = String$(Len(a$), Chr$(mapnbr))
Print a$;
End Sub
Sub button_maker (a$, y, x)
Static btnnbr
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(a$)
btnnbr = btnnbr + 1
ReDim _Preserve y_btl(btnnbr), x_btl(btnnbr), y_bbr(btnnbr), x_bbr(btnnbr), button$(btnnbr)
button$(btnnbr) = String$(j, 0) ' Fill any spaces with the null character.
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(a$))) \ 2) = _Trim$(a$)
If y > 0 Then
Color 8, 5
Locate y - 1, x - 1
a$ = Chr$(218) + String$(j, 196) + Chr$(191): cal_mapit a$, 1
Locate y, x - 1: a$ = Chr$(179): cal_mapit a$, 0: Locate , Pos(0) + j: a$ = Chr$(179): cal_mapit a$, 0
Locate y + 1, x - 1: a$ = Chr$(192) + String$(j, 196) + Chr$(217): cal_mapit a$, 2
Locate y, x: a$ = button$(btnnbr): cal_mapit a$, 0
Else
y = Abs(y)
Locate y - 1, x: a$ = String$(j, Chr$(220)): cal_mapit a$, 4
Locate y, x: a$ = button$(btnnbr): cal_mapit a$, 3
Locate y + 1, x: a$ = String$(j, Chr$(223)): cal_mapit a$, 4
End If
nob = btnnbr ' Number of buttons becomes a global variable here.
Color c1, c2
Locate y, x
End SubPete