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