Updating my Mouse/Keyboard/Buttons/Fields routine.

[SMcNeill]

Line 309 is the glitch.  It's missing a _FREEIMAGE in there:

Code: (Select All)

                    _FreeImage Virtual_KB(Which).Hardware_Handle
                    Virtual_KB(Which).Hardware_Handle = _CopyImage(Virtual_KB(Which).Handle, 33)

We're replacing an old hardware image with a new hardware image, by we never free the old from memory, which is the leak in mem uage that you see. 

[Pete]

We replaced Pete's regular hardware image with new Folger's Crystals. Do you think Pete will notice?

I keep forgetting, you missed out on those good ol' days. Lucky bastard!!!

Pete

[Pete]

Okay, that helped. What is still weird is only the initial keyboard is responsive. All of the other iterations are slow as Biden. (I thought about writing dog shit, but I'm in a really, really bad mood today.) Anyway, all other keyboards run at a steady 450+MB now. No memory leak as before. However, when I caplocks toggle back to the initial keyboard, it goes back down to the 90+MB level, and runs responsively again. Go figure.

Steve, you're scaring me. I'm right in the middle of adding a bunch of variety just like this to my project. I love variety, but I hates the Kamala load of problems it can create.

Pete@CreativeCreations.com

[SMcNeill]

Okay, that helped. What is still weird is only the initial keyboard is responsive. All of the other iterations are slow as Biden. (I thought about writing dog shit, but I'm in a really, really bad mood today.) Anyway, all other keyboards run at a steady 450+MB now. No memory leak as before. However, when I caplocks toggle back to the initial keyboard, it goes back down to the 90+MB level, and runs responsively again. Go figure.

Steve, you're scaring me. I'm right in the middle of adding a bunch of variety just like this to my project. I love variety, but I hates the Kamala load of problems it can create.

Pete@CreativeCreations.com

If I cared enough, I'd dig into it and try and sort out what's going on, but I just don't.

All of this has been upgraded several times since I last did a demo on the forums (the last demo was on the old set of forums I think), and what's here was just an oooold post which had everything all-in-one routine, and not needing the library files.  Another thing that I've noticed is that the buttons aren't properly depressing and going up and down with each click as they should with this version, and that's probably where that responsivity is getting lost with you.

I'd have to dig and follow the flow to see what the issue is (probably some lack of _DELAY), but I imagine the problem has been fixed in the library version, as I've never noticed any super memory leaks or memory jumps while running it in other projects of mine.  I just figured @Pete was an old fart, so he could sniff around an ooold demo and enjoy it. 

(Truth is, I was just too lazy to do the same type demo with the modern library, then have to upload the relevant toolbox files, and all that jazzhand stuff.  This is the first old batch of code that I had where everything was together, so it's the one I tossed in here just to show and share.  The library version really is quite a bit more advanced and tested than this is.  )

[Pete]

Thanks for the well thought out, in-depth, and detailed explanation, but "I don't give a shit!" would have sufficed.

Pete

[SMcNeill]

Thanks for the well thought out, in-depth, and detailed explanation, but "I don't give a shit!" would have sufficed.

Pete

+1 for reading between the lines successfully!   

[Pete]

Updated to include tab function for fields and buttons. I split the button effects from the mouse.

Code: (Select All)

Dim nul As String * 1

Dim As Single lb, mb, rb, mw, my, mx

Dim Shared demo As Integer

ReDim Shared fld$(0), button$(0), mRow$(0)

ReDim Shared As Long h1(0), h2(0), h3(3), fh(0)

ReDim Shared As Long bl1(0), bl2(0)

ReDim Shared As Long gfx1(0), gfx2(0), gfx3(0)

ReDim Shared As Integer x(0), y(0), y1(0), y2(0), x1(0), x2(0)

ReDim Shared As Integer FType(0), fnx(0), btnmap(0), btnfld(0), tabmap(0)

Type fields_and_buttons

    a As String

    initiate As Integer

    mapping As Integer

    SimClick As Integer

    BSelect As Integer

    tabmax As Integer

    tb As Integer

    TabFldHl As Integer

    fld As Integer

    nof As Integer

    nob As Integer

    style As Integer

    Fg As Integer

    Bg As Integer

    FTextFg As Integer

    FTextBg As Integer

    FNamFg As Integer

    FHlRed As Integer

    FHlGrn As Integer

    FHlBlu As Integer

    B1Fg As Integer ' Begin button colors.

    B1Bg As Integer

    B1HvrFg As Integer

    B1HvrBg As Integer

    B1FlashFg As Integer

    B1FlashBg As Integer

    B2BdrFg As Integer

    B2BdrHover As Integer

    B2BdrFlash As Integer

    B3Fg As Integer

    B3Bg As Integer

    B3FlashFg As Integer

    B3FlashBg As Integer

    B3Ln1Red As Integer

    B3Ln1Grn As Integer

    B3Ln1Blu As Integer

    B3Ln2Red As Integer

    B3Ln2Grn As Integer

    B3Ln2Blu As Integer

    B3Ln3Red As Integer

    B3Ln3Grn As Integer

    B3Ln3Blu As Integer

    B3Ln1HvrRed As Integer

    B3Ln1HvrGrn As Integer

    B3Ln1HvrBlu As Integer

    B3Ln2HvrRed As Integer

    B3Ln2HvrGrn As Integer

    B3Ln2HvrBlu As Integer

    B3Ln3HvrRed As Integer

    B3Ln3HvrGrn As Integer

    B3Ln3HvrBlu As Integer

End Type

Dim fb As fields_and_buttons



demo = 1

Width 80, 35: _Font 16

Dim Shared a$(_Height)

_ScreenMove 0, 0

Input "Choose a button mapping method 0 or 1: ", fb.mapping

If fb.mapping = 0 Then _Title "Mouse / Keyboard Demo with Array Mapping" Else _Title "Mouse / Keyboard Demo with Screen Mapping"

_KeyClear

_Display

fb.Fg = 0

fb.Bg = 5

Palette fb.Bg, 63

Color fb.Fg, fb.Bg: Cls

fb.FTextFg = 15: fb.FTextBg = 0: fb.FNamFg = 0

fb.FHlRed = 0: fb.FHlGrn = 155: fb.FHlBlu = 155

fb.B1Fg = 15: fb.B1Bg = 1: fb.B1HvrFg = 3: fb.B1HvrBg = 3: fb.B1FlashFg = 1: fb.B1FlashBg = 3

fb.B2BdrFg = 8: fb.B2BdrHover = 1: fb.B2BdrFlash = 9

fb.B3Fg = 6: fb.B3Bg = 7: fb.B3FlashFg = 15: fb.B3FlashBg = 6

fb.B3Ln1Red = 155: fb.B3Ln1Grn = 155: fb.B3Ln1Blu = 155

fb.B3Ln2Red = 0: fb.B3Ln2Grn = 0: fb.B3Ln2Blu = 0

fb.B3Ln3Red = 255: fb.B3Ln3Grn = 255: fb.B3Ln3Blu = 255

fb.B3Ln1HvrRed = 0: fb.B3Ln1HvrGrn = 155: fb.B3Ln1HvrBlu = 155

fb.B3Ln2HvrRed = 0: fb.B3Ln2HvrGrn = 0: fb.B3Ln2HvrBlu = 0

fb.B3Ln3HvrRed = 255: fb.B3Ln3HvrGrn = 255: fb.B3Ln3HvrBlu = 255

fb.a = "Hover:": fb_fields fb, 2, 51, 2, nul

fb.a = "Button Style:": fb_fields fb, 4, 51, 2, nul

fb.a = "Tab:": fb_fields fb, 6, 51, 2, nul

fb.a = " Button 1 ": fb_make fb, 10, 51, 1

fb.a = " Button 2 ": fb_make fb, 10, 66, 1

fb.a = " Button 3 ": fb_make fb, 15, 51, 2

fb.a = " Button 4 ": fb_make fb, 15, 66, 2

fb.a = " Button 5 ": fb_make fb, 20, 51, 3

fb.a = " Button 6 ": fb_make fb, 20, 66, 3

fb.a = " Button 7 ": fb_make fb, 25, 51, 4

fb.a = " Button 8 ": fb_make fb, 25, 66, 4

fb.a = "Activate": fb_make fb, 30, 51, 5

fb.a = "Activate": fb_make fb, 30, 66, 5

fb.a = "Text:": fb_fields fb, _Height - 2, 51, 19, "Text goes here."

Locate 1, 1

_ControlChr Off

SkipAct = 0: z1 = Timer

idle = 5

Do

    MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$



    If act Or Abs(z1 - Timer) < idle Or SkipAct <> 0 Then

        If SkipAct = 0 Then If act Then z1 = Timer: Palette fb.Bg, 63

        fb_main fb, b$, button$(), mx, my, lb

        door = 0

    Else

        Palette fb.Bg, 7

        If door = 0 Then fb_main fb, b$, button$(), mx, my, lb

        door = -1

    End If

    If drag Then

        If olddrag <> drag Then

            If drag > 0 Then print_array "Drag Right. Status = " + LTrim$(Str$(drag)) Else print_array "Drag Left. Status = " + LTrim$(Str$(drag))

            olddrag = drag

        End If

    Else

        olddrag = 0

    End If

    If oldlb <> lb Then

        Select Case lb

            Case 0

                print_array "Left Button Up - Button Status = " + LTrim$(Str$(lb))

                print_array "Number of clicks = " + LTrim$(Str$(clkcnt))

            Case -1

                print_array "Left Button Down - Button Status = " + LTrim$(Str$(lb))

            Case 1

                print_array "Left Button Pressed - Button Status = " + LTrim$(Str$(lb))

            Case 2

                print_array "Left Button Released - Button Status = " + LTrim$(Str$(lb))

        End Select

    End If

    If oldmb <> mb Then

        Select Case mb

            Case 0: print_array "Middle Button Up - Button Status = " + LTrim$(Str$(mb))

            Case -1: print_array "Middle Button Down - Button Status = " + LTrim$(Str$(mb))

            Case 1: print_array "Middle Button Pressed - Button Status = " + LTrim$(Str$(mb))

            Case 2: print_array "Middle Button Released - Button Status = " + LTrim$(Str$(mb))

        End Select

    End If

    If oldrb <> rb Then

        Select Case rb

            Case 0: print_array "Right Button Up - Button Status = " + LTrim$(Str$(rb))

            Case -1: print_array "Right Button Down - Button Status = " + LTrim$(Str$(rb))

            Case 1: print_array "Right Button Pressed - Button Status = " + LTrim$(Str$(rb))

            Case 2: print_array "Right Button Released - Button Status = " + LTrim$(Str$(rb))

        End Select

    End If

    If oldmw <> mw Then

        If mw < 0 Then print_array "Mouse Wheel Up - Wheel Status = " + LTrim$(Str$(mw))

        If mw > 0 Then print_array "Mouse Wheel Down - Wheel Status = " + LTrim$(Str$(mw))

    End If

    If fb.BSelect Then print_array "Button Selected = " + LTrim$(Str$(fb.BSelect))

    If oldalt% <> alt% Then

        If alt% < 0 Then print_array "Alt Button Down" Else print_array "Alt Button Released"

    End If

    If oldctrl% <> ctrl% Then

        If ctrl% < 0 Then print_array "Ctrl Button Down" Else print_array "Ctrl Button Released"

    End If

    If oldshift% <> shift% Then

        If shift% < 0 Then print_array "Shift Button Down" Else print_array "Shift Button Released"

    End If

    If AltStatus% And OldAltStatus% <> AltStatus% Then

        If AltToggle% Then print_array "Alt Key Pressed / Alt Toggle Status: On" Else print_array "Alt Key Pressed / Alt Toggle Status: Off"

    End If

    If k& < 0 Then oldb$ = ""

    Select Case Len(b$)

        Case 1

            If oldb$ <> b$ Then x = CVI(MKI$(Asc(b$))): print_array "You Pressed: " + Chr$(x) + "  Chr$(" + LTrim$(Str$(x)) + ")"

            oldb$ = b$

        Case 2

            If oldb$ <> b$ Then print_array "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%: OldAltStatus% = AltStatus%

Loop



Sub print_array (a$)

    Static cnt, y

    s1 = CsrLin: s2 = Pos(0)

    y = y + 1

    If cnt = _Height - 1 Then

        Locate 1, 1

        j = cnt: cnt = 0

        For cnt = 1 To j - 1

            a$(cnt) = a$(cnt + 1)

            Print a$(cnt);

        Next

        a$(cnt) = Space$(45)

        Mid$(a$(cnt), 1) = a$

        Print a$(cnt);

    Else

        cnt = cnt + 1

        a$(cnt) = Space$(45)

        Mid$(a$(cnt), 1) = a$

        Locate y, 1

        Print a$(cnt);

    End If

    Locate s1, s2

End Sub



Sub MyMouse_and_Keyboard (act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$)

    Dim As Integer oldmw

    Static As Integer oldmy, oldmx, mwy, oldmwy

    Static z1 As Single

    Do

        _Limit 30

        act = 0

        If AltStatus% Then AltStatus% = 0

        If Len(autokey$) Then

            b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)

            autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)

            act = 1

            Exit Do

        Else

            k& = _KeyHit

            If k& = 100307 Or k& = 100308 Then

                AltStatus% = -1

                AltToggle% = 1 - AltToggle%

                act = 1

                Exit Do

            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)

                act = 3

            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: act = 1

            Else

                lb = 0: act = -1

            End If

        End If

        If rb > 0 Then If rb = 1 Then rb = -1: act = 1 Else rb = 0

        If mb > 0 Then If mb = 1 Then mb = -1: act = 1 Else mb = 0

        While _MouseInput

            mwy = mwy + _MouseWheel: act = 1

        Wend

        my = _MouseY

        mx = _MouseX

        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: act = 1 Else If shift% Then shift% = 0

            If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1: act = 1 Else If ctrl% Then ctrl% = 0

            If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1: act = 1 Else If alt% Then alt% = 0

        End If

        If lb = -1 And _MouseButton(1) = 0 Then

            lb = 2: drag = 0: hover = 0: act = 1

        ElseIf rb = -1 And _MouseButton(2) = 0 Then

            rb = 2: act = 1

        ElseIf mb = -1 And _MouseButton(3) = 0 Then

            mb = 2: act = 1

        End If

        If _MouseButton(1) Then

            If lb = 0 Then

                lb = 1: z1 = Timer: act = 1

                clkcnt = clkcnt + 1

            End If

        ElseIf _MouseButton(2) And rb = 0 Then

            rb = 1: act = 1

        ElseIf _MouseButton(3) And mb = 0 Then

            mb = 1: act = 1

        End If

        If my <> oldmy Or mx <> oldmx Then act = 2

        oldmy = my: oldmx = mx

        Exit Do

    Loop

