Posts: 2,821
Threads: 334
Joined: Apr 2022
Reputation:
242
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,417
Threads: 245
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,417
Threads: 245
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,821
Threads: 334
Joined: Apr 2022
Reputation:
242
(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,417
Threads: 245
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,821
Threads: 334
Joined: Apr 2022
Reputation:
242
(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,417
Threads: 245
Joined: Apr 2022
Reputation:
125
01-30-2025, 02:39 AM
(This post was last modified: 01-31-2025, 01:15 AM by Pete.)
Well this button detour has to end sometime. Here it is with an example of a hardware overlay effect, graphics button Steve mostly put together (entirely for the function) some years ago, and an html button. The 3 png files are needed, below.
Code: (Select All)
Dim Shared mapping, demo, BSelect, ButtonStyle
Dim Shared Bg, BBdr, BBdrHover, BBdrFlash, BFg, BBg, BBg1, BHvrFg, BHvrBk, BFgFlash, BBgFlash
Dim Shared BHybFg, BHybBg1, BHybBg2, BHybBdr1, BHybBdr2
ReDim Shared y_btl(0), y_bbr(0), x_btl(0), x_bbr(0), button$(0), mRow$(0), nob, x(0), y(0)
Width 80, 32: _Font 16
Input "Choose a button mapping method 0 or 1: ", mapping
Dim Shared overlay: overlay = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)
If mapping = 0 Then _Title "Mouse / Keyboard Demo with Array Mapping" Else _Title "Mouse / Keyboard Demo with Screen Mapping"
demo = 1
_KeyClear
Color 0, 5: Cls
Palette 5, 63
Palette 6, 56
BBdr = 8: BBdrHover = 1: BBdrFlash = 1: BFg = 15: BBg = 3: BBg1 = 1: BHvrFg = 3: BHvrBk = 1: BFgFlash = 1: BBgFlash = 3
Bg = 5: BHybBg1 = 6: BHybFg = 6: BHybBg2 = 7: BHybBdr1 = 0: BHybBdr2 = 255
Dim Shared a$(_Height)
a$ = " Button 1 ": button_maker a$, 7, 51, 1
a$ = " Button 2 ": button_maker a$, 7, 66, 1
a$ = " Button 3 ": button_maker a$, 12, 51, 2
a$ = " Button 4 ": button_maker a$, 12, 66, 2
a$ = " Button 5 ": button_maker a$, 17, 51, 3
a$ = " Button 6 ": button_maker a$, 17, 66, 3
a$ = " Button 7 ": button_maker a$, 22, 51, 0
a$ = " Button 8 ": button_maker a$, 22, 66, 0
a$ = "Activate": button_maker a$, 27, 51, 4
a$ = "Activate": button_maker a$, 27, 66, 4
'''Cls: For i = 1 To 29: y = CsrLin: Print mRow$(i): Locate y, 77: Print i: _Display: Next: Sleep
Locate 1, 1
_ControlChr Off
Do
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$()
If drag Then
If olddrag <> drag Then
If drag > 0 Then print_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))
If temp Then print_array "Button Selected = " + LTrim$(Str$(temp))
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))
If BSelect Then temp = BSelect Else temp = 0
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 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 oldalt <> alt And alt < 0 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%: oldalt = alt
Loop
Sub MyMouse_and_Keyboard (lb, mb, rb, my, mx, mw, shift%, alt, AltToggle, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$, nob, button$())
Dim As Integer i, oldmw
Static As Integer oldmy, oldmx, b_hover, mwy, oldmwy, b_former
Static z1 As Single
_Limit 60
If alt Then alt = 0
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Exit Sub
Else
k& = _KeyHit
If k& = 100307 Or k& = 100308 Then
alt = -1
AltToggle = 1 - AltToggle
Exit Sub
End If
If k& > 0 Then
b$ = MKI$(k&)
If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and alt.
If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
Else
b$ = ""
End If
End If
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1
Else
lb = 0
If BSelect Then BSelect = 0
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel
Wend
my = _MouseY
mx = _MouseX
j = b_hover: b_hover = 0
If mapping Then
If Len(mRow$(my)) Then
If Mid$(mRow$(my), mx, 1) <> Chr$(32) Then
b_hover = Asc(Mid$(mRow$(my), mx, 1)) - 96
b_former = j
End If
End If
Else
For i = 1 To nob ' number of buttons.
If my >= y_btl(i) And my <= y_bbr(i) And mx >= x_btl(i) And mx <= x_bbr(i) Then
b_hover = i
b_former = j
Exit For
End If
Next
End If
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0
If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1 Else If ctrl% Then ctrl% = 0
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1 Else If alt% Then alt% = 0
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1: z1 = Timer
clkcnt = clkcnt + 1
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
If ButtonStyle = 3 Then
If demo Then i2 = 3: i3 = 4 Else i2 = 1: i3 = nob
For i = i2 To i3
If b_hover <> i Then
j = Len(button$(i))
_Dest overlay
Line (8 * (x(i) - 1), 16 * (y(i) - 1) + 7)-((j + 2) * 8 + 8 * (x(i) - 1), 16 * 2 + 16 * (y(i) - 1) + 7), _RGB32(BHybBdr1, BHybBdr1, BHybBdr1), B
Line (8 * (x(i) - 1) + 8, 16 * (y(i) - 1) + 15)-((j + 1) * 8 + 8 * (x(i) - 1), y(i) * 16 + 15), _RGB32(BHybBdr2, BHybBdr2, BHybBdr2), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage Overlay_Hardware
End If
Next
End If
If b_former And b_former <> b_hover Then ' Remove hover effect.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(button$(b_former))
Select Case ButtonStyle
Case 1
Color BBdr, Bg
Locate y_btl(b_former), x_btl(b_former): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x_btl(b_former): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x_btl(b_former): Print Chr$(192) + String$(j, 196) + Chr$(217);
Case 2
Color BBg1, Bg
Locate y_btl(b_former) - 1, x_btl(b_former): Print String$(j, 220);
Locate y_btl(b_former) + 1, x_btl(b_former): Print String$(j, 223);
Color BFg, BBg1
Locate y_btl(b_former), x_btl(b_former): Print button$(b_former);
Case 3
i = b_former
j = Len(button$(b_former))
_Dest overlay
Line (8 * (x(i) - 1) + 2, 16 * (y(i) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(i) - 1) - 2, 16 * 2 + 16 * (y(i) - 1) + 7 - 2), _RGB32(155, 155, 155), B
Line (8 * (x(i) - 1), 16 * (y(i) - 1) + 7)-((j + 2) * 8 + 8 * (x(i) - 1), 16 * 2 + 16 * (y(i) - 1) + 7), _RGB32(BHybBdr1, BHybBdr1, BHybBdr1), B
Line (8 * (x(i) - 1) + 8, 16 * (y(i) - 1) + 15)-((j + 1) * 8 + 8 * (x(i) - 1), y(i) * 16 + 15), _RGB32(BHybBdr2, BHybBdr2, BHybBdr2), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage Overlay_Hardware
Color BHybFg, BHybBg2
Locate y_btl(i) + 1, x_btl(i) + 1: Print button$(i);
End Select
b_former = 0
ButtonStyle = 0
Color c1, c2
Locate s1, s2
ElseIf b_hover Then ' Add hover effect.
If demo Then
Select Case b_hover
Case 1, 2: ButtonStyle = 1
Case 3, 4: ButtonStyle = 3
Case 5, 6: ButtonStyle = 4
Case 7, 8: ButtonStyle = 2
Case 9, 10: ButtonStyle = 5
End Select
End If
Select Case lb
Case 0, -1, 1 ' Button clicked. Flash effect.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(button$(b_hover))
Select Case ButtonStyle
Case 1
If Abs(lb) = 1 Then Color BBdrFlash, Bg Else Color BBdrHover, Bg
Locate y_btl(b_hover), x_btl(b_hover): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x_btl(b_hover): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x_btl(b_hover): Print Chr$(192) + String$(j, 196) + Chr$(217);
Rem Locate y_btl(b_hover) + 1, x_btl(b_hover) + 1: Print button$(b_hover);
Case 2
If Abs(lb) = 1 Then Color BBgFlash, Bg Else Color BHvrFg, Bg
Locate y_btl(b_hover) - 1, x_btl(b_hover): Print String$(j, 220);
Locate y_btl(b_hover) + 1, x_btl(b_hover): Print String$(j, 223);
If Abs(lb) = 1 Then Color BFgFlash, BBgFlash Else Color BFg, BBg
Locate y_btl(b_hover), x_btl(b_hover): Print button$(b_hover);
Case 3
i = b_hover
j = Len(button$(b_hover))
If Abs(lb) = 1 Then
Color Bg, BHybFg
Locate y_btl(b_hover) + 1, x_btl(b_hover) + 1: Print button$(b_hover);
Else
Color BHybFg, BHybBg2
Locate y_btl(b_hover) + 1, x_btl(b_hover) + 1: Print button$(b_hover);
_Dest overlay
Line (8 * (x(i) - 1) + 2, 16 * (y(i) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(i) - 1) - 2, 16 * 2 + 16 * (y(i) - 1) + 7 - 2), _RGB32(0, 155, 155), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage Overlay_Hardware
End If
End Select
Color c1, c2
Locate s1, s2
Case 2 ' Button selection completed.
BSelect = b_hover
End Select
End If
If demo Or ButtonStyle = 4 Then
If demo Then i2 = 5: i3 = 6 Else i2 = 1: i3 = nob
For i = i2 To i3
j = Len(button$(i)): a$ = " " + button$(i) + " "
Gdown = Button_HW(j * 8, 2 * 16, 170, 170, 170, -9, -9, -1, Mid$(a$, 1, j))
Ghover = Button_HW(j * 8, 2 * 16, 200, 200, 200, -8, -7, -1, Mid$(a$, 1, j))
Gdrag = Button_HW(j * 8, 2 * 16, 200, 200, 200, -1, -1, -1, Mid$(a$, 1, j))
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
If lb = 0 And b_hover = i Then
_PutImage ((x(i) - 1) * 8, (y(i) - 1) * 16 + 8), Ghover
ElseIf Abs(lb) = 1 And b_hover = i Then
_PutImage ((x(i) - 1) * 8, (y(i) - 1) * 16 + 8), Gdrag
Else
_PutImage ((x(i) - 1) * 8, (y(i) - 1) * 16 + 8), Gdown
End If
_FreeImage Ghover
_FreeImage Gdrag
_FreeImage Gdown
_FreeImage Overlay_Hardware
Next
End If
If demo Or ButtonStyle = 5 Then
If demo Then i2 = 9: i3 = 10 Else i2 = 1: i3 = nob
For i = i2 To i3
_Dest overlay
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
If lb = 0 And b_hover = i Then
img& = _LoadImage(button$(i) + "-hover.png", 32)
_PutImage ((x(i) - 1) * 8 + 4, (y(i) - 1) * 16), img&
ElseIf Abs(lb) = 1 And b_hover = i Then
img& = _LoadImage(button$(i) + "-active.png", 32)
_PutImage ((x(i) - 1) * 8 + 4, (y(i) - 1) * 16), img&
Else
img& = _LoadImage(button$(i) + "-static.png", 32)
_PutImage ((x(i) - 1) * 8 + 4, (y(i) - 1) * 16), img&
End If
_Dest 0
_FreeImage img&
_FreeImage Overlay_Hardware
Next
End If
If demo Then
q1 = CsrLin: q2 = Pos(0)
Locate 3, 49: Print "Hover ="; b_hover; " Button Style ="; ButtonStyle;
Locate q1, q2
End If
oldmy = my: oldmx = mx
_Display
End Sub
Sub cal_mapit (a$, mapid)
Static initiate As Integer, mapnbr As Integer
If initiate = 0 Then
initiate = 1
ReDim mRow$(_Height)
mapnbr = 96
End If
If mapping And mRow$(CsrLin) = "" Then mRow$(CsrLin) = Space$(_Width)
Select Case mapid
Case 1
mapnbr = mapnbr + 1 ' Advance.
y_btl(mapnbr - 96) = CsrLin: x_btl(mapnbr - 96) = Pos(0)
Case 2
y_bbr(mapnbr - 96) = CsrLin: x_bbr(mapnbr - 96) = Pos(0) + Len(a$)
Case 3
mapnbr = mapnbr + 1 ' Advance.
y_btl(mapnbr - 96) = CsrLin
x_btl(mapnbr - 96) = Pos(0)
y_bbr(mapnbr - 96) = CsrLin
x_bbr(mapnbr - 96) = Pos(0) + Len(a$)
Case -4
mapnbr = mapnbr + 1 ' Advance.
y_btl(mapnbr - 96) = CsrLin
x_btl(mapnbr - 96) = Pos(0)
y_bbr(mapnbr - 96) = CsrLin + Asc(Mid$(a$, 1, 1))
x_bbr(mapnbr - 96) = Pos(0) + Len(a$)
Case -1
' Do nothing.
End Select
If mapping Then Mid$(mRow$(CsrLin), Pos(0)) = String$(Len(a$), Chr$(mapnbr))
If mapid > -1 Then Print a$;
End Sub
Sub button_maker (a$, y, x, btype)
Static btnnbr
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(a$)
btnnbr = btnnbr + 1
ReDim _Preserve y_btl(btnnbr), x_btl(btnnbr), y_bbr(btnnbr), x_bbr(btnnbr), button$(btnnbr)
button$(btnnbr) = String$(j, 0) ' Fill any spaces with the null character.
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(a$))) \ 2) = _Trim$(a$)
Select Case btype
Case 0 ' No frills
y = Abs(y)
Color BFg, BBg1: Locate y, x: a$ = button$(btnnbr): cal_mapit a$, 3
Color BBg1, Bg: Locate y - 1, x: a$ = String$(j, Chr$(220)): cal_mapit a$, 0
Locate y + 1, x: a$ = String$(j, Chr$(223)): cal_mapit a$, 0
Case 1 ' Text
Color BBdr, Bg
Locate y - 1, x - 1: a$ = Chr$(218) + String$(j, 196) + Chr$(191): cal_mapit a$, 1
Locate y, x - 1: a$ = Chr$(179): cal_mapit a$, 0
Locate , Pos(0) + j: a$ = Chr$(179): cal_mapit a$, 0
Locate y + 1, x - 1: a$ = Chr$(192) + String$(j, 196) + Chr$(217): cal_mapit a$, 2
Locate y, x: a$ = button$(btnnbr): cal_mapit a$, 0
Case 2 ' Hybrid.
Dim b(15) As String * 1
b(0) = Chr$(0)
b(1) = "Ú"
b(2) = "Ä"
b(3) = "¿"
b(4) = "³"
b(5) = "À"
b(6) = "Ù"
b(7) = "Ã"
b(8) = "´"
b(9) = "Ä"
b(10) = "Â"
b(11) = "Á"
b(12) = "Þ"
b(13) = "Ý"
b(15) = "ß"
b(14) = "Ü"
j = Len(a$)
i = btnnbr
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr)
y(i) = y - 1: x(i) = x - 1
button$(i) = String$(j, 0)
Mid$(button$(i), 1 + (j - Len(_Trim$(a$))) / 2) = _Trim$(a$)
Locate y - 1, x - 1: Color BHybBg1, Bg: a$ = String$(j + 2, b(14)): cal_mapit a$, 1
Locate y, x - 1: Color Bg, BHybBg1: a$ = String$(j + 2, b(0)): cal_mapit a$, 0
Locate y + 1, x - 1: Color BHybBg1, Bg: a$ = String$(j + 2, b(15)): cal_mapit a$, 2
Locate y, x: Color BHybFg, BHybBg2: a$ = button$(i): cal_mapit a$, 0
_Dest overlay
Line (8 * (x(i) - 1) + 2, 16 * (y(i) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(i) - 1) - 2, 16 * 2 + 16 * (y(i) - 1) + 7 - 2), _RGB32(155, 155, 155), B
Line (8 * (x(i) - 1), 16 * (y(i) - 1) + 7)-((j + 2) * 8 + 8 * (x(i) - 1), 16 * 2 + 16 * (y(i) - 1) + 7), _RGB32(BHybBdr1, BHybBdr1, BHybBdr1), B
Line (8 * (x(i) - 1) + 8, 16 * (y(i) - 1) + 15)-((j + 1) * 8 + 8 * (x(i) - 1), y(i) * 16 + 15), _RGB32(BHybBdr2, BHybBdr2, BHybBdr2), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage Overlay_Hardware
Case 3
j = Len(a$)
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr)
y(btnnbr) = y - 1: x(btnnbr) = x - 1
button$(btnnbr) = String$(j + 2, 0)
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(a$))) / 2) = _Trim$(a$)
Locate y - 1, x - 1: cal_mapit button$(btnnbr), -4
Locate y, x - 1: cal_mapit button$(btnnbr), -1
Locate y + 1, x - 1: cal_mapit button$(btnnbr), -1
Case 4
img& = _LoadImage("activate-static.png", 32)
j = _Width(img&): i = _Height(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
_FreeImage img&
button$(btnnbr) = _Trim$(a$)
a$ = String$(j, i)
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr)
y(btnnbr) = y - 1: x(btnnbr) = x - 1
Locate y - 1, x - 1: cal_mapit a$, -4
For k = 0 To i - 2
Locate y + k, x - 1: cal_mapit a$, -1
Next
End Select
nob = btnnbr ' Number of buttons becomes a global variable here.
Color c1, c2
Locate y, x
End Sub
Sub print_array (a$)
Static cnt
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$
Print a$(cnt);
End If
End Sub
Function Button_HW (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$
Button_HW = _CopyImage(t, 33)
_FreeImage t
_Dest Dest
End Function
Pete
|
