Login

***Pete*** · Yesterday, 05:05 PM

I thought I'd put this in a demo for @bplus to have a look at the mouse function. I want to add my other mapping routine as an option. This one uses arrays. Basically my goal is to pack as many methods and actions as I use in many of my apps into this one subroutine, if possible.

Demo: Press keys, hold keys like ctrl, click mouse, use wheel, hover/click buttons, drag, etc.

Code: (Select All)

ReDim Shared y_btl(2), y_bbr(2), x_btl(2), x_bbr(2), button$(2)

nob = 2

Color 15, 1

If mapping = 0 Then

    Locate 10, 50: y_btl(1) = CsrLin: x_btl(1) = Pos(0): Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 50: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    Locate 12, 50: Print Chr$(192) + String$(10, 196) + Chr$(217);: y_bbr(1) = CsrLin: x_bbr(1) = Pos(0) - 1

    button$(1) = " Button 1 "

    Locate 11, 51: Print " Button 1 ";



    Locate 10, 65: y_btl(2) = CsrLin: x_btl(2) = Pos(0): Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 65: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    Locate 12, 65: Print Chr$(192) + String$(10, 196) + Chr$(217);: y_bbr(2) = CsrLin: x_bbr(2) = Pos(0) - 1

    button$(2) = " Button 2 "

    Locate 11, 66: Print " Button 2 ";

Else

    Locate 10, 50: Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 50: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    button$(1) = " Button 1 "

    Locate 12, 50: Print Chr$(192) + String$(10, 196) + Chr$(217)

    Locate 11, 51: Print " Button 1 ";



    Locate 10, 65: Print Chr$(218) + String$(10, 196) + Chr$(191)

    Locate 11, 65: Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179);

    Locate 12, 65: Print Chr$(192) + String$(10, 196) + Chr$(217)

    button$(2) = " Button 2 "

    Locate 11, 66: Print " Button 2 ";

End If

PCopy 0, 1

Color 7, 0

Locate 1, 1

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

    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

    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

    If b_active Then

        If b_hover Then

            If lb = 2 Then ' Button clicked. Flash effect.

                s1 = CsrLin: s2 = Pos(0)

                c1 = _DefaultColor: c2 = _BackgroundColor

                For i = 1 To 2

                    If i = 1 Then Color 15, 1 Else Color 1, 3

                    Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(10, 196) + Chr$(191)

                    Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)

                    Locate , x_btl(b_active): Print Chr$(192) + String$(10, 196) + Chr$(217);

                    Locate y_btl(b_active) + 1, x_btl(b_active) + 1: Print button$(b_active);

                    Color c1, c2

                    Locate s1, s2

                    _Delay .1

                Next

            End If

        Else

            s1 = CsrLin: s2 = Pos(0)

            c1 = _DefaultColor: c2 = _BackgroundColor

            Color 15, 1

            Locate y_btl(b_active), x_btl(b_active): Print Chr$(218) + String$(10, 196) + Chr$(191)

            Locate , x_btl(b_active): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)

            Locate , x_btl(b_active): Print Chr$(192) + String$(10, 196) + Chr$(217);

            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

    Else

        If b_hover And oldmy <> 0 Then

            If b_active = 0 Then

                s1 = CsrLin: s2 = Pos(0)

                c1 = _DefaultColor: c2 = _BackgroundColor

                Color 1, 3

                Locate y_btl(b_hover), x_btl(b_hover): Print Chr$(218) + String$(10, 196) + Chr$(191)

                Locate , x_btl(b_hover): Print Chr$(179);: Locate , Pos(0) + 10: Print Chr$(179)

                Locate , x_btl(b_hover): Print Chr$(192) + String$(10, 196) + Chr$(217);

                Locate y_btl(b_hover) + 1, x_btl(b_hover) + 1: Print button$(b_hover);

                Color c1, c2

                Locate s1, s2

                b_active = b_hover

            End If

        End If

    End If

    oldmy = my: oldmx = mx

End Sub

I'll probably switch to type variables before going any further.

Oh, since INKEY$ is very familiar to me, but I get a bit PISSED OFF now and then by its inability to detect press and release without adding a slightly imperfect coding workaround, I decided to migrate to _KEYHIT by using a _KEYHIT to INKEY$ conversion method. Lucky for me I migrated just before Inauguration day, or I might have HIT A WALL on that one!

Pete

bplus · Yesterday, 05:47 PM

@Pete we must be on the same mind frequency (GHM), I just completed 2 Mouse routines last night that I am very happy with myself. I went to Steve's camp and learned about OldMouse. Turns out I had a copy of that, that has been sitting around for years, never got to study it as I did last night.

Yes, to incorp key catching also, or Not? That is a question not quite settled for me, yet. I see you are including.

It's good to be all inclusive, like Canada, Mexico, S America... then they are all US and no reason to build firewalls. How could we possibly make America greater???

If you can have only one tool, let it be a Swiss Army knife.

***Pete*** · Yesterday, 05:52 PM

I had a French Army knife once, but I had to give it up.

Pete Big Grin

Jack002 · 10 hours ago

bplus

maybe I should post this in my own section

or maybe I should try to get this thread back on topic

here is my single blade knife for just getting a mouse click without backfire from not getting clear of mouse button release at next mouse poll or mouse catching missed because a single keydown was not responeded to fast enough and another detection (the same mouse down causes a reverse because my app is toggle a cell on or off. This is same situation that arose in dbox Play demo of Play.

Code: (Select All)
_Title "ClickTF test on grid" ' b+ 2025-01-20 test Steve mouse catch click with OldMouse check

Dim Shared As Long SW, SH

SW = 800: SH = 600

Screen _NewImage(SW, SH, 32): _ScreenMove 210, 60

sq = 100 ' cellsize in pixels 100x100 and xoffset and yoffset

cellsAcross = 6: CellsDown = 4

drawGrid sq, sq, sq, sq, cellsAcross, CellsDown ' OK

' now test clicking the cells

Do

    If ClickTF%(mx, my) Then ' covert mx, my to a grid cell or say not in grid

        gridx = mx \ sq: gridY = my \ sq

        Locate 1, 1: Print Space$(500); ' clear line

        Locate 1, 1: Print gridx; ","; gridY;

        Print _IIf(gridx > 0 And gridx <= cellsAcross And gridY > 0 And gridY <= CellsDown, "inside", "outside");_

         " the grid."

    End If

Loop

Function ClickTF% (mx, my) ' where the mouse button goes down at NOT after any drag!

    Static OldMouse: Dim mb   

    While _MouseInput: Wend ' there we've polled the mouse we don't need to remain inside the loop unless we need mouse wheel

    mb = _MouseButton(1)

    If mb And Not OldMouse Then

        mx = _MouseX: my = _MouseY: ClickTF% = -1

    End If

    OldMouse = mb

End Function

Sub drawGrid (x, y, xs, ys, xn, yn) ' top left x, y, x side, y side, number of x, nmber of y

    Dim As Long i, dx, dy

    dx = xs * xn: dy = ys * yn

    For i = 0 To xn

        Line (x + xs * i, y)-(x + xs * i, y + dy)

    Next

    For i = 0 To yn

        Line (x, y + ys * i)-(x + dx, y + ys * i)

    Next

End Sub

A useful low LOC routine that is portable to many apps eg boards for editing graphics pixel by pixel or tile by tile, or games.

No more hacky! _Delay .25 yea!

bplus · 2 hours ago

BTW @Pete double clicks from your demo seems like needs work.

Login
Username/Email:
Password:	Lost Password?
	Remember me