End Sub



Sub fb_main (fb As fields_and_buttons, b$, button$(), mx, my, lb)

    Static BTabHl As Integer

    s1 = CsrLin: s2 = Pos(0)

    b_hover = 0: fb.fld = 0: fb.BSelect = 0

    If fb.mapping Then

        If Len(mRow$(my)) Then

            i = Asc(Mid$(mRow$(my), mx, 1))

            If i > 96 Then

                fb.fld = i - 96

                If FType(fb.fld) = 5 Then b_hover = btnmap(fb.fld)

            End If

        End If

    Else

        For i = 1 To fb.nof ' number of fields.

            If my >= y1(i) And my <= y2(i) And mx >= x1(i) And mx <= x2(i) Then

                Select Case FType(i)

                    Case 1

                        fb.fld = i

                    Case 5

                        fb.fld = i

                        b_hover = btnmap(fb.fld)

                        Exit For

                End Select

            End If

        Next

    End If

    If lb = 2 And FType(fb.fld) = 1 Then

        fb.tb = fb.fld - 1

        fb.TabFldHl = tabmap(fb.tb)

        fb.fld = fb.tb

        BTabHl = 0

        ChangeField% = 1

    Else

        If fb.tabmax And b$ = Chr$(9) Then ChangeField% = -1 Else ChangeField% = 0

    End If

    If ChangeField% Then

        If fb.tb = fb.tabmax Then ' Redo cycle.

            fb.tb = 0: BTabHl = 0: fb.TabFldHl = 0

        Else

            If FType(fb.tb + 1) = 5 Then ' Button.

                fb.tb = fb.tb + 1

                BTabHl = 0

                force = 1: ' Local variable to force any tab button field to remain highlighted.

            Else ' Field.

                fb.tb = fb.tb + 1 ' Increase tab field for text / non-button fields.

                fb.TabFldHl = tabmap(fb.tb)

                Locate y1(fb.tb), x1(fb.tb)

                s1 = CsrLin: s2 = Pos(0)

            End If

        End If

    End If

    If fb.tb Then

        If fb.TabFldHl And FType(fb.tb) = 1 Then ' Highlight tab field.

            _PutImage ((fnx(fb.tb) - 1) * 8 - 3, (y1(fb.tb) - 1) * 16 - 2), fh(fb.TabFldHl)

        End If

        If b$ = Chr$(13) Then ' Tab field selected by Enter key.

            If FType(fb.tb) = 5 Then

                fb.SimClick = -btnmap(fb.tb) ' Simulate a left button click.

            End If

        End If

        If FType(fb.tb) = 1 Then

            Locate , , 1

        Else

            Locate , , 0

        End If

    End If

    For k = 1 To fb.nob

        If demo Then fb.style = (k - 1) \ 2 + 1

        If fb.SimClick = -k Then

            fb.SimClick = Abs(fb.SimClick)

            h = 1: i = Len(button$(fb.SimClick))

            j = fb.tb: l = btnmap(j)

        Else

            If BTabHl = k And FType(fb.tb) = 5 Then j = fb.tb: l = btnmap(j) Else j = btnfld(k): l = b_hover

            h = lb: i = Len(button$(k))

        End If

        If BTabHl = k And b_hover <> k And fb.SimClick = 0 Then

            Select Case fb.style

                Case 1

                    Color fb.B1HvrFg, fb.Bg

                    Locate y1(j) - 1, x1(j): Print String$(i, 220);

                    Locate y1(j) + 1, x1(j): Print String$(i, 223);

                    Color fb.B1Fg, fb.B1HvrBg

                    Locate y1(j), x1(j): Print button$(k);

                Case 2

                    Color fb.B2BdrHover, fb.Bg

                    Locate y1(j), x1(j): Print Chr$(218) + String$(i, 196) + Chr$(191)

                    Locate y1(j) + 1, x1(j): Print Chr$(179);: Locate , Pos(0) + i: Print Chr$(179)

                    Locate y1(j) + 2, x1(j): Print Chr$(192) + String$(i, 196) + Chr$(217);

                    Locate y1(j) + 1, x1(j) + 1: Print button$(k);

                Case 3

                    Color fb.B3Fg, fb.B3Bg

                    Locate y1(j) + 1, x1(j) + 1: Print button$(k);

                    _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl2(k)

                Case 4

                    _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx2(k)

                Case 5

                    _PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h2(k)

            End Select

        Else

            Select Case fb.style

                Case 1

                    If h = 0 And b_hover = k Then

                        Color fb.B1HvrFg, fb.Bg

                        Locate y1(j) - 1, x1(j): Print String$(i, 220);

                        Locate y1(j) + 1, x1(j): Print String$(i, 223);

                        Color fb.B1Fg, fb.B1HvrBg

                        Locate y1(j), x1(j): Print button$(k);

                    ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then

                        Color fb.B1FlashBg, fb.Bg

                        Locate y1(j) - 1, x1(j): Print String$(i, 220);

                        Locate y1(j) + 1, x1(j): Print String$(i, 223);

                        Color fb.B1FlashFg, fb.B1FlashBg

                        Locate y1(j), x1(j): Print button$(k);

                        If h = 2 Then fb.BSelect = k

                    Else

                        Color fb.B1Bg, fb.Bg

                        Locate y1(j) - 1, x1(j): Print String$(i, 220);

                        Locate y1(j) + 1, x1(j): Print String$(i, 223);

                        Color fb.B1Fg, fb.B1Bg

                        Locate y1(j), x1(j): Print button$(k);

                    End If

                Case 2

                    If h = 0 And b_hover = k Then

                        Color fb.B2BdrHover, fb.Bg

                    ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then

                        Color fb.B2BdrFlash, fb.Bg

                        If h = 2 Then fb.BSelect = k

                    Else

                        Color fb.B2BdrFg, fb.Bg

                    End If

                    Locate y1(j), x1(j): Print Chr$(218) + String$(i, 196) + Chr$(191)

                    Locate y1(j) + 1, x1(j): Print Chr$(179);: Locate , Pos(0) + i: Print Chr$(179)

                    Locate y1(j) + 2, x1(j): Print Chr$(192) + String$(i, 196) + Chr$(217);

                    Locate y1(j) + 1, x1(j) + 1: Print button$(k);

                Case 3

                    If h = 0 And b_hover = k Then

                        Color fb.B3Fg, fb.B3Bg

                        Locate y1(j) + 1, x1(j) + 1: Print button$(k);

                        _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl2(k)

                    ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then

                        Color fb.B3FlashFg, fb.B3FlashBg

                        Locate y1(j) + 1, x1(j) + 1: Print button$(k);

                        _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl1(k)

                        If h = 2 Then fb.BSelect = k

                    Else

                        Color fb.B3Fg, fb.B3Bg

                        Locate y1(j) + 1, x1(j) + 1: Print button$(k);

                        _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl1(k)

                    End If

                Case 4

                    If h = 0 And b_hover = k Then

                        _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx2(k)

                    ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then

                        _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx3(k)

                        If h = 2 Then fb.BSelect = k

                    Else

                        _PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx1(k)

                    End If

                Case 5

                    If h = 0 And b_hover = k Then

                        _PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h2(k)

                    ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then

                        _PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h3(k)

                        If h = 2 Then fb.BSelect = k

                    Else

                        _PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h1(k)

                    End If

            End Select

        End If

    Next

    If FType(fb.tb) = 5 Then If b_hover = 0 Or force Then BTabHl = btnmap(fb.tb)

    If demo Then

        If b_hover Then fb.style = (b_hover - 1) \ 2 + 1 Else fb.style = 0

        q1 = CsrLin: q2 = Pos(0)

        Color fb.FTextFg, fb.FTextBg

        Locate y1(1), x1(1): Print Space$(2);: Locate y1(1), x1(1): Print LTrim$(Str$(b_hover));

        Locate y1(2), x1(2): Print Space$(2);: Locate y1(2), x1(2)

        If b_hover Then Print LTrim$(Str$(fb.style)); Else j = 0: Print LTrim$(Str$(j));

        Locate y1(3), x1(3): Print Space$(2);: Locate y1(3), x1(3): Print LTrim$(Str$(fb.tb));

        Color fb.Fg, fb.Bg

        Locate q1, q2

    End If

    Locate s1, s2

    _Display

    If fb.SimClick Then fb.BSelect = fb.SimClick: fb.SimClick = 0: _Delay .1

