Posts: 2,861
Threads: 341
Joined: Apr 2022
Reputation:
251
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. 
Posts: 2,467
Threads: 249
Joined: Apr 2022
Reputation:
125
01-27-2025, 11:14 PM
(This post was last modified: 01-27-2025, 11:16 PM by 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 
Posts: 2,467
Threads: 249
Joined: Apr 2022
Reputation:
125
01-28-2025, 12:36 AM
(This post was last modified: 01-28-2025, 01:10 AM by 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
Posts: 2,861
Threads: 341
Joined: Apr 2022
Reputation:
251
(01-28-2025, 12:36 AM)Pete Wrote: 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. )
Posts: 2,467
Threads: 249
Joined: Apr 2022
Reputation:
125
Thanks for the well thought out, in-depth, and detailed explanation, but "I don't give a shit!" would have sufficed.
Pete
Posts: 2,861
Threads: 341
Joined: Apr 2022
Reputation:
251
(01-28-2025, 03:53 AM)Pete Wrote: 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!
Posts: 2,467
Threads: 249
Joined: Apr 2022
Reputation:
125
01-30-2025, 02:39 AM
(This post was last modified: Yesterday, 02:23 AM by Pete.)
Updated to include tab function for fields and buttons. I split the button effects from the mouse.
Code: (Select All)
Dim Shared demo As Integer
Dim As Single lb, mb, rb, mw, my, mx
ReDim Shared fld$(0), button$(0), mRow$(0), h1(0) As Long, h2(0) As Long, h3(0) As Long, bl1(0) As Long, bl2(0) As Long
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), fnx(0), btnmap(0), btnfld(0), FType(0)
Type fields_and_buttons
a As String
initiate As Integer
tabmax As Integer
tb As Integer
SimClick As Integer
fld As Integer
nof As Integer
nob As Integer
mapping As Integer
style As Integer
b_lines_static As Long
b_lines_hover As Long
img_static As Long
img_hover As Long
img_active As Long
BSelect As Integer
Bg As Integer ' Begin button colors.
BBdr As Integer
BBdrHover As Integer
BBdrFlash As Integer
BFg As Integer
BBg As Integer
BBg1 As Integer
BHvrFg As Integer
BHvrBk As Integer
BFgFlash As Integer
BBgFlash As Integer
BHybFg As Integer
BHybBg1 As Integer
BHybBg2 As Integer
BHybBdr1 As Integer
BHybBdr2 As Integer
End Type
Dim fb As fields_and_buttons
Width 80, 35: _Font 16
_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"
demo = 1
_KeyClear
Palette 5, 63
Color 0, 5: Cls
_Display
fb.BBdr = 8: fb.BBdrHover = 1: fb.BBdrFlash = 9: fb.BFg = 15: fb.BBg = 3: fb.BBg1 = 1: fb.BHvrFg = 3: fb.BHvrBk = 1: fb.BFgFlash = 1: fb.BBgFlash = 3
fb.Bg = 5: fb.BHybBg1 = 6: fb.BHybFg = 6: fb.BHybBg2 = 7: fb.BHybBdr1 = 0: fb.BHybBdr2 = 255
Dim Shared a$(_Height)
fb.a = "Hover: ": fb_fields fb, 2, 51, 5
fb.a = "Button Style: ": fb_fields fb, 4, 51, 5
fb.a = "Tab: ": fb_fields fb, 6, 51, 5
fb.style = 1
fb.a = " Button 1 ": fb_make fb, 10, 51
fb.a = " Button 2 ": fb_make fb, 10, 66
fb.style = 2
fb.a = " Button 3 ": fb_make fb, 15, 51
fb.a = " Button 4 ": fb_make fb, 15, 66
fb.style = 3
fb.a = " Button 5 ": fb_make fb, 20, 51
fb.a = " Button 6 ": fb_make fb, 20, 66
fb.style = 4
fb.a = " Button 7 ": fb_make fb, 25, 51
fb.a = " Button 8 ": fb_make fb, 25, 66
fb.style = 5
fb.a = "Activate": fb_make fb, 30, 51
fb.a = "Activate": fb_make fb, 30, 66
fb.style = 0
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 5, 63
fb_main fb, b$, button$(), mx, my, lb
door = 0
Else
Palette 5, 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 60
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 HtmlBtn 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
If FType(fb.tb) = 1 Then
If demo Then Locate , Pos(0) + 2, 1, 7, 1: s1 = CsrLin: s2 = Pos(0)
End If
fb.tb = fb.fld - 1
fb.fld = fb.tb
HtmlBtn = 0
b$ = Chr$(9)
End If
If fb.tabmax And b$ = Chr$(9) Then
If fb.tb = fb.tabmax Then ' Redo cycle.
fb.tb = 0: HtmlBtn = 0
Else
If FType(fb.tb + 1) = 5 Then
fb.tb = fb.tb + 1 ' Note: Button will be highlighted at end of subroutine.
HtmlBtn = 0
force = 1: ' Local variable to force any tab button field to remain highlighted.
Else
fb.tb = fb.tb + 1 ' Increase tab field for text / non-button fields.
i = Val(Mid$(fld$(fb.tb), 6, 5))
j = Val(Mid$(fld$(fb.tb), 16, 5)) + 1
Locate y1(fb.tb), fnx(fb.tb)
If demo Then Locate , Pos(0) + 2, 1, 7, 1
s1 = CsrLin: s2 = Pos(0)
End If
End If
End If
If fb.tb Then
If b$ = Chr$(13) Then
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 HtmlBtn = k Then j = fb.tb: l = btnmap(j) Else j = btnfld(k): l = b_hover
h = lb: i = Len(button$(k))
End If
If HtmlBtn = k And b_hover <> k And fb.SimClick = 0 Then
Select Case fb.style
Case 1
Color fb.BHvrFg, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.BFg, fb.BBg
Locate y1(j), x1(j): Print button$(k);
Case 2
Color fb.BBdrHover, 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.BHybFg, fb.BHybBg2
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.BHvrFg, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.BFg, fb.BBg
Locate y1(j), x1(j): Print button$(k);
ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then
Color fb.BBgFlash, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.BFgFlash, fb.BBgFlash
Locate y1(j), x1(j): Print button$(k);
If h = 2 Then fb.BSelect = k
Else
Color fb.BBg1, fb.Bg
Locate y1(j) - 1, x1(j): Print String$(i, 220);
Locate y1(j) + 1, x1(j): Print String$(i, 223);
Color fb.BFg, fb.BBg1
Locate y1(j), x1(j): Print button$(k);
End If
Case 2
If h = 0 And b_hover = k Then
Color fb.BBdrHover, fb.Bg
ElseIf Abs(h) And b_hover = k Or fb.SimClick = k Then
Color fb.BBdrFlash, fb.Bg
If h = 2 Then fb.BSelect = k
Else
Color fb.BBdr, 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.BHybFg, fb.BHybBg2
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.Bg, fb.BHybFg
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.BHybFg, fb.BHybBg2
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 HtmlBtn = 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 15, 0
Locate 2, 66 - 7: Print b_hover;: Locate 4, 71 - 5
If b_hover Then Print fb.style; Else j = 0: Print j;
Locate 6, 63 - 6: Print fb.tb;
Color 0, 5
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)
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
fb.nof = fb.nof + 1: fb.tabmax = fb.tabmax + 1
ReDim _Preserve fld$(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
fld$(fb.nof) = Space$(20)
Locate y, x
Color 0, 5
Print fb.a;
fnx(fb.nof) = Pos(0)
Color 15, 0
fb.a = Space$(length): fb_map fb, 1
Color c1, c2
Locate s1, s2
End Sub
Sub fb_make (fb As fields_and_buttons, y, x)
Static btnnbr
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
fld$(fb.nof) = Space$(25)
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.BFg, fb.BBg1: Locate y, x: fb.a = button$(btnnbr): fb_map fb, 5
Color fb.BBg1, 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.BBdr, 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.BHybBg1, fb.Bg: fb.a = String$(j + 2, "Ü"): fb_map fb, 6
Locate y, x - 1: Color fb.Bg, fb.BHybBg1: fb.a = String$(j + 2, 0): fb_map fb, 0
Locate y + 1, x - 1: Color fb.BHybBg1, fb.Bg: fb.a = String$(j + 2, "ß"): fb_map fb, 7
Locate y, x: Color fb.BHybFg, fb.BHybBg2: fb.a = button$(i): fb_map fb, 0
Dest = _Dest
t = _NewImage(120, 70, 32)
_Dest t
Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(155, 155, 155), B
Line (0, 7)-((j + 2) * 8, 16 * 2 + 7), _RGB32(fb.BHybBdr1, fb.BHybBdr1, fb.BHybBdr1), B
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.BHybBdr2, fb.BHybBdr2, fb.BHybBdr2), B
bl1(btnnbr) = _CopyImage(t, 33)
_FreeImage t
_Dest 0
Dest = _Dest
tt = _NewImage(120, 70, 32)
_Dest tt
Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(0, 155, 155), B
Line (0, 7)-((j + 2) * 8, 16 * 2 + 7), _RGB32(fb.BHybBdr1, fb.BHybBdr1, fb.BHybBdr1), B
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.BHybBdr2, fb.BHybBdr2, fb.BHybBdr2), B
bl2(btnnbr) = _CopyImage(tt, 33)
_FreeImage tt
_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
Sub popup (m.top, m.left, m.height, m.width)
pop = 1
c.MenuBdrFg = 0
c.MenubrdBg = 5
c.MenuSdwFg = 6
c.MenuSdwBg = 0
c.MenuFg = 0
c.MenuBg = 5
spacing = 1
PCopy 0, 1
Palette 7, 7
Palette 6, 58
Locate m.top - pop, m.left - pop
For h = 1 To m.height
If h = 1 Then
Color c.MenuBdrFg, c.MenubrdBg
Print Chr$(218) + String$(m.width - 2, 196) + Chr$(191)
j = CsrLin
For i = 1 To m.height - 2
If CsrLin < _Height Then Locate j, m.left - pop Else Locate , m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
Color c.MenuBdrFg, c.MenubrdBg: Print Space$(m.width - 2);
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
j = j + 1
Next
Locate j, m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(192) + String$(m.width - 2, 196) + Chr$(217);
If pop Then ' Shadow effect.
Color c.MenuSdwFg, c.MenuSdwBg ' Shadow below.
Locate CsrLin + 1, m.left - pop + 2
For i = 1 To m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
Next
Locate m.top - pop + 1 ' Shadow to the right.
For i = 1 To m.height - 1
Locate , m.left - pop + m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
j = Screen(CsrLin, Pos(0))
Print Chr$(j)
Next
End If
End If
Color c.MenuFg, c.MenuBg
Locate m.top - pop + h + (h - 1) * spacing, m.left - pop + 2 - 1
Next h
End Sub
Pete
Posts: 2,467
Threads: 249
Joined: Apr 2022
Reputation:
125
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
Posts: 2,467
Threads: 249
Joined: Apr 2022
Reputation:
125
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
|
