Updated to include tab function for fields and buttons. I split the button effects from the mouse.
Pete
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 SubPete