End Sub



Sub fb_fields (fb As fields_and_buttons, y, x, length, filler$)

    Static cnt

    s1 = CsrLin: s2 = Pos(0)

    c1 = _DefaultColor: c2 = _BackgroundColor

    fb.nof = fb.nof + 1: fb.tabmax = fb.tabmax + 1: cnt = cnt + 1

    ReDim _Preserve fld$(fb.nof), fh(cnt), tabmap(fb.nof)

    ReDim _Preserve fnx(fb.nof), y1(fb.nof), x1(fb.nof), y2(fb.nof), x2(fb.nof), FType(fb.nof), FType(fb.nof)

    FType(fb.nof) = 1

    Locate y, x

    fnx(fb.nof) = x

    tabmap(fb.nof) = cnt

    Color fb.FNamFg, fb.Bg

    Print fb.a;

    Color fb.Bg, fb.FTextBg

    Print "Ý";

    j = Len(fb.a) + length + 2 ' Used in Line statement for highlighting line length configuration.

    If Len(filler$) Then

        fld$(fb.nof) = filler$

        fb.a = filler$ + Space$(length - Len(filler$)): fb_map fb, 1

    Else

        fb.a = Space$(length): fb_map fb, 1

    End If

    Print "Þ";

    t = _NewImage((j + 1) * 8, 2 * 16, 32)

    _Dest t

    Line (0, 0)-(j * 8 + 1, 16 * 1 + 3), _RGB32(fb.FHlRed, fb.FHlGrn, fb.FHlBlu), B

    fh(cnt) = _CopyImage(t, 33)

    _FreeImage t

    _Dest 0

    Color c1, c2

    Locate s1, s2

End Sub



Sub fb_make (fb As fields_and_buttons, y As Integer, x As Integer, ButtonStyle As Integer)

    Static btnnbr

    fb.style = ButtonStyle

    If fb.initiate = 0 Then

        fb.initiate = 1

        btnnbr = 0

    End If

    s1 = CsrLin: s2 = Pos(0)

    c1 = _DefaultColor: c2 = _BackgroundColor

    j = Len(fb.a)

    fb.nof = fb.nof + 1: fb.nob = fb.nob + 1: fb.tabmax = fb.tabmax + 1

    ReDim _Preserve fld$(fb.nof), FType(fb.nof), btnmap(fb.nof), btnfld(fb.nob)

    FType(fb.nof) = 5

    btnnbr = btnnbr + 1

    btnmap(fb.nof) = btnnbr

    btnfld(btnnbr) = fb.nof

    ReDim _Preserve y1(fb.nof), x1(fb.nof), y2(fb.nof), x2(fb.nof), button$(fb.nof)

    button$(btnnbr) = String$(j, 0) ' Fill any spaces with the null character.

    Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(fb.a))) \ 2) = _Trim$(fb.a)

    Select Case fb.style

        Case 1 ' Single line button with blank border.

            y = Abs(y)

            Color fb.B1Fg, fb.B1Bg: Locate y, x: fb.a = button$(btnnbr): fb_map fb, 5

            Color fb.B1Bg, fb.Bg: Locate y - 1, x: fb.a = String$(j, Chr$(220)): fb_map fb, 0

            Locate y + 1, x: fb.a = String$(j, Chr$(223)): fb_map fb, 0

        Case 2 ' Text button with line border.

            Color fb.B2BdrFg, fb.Bg

            Locate y - 1, x - 1: fb.a = Chr$(218) + String$(j, 196) + Chr$(191): fb_map fb, 6

            Locate y, x - 1: fb.a = Chr$(179): fb_map fb, 0

            Locate , Pos(0) + j: fb.a = Chr$(179): fb_map fb, 0

            Locate y + 1, x - 1: fb.a = Chr$(192) + String$(j, 196) + Chr$(217): fb_map fb, 7

            Locate y, x: fb.a = button$(btnnbr): fb_map fb, 0

        Case 3 ' Text hybrid button with graphics line border.

            Palette 6, 56

            j = Len(fb.a)

            k = btnnbr

            ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), bl1(btnnbr), bl2(btnnbr)

            y(k) = y - 1: x(k) = x - 1

            button$(i) = String$(j, 0)

            Mid$(button$(i), 1 + (j - Len(_Trim$(fb.a))) / 2) = _Trim$(fb.a)

            Locate y - 1, x - 1: Color fb.B3Fg, fb.Bg: fb.a = String$(j + 2, "Ü"): fb_map fb, 6

            Locate y, x - 1: Color fb.B3Fg, fb.B3Fg: fb.a = String$(j + 2, 0): fb_map fb, 0

            Locate y + 1, x - 1: Color fb.B3Fg, fb.Bg: fb.a = String$(j + 2, "ß"): fb_map fb, 7

            Dest = _Dest

            t = _NewImage((j + 3) * 8, 4 * 16, 32)

            _Dest t

            Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), B

            Line (0, 7)-((j + 2) * 8, 16 * 2 + 7), _RGB32(fb.B3Ln2Red, fb.B3Ln2Grn, fb.B3Ln2Blu), B

            Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln3Red, fb.B3Ln3Grn, fb.B3Ln3Blu), B

            bl1(btnnbr) = _CopyImage(t, 33)

            _FreeImage t

            t = _NewImage((j + 3) * 8, 4 * 16, 32)

            _Dest t

            Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(fb.B3Ln1HvrRed, fb.B3Ln1HvrGrn, fb.B3Ln1HvrBlu), B

            Line (0, 7)-((j + 2) * 8, 16 * 2 + 7), _RGB32(fb.B3Ln2HvrRed, fb.B3Ln2HvrGrn, fb.B3Ln2HvrBlu), B

            Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln3HvrRed, fb.B3Ln3HvrGrn, fb.B3Ln3HvrBlu), B

            bl2(btnnbr) = _CopyImage(t, 33)

            _FreeImage t

            _Dest 0

        Case 4 ' Graphics hybrid button.

            j = Len(fb.a)

            ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), gfx1(btnnbr), gfx2(btnnbr), gfx3(btnnbr)

            y(btnnbr) = y - 1: x(btnnbr) = x - 1

            button$(btnnbr) = String$(j + 2, 0)

            Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(fb.a))) / 2) = _Trim$(fb.a)

            fb.a = " " + button$(btnnbr) + " ": j = j + 2 ' Widen margins for better button appearance.

            Locate y - 1, x - 1: fb_map fb, 8

            Locate y, x - 1: fb_map fb, -1

            Locate y + 1, x - 1: fb_map fb, 9

            gfx1(btnnbr) = fb_gfx(j * 8, 2 * 16, 170, 170, 170, -9, -9, -1, Mid$(fb.a, 1, j))

            gfx2(btnnbr) = fb_gfx(j * 8, 2 * 16, 200, 200, 200, -8, -7, -1, Mid$(fb.a, 1, j))

            gfx3(btnnbr) = fb_gfx(j * 8, 2 * 16, 200, 200, 200, -1, -1, -1, Mid$(fb.a, 1, j))

        Case 5 ' HTML button.

            img& = _LoadImage("activate-static.png", 32)

            i = _Height(img&)

            j = _Width(img&)

            If j Mod 8 Then j = j \ 8 + 1 Else j = j \ 8

            If i Mod 16 Then i = i \ 16 + 1 Else i = i \ 16

            If i / 2 <> i \ 2 Then i = i + 1

            If j / 2 <> j \ 2 Then j = j + 1

            button$(btnnbr) = _Trim$(fb.a)

            fb.a = String$(j, i)

            ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), h1(btnnbr), h2(btnnbr), h3(btnnbr)

            y(btnnbr) = y - 1: x(btnnbr) = x - 1

            Locate y - 1, x - 1: fb_map fb, 10

            For k = 0 To i - 2

                Locate y + k, x - 1: fb_map fb, -1

            Next

            h1(btnnbr) = _CopyImage(img&, 33)

            _FreeImage img&

            img& = _LoadImage("activate-hover.png", 32)

            h2(btnnbr) = _CopyImage(img&, 33)

            _FreeImage img&

            img& = _LoadImage("activate-active.png", 32)

            h3(btnnbr) = _CopyImage(img&, 33)

            _FreeImage img&

    End Select

    Color c1, c2

    Locate s1, s2

End Sub



Function fb_gfx (wide, tall, r, g, b, rc, gc, bc, caption$)

    ' Button function courtesy of the Amazing Steve.

    Dim k As _Unsigned Long

    Dest = _Dest

    t = _NewImage(wide, tall, 32)

    _Dest t

    For i = 0 To 10

        rm = rm + rc

        gm = gm + gc

        bm = bm + bc

        k = _RGB32(r + rm, g + gm, b + bm)

        Line (x + i, y + i)-(x + wide - i, y + tall - i), k, B

    Next

    Paint (x + i, y + i), k

    Color _RGB32(r, g, b), 0

    _PrintString (x + (wide - _PrintWidth(caption$)) / 2, y + (tall - _FontHeight) / 2), caption$

    fb_gfx = _CopyImage(t, 33)

    _FreeImage t

    _Dest Dest

End Function



Sub fb_map (fb As fields_and_buttons, mapid)

    Static mapfld As Integer

    If UBound(mRow$) = 0 Then

        ReDim mRow$(_Height)

        mapfld = 96

    End If

    If fb.mapping And mRow$(CsrLin) = "" Then mRow$(CsrLin) = Space$(_Width)

    Select Case mapid

        Case 1 ' Simple text field.

            mapfld = mapfld + 1 ' Advance.

            y1(mapfld - 96) = CsrLin

            x1(mapfld - 96) = Pos(0)

            y2(mapfld - 96) = CsrLin

            x2(mapfld - 96) = Pos(0) + Len(fb.a)

        Case 5 ' Single line button with blank padding.

            mapfld = mapfld + 1 ' Advance.

            y1(mapfld - 96) = CsrLin

            x1(mapfld - 96) = Pos(0)

            y2(mapfld - 96) = CsrLin

            x2(mapfld - 96) = Pos(0) + Len(fb.a)

        Case 6 ' Text or hybrid button top.

            mapfld = mapfld + 1 ' Advance.

            y1(mapfld - 96) = CsrLin: x1(mapfld - 96) = Pos(0)

        Case 7 ' Text or hybrid button bottom.

            y2(mapfld - 96) = CsrLin: x2(mapfld - 96) = Pos(0) + Len(fb.a)

        Case 8 ' Graphics hybrid button top.

            mapfld = mapfld + 1 ' Advance.

            y1(mapfld - 96) = CsrLin

            x1(mapfld - 96) = Pos(0)

        Case 9 ' Graphics hybrid button bottom.

            y2(mapfld - 96) = CsrLin

            x2(mapfld - 96) = Pos(0) + Len(fb.a)

        Case 10 ' HTML button.

            mapfld = mapfld + 1 ' Advance.

            y1(mapfld - 96) = CsrLin

            x1(mapfld - 96) = Pos(0)

            y2(mapfld - 96) = CsrLin + Asc(Mid$(fb.a, 1, 1))

            x2(mapfld - 96) = Pos(0) + Len(fb.a)

    End Select

    If fb.mapping Then Mid$(mRow$(CsrLin), Pos(0)) = String$(Len(fb.a), Chr$(mapfld))

    If mapid < 8 And mapid > -1 Then Print fb.a;

End Sub

   

   

   


Pete

[Pete]

Updated the post above. Part of me wants to add a pure graphics example. As much as I love the hardware acceleration effect, it sure uses up a big chunk of CPU.

I'm also thinking about scaling for popups, and possibly scrolling.

Well, whenever I reach a stopping point, which this may be it, I want to rename some variables and replace some with TYPE variables , add some comments, and format the demo into two libraries, mouse/keyboard and fields/buttons.

Pete

[Pete]

Updated post #27 with Enter to select a button highlighted with the tab key. I have to give some thought if I want to do the same with the text fields.

I might post something in the General section regarding shared vs passed variables for this type of library operation. There are some small advantages to using shared variables, which results in less coding to use the libraries from the main.

Pete

[Pete]

I like the newly engineered routine. Added box highlighting for the Tab or click on fields action. Next step is to separate out the demo into its own sub, and then start adding some comments before I forget what the hell everything does.

Update is in post #27

https://qb64phoenix.com/forum/showthread...8#pid31798

Pete