Last updated 4/3/25
GUI Demo in Screen 0 with a mix of hardware buttons, software buttons, cut/copy/paste popup,working text input, screen idle, and other effects added.
What's neat is the shadow effect of the popup to appear as 3-D works over both hardware and software images. It simple dims everything it over-shadows, which is better than can be done in SCREEN 0 without hardware access.
Demo: Press keys, hold keys like ctrl, click mouse, use wheel, hover/click buttons, drag, left click inside text input AT BOTTOM Text: ____
This version uses a software popup menu with a hardware shadow. CAUTION: This version Saves / Overwrites an image file to your local directory named: temp7a3b4.png (The odds of you having a file by that name should be minuscule).
This version uses a hardware popup menu.
Pete
GUI Demo in Screen 0 with a mix of hardware buttons, software buttons, cut/copy/paste popup,working text input, screen idle, and other effects added.
What's neat is the shadow effect of the popup to appear as 3-D works over both hardware and software images. It simple dims everything it over-shadows, which is better than can be done in SCREEN 0 without hardware access.
Demo: Press keys, hold keys like ctrl, click mouse, use wheel, hover/click buttons, drag, left click inside text input AT BOTTOM Text: ____
This version uses a software popup menu with a hardware shadow. CAUTION: This version Saves / Overwrites an image file to your local directory named: temp7a3b4.png (The odds of you having a file by that name should be minuscule).
Code: (Select All)
Dim Shared PopDrg, FlattenImage&
Dim Shared demo As Integer, clean As _Bit
ReDim Shared text$(0), textlen(0), textlenmax(0), 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), bl3(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), BStyle(0)
Type fields_and_buttons
a As String
pad 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
SkipAct As Integer
idle As Single
PopStatus As Integer
HardwareBg As Long
' Style
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
B3TxtRed As Integer
B3TxtGrn As Integer
B3TxtBlu As Integer
B3OutRed As Integer
B3OutGrn As Integer
B3OutBlu As Integer
B3InRed As Integer
B3InGrn As Integer
B3InBlu 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
' Input Types
CurStyle As Integer
CurShow As Integer
hl1 As Integer
hl2 As Integer
InputField As Integer
mhovery As Integer
mhoverx As Integer
mvar As Integer
mtop As Integer
mleft As Integer
myclose As Integer
mxclose As Integer
page_color As Integer
skin_frg As Integer
skin_bkg As Integer
input_frg As Integer
input_bkg As Integer
skin_shadow_frg As Integer
skin_shadow_bkg As Integer
mwidth As Integer
mheight As Integer
' Popup Colors
cp2 As Integer ' Popup background.
cp4 As Integer ' Popup shadow.
cp1 As Integer ' Available menu item.
cp3 As Integer ' Unavailable menu item.
End Type
Dim fb As fields_and_buttons
demo = 1
If demo Then
Width 80, 35
fb_palette fb
_ScreenMove 0, 0
Color 0, fb.Bg: Cls
Input "Choose a button mapping method 0 or 1: ", fb.mapping
Cls
GoTo start
End If
fb_palette fb
' Begin User Routine.
fb.a = " Button Hybrid ": fb_make fb, 4, 31, 3
fb.a = " Button Graphics ": fb_make fb, 8, 31, 4
fb.a = " Button Text ": fb_make fb, 12, 31, 2
fb.a = " Button Text ": fb_make fb, 15, 31, 1
fb.a = " Button HTML ": fb_make fb, 19, 31, 5
fb.a = "Text:": fb_fields fb, _Height - 4, 31, 15, 15, "Text goes here."
fb.a = "More Text:": fb_fields fb, _Height - 2, 31, 30, 50, "Additional Text goes here."
start:
Do
fb_control fb, b$, mx, my, lb, mb, rb, drag
Loop
Sub fb_control (fb As fields_and_buttons, b$, mx, my, lb, mb, rb, drag)
Static initiate As Integer, z1, door, autokey$ ' autokey$ needs to either be preserved here or passed back.
If initiate = 0 Then
initiate = 1
fb_palette fb
If demo Then
fb.nof = 0: fb.nob = 0: fb.tabmax = 0
ReDim fld$(0), FType(0), btnmap(0), btnfld(0), BStyle(0)
ReDim y1(0), x1(0), y2(0), x2(0), button$(0)
clean = -1: fb_fields fb, y, x, length, lengthmax, filler$
clean = -1: fb_map fb, mapid
clean = -1: fb_make fb, y, x, ButtonStyle
Dim nul As String * 1 ' Used only for demo.
fb_demo fb, nul$, lb, mb, rb, mw, my, mx
End If
If fb.idle = 0 Then If fb.SkipAct = 0 Then fb.idle = 15 ' 15-second Default.
End If
If FlattenImage& Then If fb.PopStatus = 0 Then FlattenImage& = 0: PCopy 2, 0 ' Full cycle
MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
If FlattenImage& Then _PutImage (0, 0), FlattenImage&
If act Or Abs(z1 - Timer) < fb.idle Or fb.SkipAct <> 0 Then
If door = -1 Then
_PaletteColor 5, _RGB32(255, 255, 255, 0)
Palette 6, 63
End If
If fb.SkipAct = 0 Then If act Then z1 = Timer
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
door = 0
Else
If door = 0 Then
_PaletteColor 5, _RGB32(215, 215, 215, 235)
_PaletteColor 6, _RGB32(205, 205, 205)
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
_Limit 10
End If
door = -1
End If
End Sub
Sub fb_palette (fb As fields_and_buttons)
' Reserved colors 3, 5, 6.
_PaletteColor 3, _RGB32(0, 0, 0, 70) ' Popup shadow.
_PaletteColor 5, _RGB32(255, 255, 255, 0) ' Software page color (Transparent).
_PaletteColor 0, _RGB32(10, 10, 10) ' Needed to separate black for png _saveimage transperancy.
Palette 6, 63 ' Bright white for background uses.
' Button Colors.
fb.Fg = 0
fb.Bg = 5
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 = 7: fb.B1HvrBg = 7: fb.B1FlashFg = 1: fb.B1FlashBg = 7
fb.B2BdrFg = 8: fb.B2BdrHover = 1: fb.B2BdrFlash = 9
fb.B3OutRed = 95: fb.B3OutGrn = 95: fb.B3OutBlu = 95
fb.B3InRed = 155: fb.B3InGrn = 155: fb.B3InBlu = 155
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
' Input Field Colors
fb.page_color = _BackgroundColor
fb.input_frg = 15
fb.input_bkg = 0
fb.hl1 = 15 ' Highlight text forground.
fb.hl2 = 1 ' Highlight text background.
fb.skin_frg = 0 ' These next 4 are for popup input windows, not full page.
fb.skin_bkg = 5
fb.skin_shadow_frg = 8
fb.skin_shadow_bkg = 0
' Popup Colors
fb.cp2 = 6 ' Popup background.
fb.cp4 = 3 ' Popup shadow.
fb.cp1 = 0 ' Available menu item.
fb.cp3 = 7 ' Unavailable menu item.
End Sub
Sub fb_screencopy
_SaveImage "temp7a3b4.png"
temp& = _LoadImage("temp7a3b4.png", 32)
t& = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)
_Dest t&
Cls , _RGB32(255, 255, 255)
_ClearColor _RGB32(0, 0, 0), temp& ' Make the black non-image areas transparent.
_PutImage (0, 0), temp&
FlattenImage& = _CopyImage(t&, 33)
_FreeImage t&
_FreeImage temp&
_Dest 0
End Sub
Sub fb_main (fb As fields_and_buttons, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$)
Static BTabHl As Integer, chngfld As Integer
s1 = CsrLin: s2 = Pos(0)
b_hover = 0: fb.fld = 0: fb.BSelect = 0
If fb.mapping Then ' Background was mapped.
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 ' Input field.
fb.fld = i
Case 5 ' Button.
fb.fld = i
b_hover = btnmap(fb.fld)
Exit For
End Select
End If
Next
End If
If lb = 1 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)
If Abs(chngfld) <> fb.tb Then chngfld = fb.tb
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
End If
For k = 1 To fb.nob
If demo Then BStyle(k) = (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 And fb.PopStatus = 0 Then ' Display button on Tab selection.
Select Case BStyle(k)
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
_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 ' Display all buttons standard, hover, or selected.
Select Case BStyle(k)
Case 1
If fb.PopStatus = 0 Then
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
End If
Case 2
If fb.PopStatus = 0 Then
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);
End If
Case 3
If h = 0 And b_hover = k And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl2(k)
ElseIf Abs(h) And b_hover = k And fb.PopStatus = 0 Or fb.SimClick = k And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl3(k)
If h = 2 Then fb.BSelect = k
Else
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl1(k)
End If
Case 4
If h = 0 And b_hover = k And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx2(k)
ElseIf Abs(h) And b_hover = k And fb.PopStatus = 0 Or fb.SimClick = k And fb.PopStatus = 0 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 And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h2(k)
ElseIf Abs(h) And b_hover = k And fb.PopStatus = 0 Or fb.SimClick = k And fb.PopStatus = 0 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
Select Case FType(fb.tb)
Case 1
fb_field_input fb, chngfld, tabmap(fb.tb), lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, autokey$
Case 5
If b_hover = 0 Or force Then If fb.PopStatus = 0 Then BTabHl = btnmap(fb.tb)
End Select
If demo And fb.PopStatus = 0 Then
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$(BStyle(b_hover))); 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
_Display
Locate s1, s2, 0 ' Hide cursor
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, lengthmax, filler$)
Static initiate As Integer, cnt As Integer
If initiate = 0 Or clean Then
initiate = 1
cnt = 0
If fb.Bg <> _BackgroundColor Then Color fb.Fg, fb.Bg: Cls
If clean Then clean = 0: initiate = 0: Exit Sub
End If
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
fb.nof = fb.nof + 1: fb.tabmax = fb.tabmax + 1: cnt = cnt + 1
ReDim _Preserve text$(fb.nof), textlen(cnt), textlenmax(cnt), 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) = 1
textlen(cnt) = length
textlenmax(cnt) = lengthmax
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
text$(cnt) = filler$
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 initiate As Integer, btnnbr As Integer
If initiate = 0 Or clean Then
initiate = 1
btnnbr = 0
If fb.Bg <> _BackgroundColor Then Color fb.Fg, fb.Bg: Cls
If clean Then clean = 0: initiate = 0: Exit Sub
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), BStyle(fb.nof)
BStyle(fb.nof) = ButtonStyle ' Passed variable from main.
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 BStyle(fb.nof)
Case 1 ' Single line button with blank border. 3-rows tall and name, with space ends, wide.
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. 3-rows tall and name, with space ends, wide.
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. 3-rows tall and name, with space ends + 2, wide.
fb.pad = 2 ' Add button style padding.
j = Len(fb.a)
k = btnnbr
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), bl1(btnnbr), bl2(btnnbr), bl1(btnnbr), bl3(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: fb_map fb, 6
Locate y, x - 1: fb_map fb, -1
Locate y + 1, x - 1: 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.B3OutRed, fb.B3OutGrn, fb.B3OutBlu), BF
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), BF
Color _RGB32(fb.B3TxtRed, fb.B3TxtGrn, fb.B3TxtBlu), _RGB32(fb.B3InRed, fb.B3InGrn, fb.B3InBlu): _PrintString (_FontWidth, _FontHeight), fb.a
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.B3OutRed, fb.B3OutGrn, fb.B3OutBlu), BF
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), BF
Color _RGB32(fb.B3TxtRed, fb.B3TxtGrn, fb.B3TxtBlu), _RGB32(fb.B3InRed, fb.B3InGrn, fb.B3InBlu): _PrintString (_FontWidth, _FontHeight), fb.a
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
t& = _NewImage((j + 3) * 8, 4 * 16, 32)
_Dest t&
Rem _PutImage (0, 0), bl1(btnnbr)
Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(fb.B3OutRed, fb.B3OutGrn, fb.B3OutBlu), BF
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), BF
Color _RGB32(fb.B3InRed, fb.B3InGrn, fb.B3InBlu), _RGB32(fb.B3TxtRed, fb.B3TxtGrn, fb.B3TxtBlu): _PrintString (_FontWidth, _FontHeight), fb.a
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
bl3(btnnbr) = _CopyImage(t, 33)
_FreeImage t&
_Dest 0
Case 4 ' Graphics button.
fb.pad = 2 ' Add button style padding.
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)
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
caption$ = Mid$(" " + fb.a + " ", 1, j + fb.pad)
gfx1(btnnbr) = fb_gfx((j + fb.pad) * 8, 2 * 16, 170, 170, 170, -9, -9, -1, caption$)
gfx2(btnnbr) = fb_gfx((j + fb.pad) * 8, 2 * 16, 200, 200, 200, -8, -7, -1, caption$)
gfx3(btnnbr) = fb_gfx((j + fb.pad) * 8, 2 * 16, 200, 200, 200, -1, -1, -1, caption$)
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
fb.pad = 0 ' Remove any button style padding.
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 initiate As Integer, mapfld As Integer
If initiate = 0 Or clean Then
initiate = 1
ReDim mRow$(_Height)
mapfld = 96
If clean Then clean = 0: initiate = 0: Exit Sub
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) + fb.pad, Chr$(mapfld))
If mapid < 6 And mapid > -1 Then Print fb.a;
End Sub
Sub fb_field_input (fb As fields_and_buttons, chngfld As Integer, ifield, lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, autokey$) ' Single line keyboard routine for input.
Static initiate, ml, mr, y, x, ovw, hscr, restore_color1, restore_color2
Static hl, string_pos, mhover_close, s1color, s2color
Static mhlinput As _Bit, popit
Static restricted_keys$
Static flen(), yfield(), xfield(), maxflen(), menu$()
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
If initiate = 0 Then
initiate = 1
End If
If initiate = 1 Or chngfld > 0 Then
initiate = 2
If hl Then Locate y, x: GoSub hl_off
b$ = "" ' Needed to prevent an autokey event if tab was used to open this input field.
Locate y1(fb.tb), x1(fb.tb)
Color fb.input_frg, fb.input_bkg ' Initiate input text color.
fb.InputField = ifield: If fb.InputField = 0 Then fb.InputField = 1
ReDim _Preserve yfield(fb.InputField) ' Row.
ReDim _Preserve xfield(fb.InputField) ' Column.
ReDim _Preserve flen(fb.InputField) ' Field length.
ReDim _Preserve maxflen(fb.InputField) ' Max text length.
flen(fb.InputField) = textlen(fb.InputField)
maxflen(fb.InputField) = textlenmax(fb.InputField)
yfield(fb.InputField) = CsrLin
xfield(fb.InputField) = Pos(0)
If fb.CurStyle = 0 Then fb.CurStyle = 7: fb.CurShow = 1 ' Default cursor.
hscr = 0: fb.mhovery = 0: fb.mhoverx = 0: mhlinput = 0
ml = Pos(0)
mr = ml + flen(fb.InputField)
If chngfld > 0 Then
chngfld = -chngfld
If lb <> 0 Then Locate my, mx
End If
y = CsrLin: x = Pos(0) ' Initial cursor position.
fb.CurShow = 1: Locate y, x, fb.CurShow, 7, fb.CurStyle ' Show cursor.
End If
Color fb.input_frg, fb.input_bkg: Locate y, x, 1
If PopDrg Then If drag = 0 Then PopDrg = -1: popit = -1 Else popit = -1
If popit Then
fb.CurShow = 0: Locate , , fb.CurShow ' Hide cursor
fb_input_popup fb, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$
If popit = 0 Then fb.CurShow = 1: Locate , , fb.CurShow, 7, fb.CurStyle ' Show cursor
If b$ = "" Then Exit Sub Else autokey$ = b$: b$ = "" ' Note: Do not exit sub here.
Else
Do
string_pos = Pos(0) - ml ' Track text position from 0 to maxflen(fb.InputField).
If InStr(restricted_keys$, LCase$(b$)) And Len(b$) = 1 Then
_MessageBox " Invalid character.", "File names cannot contain the following characters: " + restricted_keys$, "info"
b$ = ""
End If
If fb.myclose Then ' Self contained close on x click routine. Includes hover and left click release.
If my = fb.myclose And mx = fb.mxclose Or mhover_close Then
If mhover_close And lb = 2 Then Exit Do ' Close popup and exit input routine.
y = CsrLin: x = Pos(0)
s1color = _DefaultColor: s2color = _BackgroundColor
j = mhover_close
If my = fb.myclose And mx = fb.mxclose Then
If mhover_close = 0 Then Color fb.skin_bkg, 4: mhover_close = 1
Else
If mhover_close Then Color fb.skin_frg, fb.skin_bkg: mhover_close = 0
End If
If j <> mhover_close Then
Locate fb.myclose, fb.mxclose - 1: Print " x ";
Color s1color, s2color
Locate y, x
End If
End If
End If
If mhlinput Then If drag = 0 And lb = 0 Then mhlinput = 0 ' Quit mouse input line highlighting.
If lb > 0 Or drag Then ' Mouse button events.
Do
If drag Then
If my = yfield(fb.InputField) Or mhlinput Then
If mx >= ml - hscr And mx <= ml + Len(text$(fb.InputField)) - hscr Or mhlinput Then
mhlinput = -1
If drag > 0 Then
If mx > Pos(0) - 1 Then
shift% = -1: GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
y = CsrLin: x = Pos(0)
End If
Else
If mx < Pos(0) Then
shift% = -1: GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
y = CsrLin: x = Pos(0)
End If
End If
End If
Exit Do
End If
End If
If lb = 1 Or clkcnt > 1 Then
For i = 1 To UBound(yfield) ' Find input line.
If my = yfield(i) And mx >= xfield(i) And mx <= xfield(i) + flen(i) Then ' Mouse cursor in an input field.
If hl Then GoSub hl_off '|--------------->
Rem If i <> 1 Then If text$(1) = "" Then Beep: Exit Do ' Uniqueue restriction when no text is present in first input field.
fb.InputField = i
If clkcnt > 1 Then
GoSub select_all '|--------------->
Else
GoSub mouse_click_relocate '|--------------->
End If
y = CsrLin: x = Pos(0)
Exit For
End If
Next
Exit Do
End If
If lb = 2 Then ' Mouse button pressed and released.
'</----------------------- USER DEFINED ROUTINE -----------------------/>
Exit Do
End If
Exit Do
Loop
End If
If rb = 2 Then ' Right mouse button released.
If textlenmax(fb.InputField) Then ' Only open popup if the field accepts input.
If fb.mvar < 1 Then
If my <> yfield(fb.InputField) Then ' Check for change input field click.
For i = 1 To UBound(yfield)
If my = yfield(i) Then ' Change input fields.
Rem If i <> 1 Then If text$(1) = "" Then Beep: Exit Do ' Uniqueue restriction when no text is present in first input field.
If i <> fb.InputField Then ' Remove any highlighting if input line is being changed.
If hl Then GoSub hl_off '|--------------->
End If
fb.InputField = i
GoSub mouse_click_relocate '|--------------->
Exit For
End If
Next
End If
popit = -1
End If
End If
End If
Exit Do ' Flow through.
Loop
End If
If Len(b$) Then
Select Case b$
Case Chr$(27) ' Esc key.
Rem Exit Do ' Leave sub.
Case Chr$(9), Chr$(13) ' Tab or Enter key.
initiate = 1
If hl Then GoSub hl_off '|--------------->
autokey$ = Chr$(9)
Rem Exit Do ' Leave sub.
Case Chr$(8) ' Backspace key.
GoSub backspace '|--------------->
Case Chr$(0) + "S" ' Delete key.
GoSub delete '|--------------->
Case Chr$(0) + "M" ' Arrow right key.
GoSub cursor_forward '|--------------->
Case Chr$(0) + "K" ' Arrow left key.
GoSub cursor_back '|--------------->
Case Chr$(0) + "t" ' Ctrl + Arrow right key.
GoSub ctrl_rt '|--------------->
Case Chr$(0) + "s" ' Ctrl + Arrow left key.
GoSub ctrl_lt '|--------------->
Case Chr$(0) + "G" ' Home
GoSub cur_home '|--------------->
Case Chr$(0) + "O" ' End
GoSub cur_end '|--------------->
Case Chr$(0) + "R" ' Insert/overwrite toggle.
ovw = 1 - ovw
If ovw Then fb.CurStyle = 30 Else fb.CurStyle = 7
Locate , , fb.CurShow, 7, fb.CurStyle ' Change cursor appearance. Assumes cursor is shown, not hidden.
Case Chr$(22) ' Ctrl + V - Paste
GoSub paste '|--------------->
Case Chr$(3) ' Ctrl + C - Copy
GoSub copy '|--------------->
Case Chr$(24) ' Ctrl + X - Cut
GoSub cut '|--------------->
Case Chr$(1) ' Select all.
GoSub select_all '|--------------->
Case Chr$(32) To "z"
GoSub print_chr '|--------------->
End Select
y = CsrLin: x = Pos(0) ' Track cursor.
End If
Color restore_color1, restore_color2
If popit <> 0 Or PopDrg <> 0 Then fb.PopStatus = 1 Else fb.PopStatus = 0
Exit Sub
print_chr:
If hl Then GoSub cut '|--------------->
string_pos = Pos(0) - ml
If string_pos + ml < mr - 1 And Len(text$(fb.InputField)) < flen(fb.InputField) - 1 Then
If ml + Len(text$(fb.InputField)) < mr Then
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, string_pos) + b$ + Mid$(text$(fb.InputField), string_pos + 1 + ovw)
Locate , ml: Print Space$(flen(fb.InputField));: Locate , ml
Print text$(fb.InputField);
Locate , ml + string_pos + 1
End If
Else ' Horizontal scrolling.
If Len(text$(fb.InputField)) < maxflen(fb.InputField) Then
If string_pos = flen(fb.InputField) - 1 Or string_pos = flen(fb.InputField) - 2 And string_pos < Len(text$(fb.InputField)) - hscr - 1 Then
j = 1 ' At right margin.
Else
j = 0
End If
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + b$ + Mid$(text$(fb.InputField), hscr + string_pos + 1 + ovw)
hscr = hscr + j
Locate , ml
If ovw Then Print Space$(flen(fb.InputField));: Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , ml + string_pos + 1 - j
End If
End If
Return
backspace:
If hl And shift% = 0 Then GoSub cut: Return '|--------------->
If string_pos = 0 And hscr > 0 Or string_pos > 0 Then
If hl Then GoSub hl_off '|--------------->
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos - 1) + Mid$(text$(fb.InputField), hscr + string_pos + 1)
If hscr Then hscr = hscr - 1: j = 0 Else j = 1
Locate , ml: Print Space$(flen(fb.InputField));
Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , x - j
End If
Return
delete:
If hl Then
GoSub cut '|--------------->
Else
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + Mid$(text$(fb.InputField), hscr + string_pos + 2)
Locate , ml: Print Space$(flen(fb.InputField));
Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , x
End If
Return
cur_home:
Do
GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
Loop Until hscr = 0 And string_pos = 0
Return
cur_end:
Do
GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
Loop Until string_pos + 1 > Len(text$(fb.InputField)) - hscr
Return
cursor_forward:
If hl And shift% = 0 Then GoSub hl_off '|--------------->
If string_pos + 1 <= Len(text$(fb.InputField)) - hscr Then
If ml + string_pos + 1 = mr And Len(text$(fb.InputField)) >= flen(fb.InputField) And shift% = 0 Then
hscr = hscr + 1
Locate , ml: Print Space$(flen(fb.InputField));: Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
If string_pos <> Len(text$(fb.InputField)) - hscr Then Locate , Pos(0) - 1
ElseIf shift% And string_pos < Len(text$(fb.InputField)) - hscr Then
If string_pos = flen(fb.InputField) - 1 Then
hscr = hscr + 1
Color fb.input_frg, fb.input_bkg
Locate , ml: Print Space$(flen(fb.InputField));: Locate , ml
If string_pos - hl > flen(fb.InputField) Then
Print Mid$(text$(fb.InputField), hscr + 1, (flen(fb.InputField)) - 1);
Else
Print Mid$(text$(fb.InputField), hscr + 1, string_pos - hl - 1);
End If
If hl < 0 Then Color fb.input_frg, fb.input_bkg Else Color fb.hl1, fb.hl2
hl = hl + 1
If Pos(0) = ml Then
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField) - 1);
Else
Print Mid$(text$(fb.InputField), hscr + 1 + string_pos - hl, (flen(fb.InputField)) - (string_pos - hl) - 1);
End If
Else
If hl < 0 Then Color fb.input_frg Else Color fb.hl1, fb.hl2
hl = hl + 1
Print Mid$(text$(fb.InputField), hscr + string_pos + 1, 1);
End If
Else
If hl Then GoSub hl_off '|--------------->
If Pos(0) < mr Then Locate , Pos(0) + 1
End If
Color fb.input_frg
End If
Return
cursor_back:
If hl And shift% = 0 Then GoSub hl_off '|--------------->
If string_pos = 0 And shift% = 0 Then
If hscr Then hscr = hscr - 1: Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));: Locate , ml
ElseIf shift% Then
If string_pos = 0 Then
If hscr Then
hscr = hscr - 1
If hl > 0 Then Color fb.input_frg, fb.input_bkg Else Color fb.hl1, fb.hl2
hl = hl - 1
j = Abs(hl): If j > (flen(fb.InputField)) Then j = flen(fb.InputField)
Print Mid$(text$(fb.InputField), hscr + 1, j);
Color fb.input_frg, fb.input_bkg: Print Mid$(text$(fb.InputField), hscr + 1 + j, (flen(fb.InputField)) - j);
Locate , ml
End If
Else
Locate , Pos(0) - 1
If hl > 0 Then Color fb.input_frg, fb.input_bkg Else Color fb.hl1, fb.hl2
Print Mid$(text$(fb.InputField), hscr + string_pos, 1);
Locate , Pos(0) - 1
hl = hl - 1
End If
Color fb.input_frg, fb.input_bkg
Else
If hl Then GoSub hl_off '|--------------->
Locate , Pos(0) - 1
End If
Return
ctrl_rt:
Do
GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
Loop Until Mid$(text$(fb.InputField), hscr + string_pos, 1) = " " Or string_pos >= Len(text$(fb.InputField)) - hscr
Return
ctrl_lt:
Do
GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
Loop Until Mid$(text$(fb.InputField), hscr + string_pos, 1) = " " Or Pos(0) = ml And hscr = 0
Return
hl_off:
j = Pos(0)
Locate , ml
Color fb.input_frg, fb.input_bkg
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , j
hl = 0
Return
cut:
Color fb.input_frg, fb.input_bkg
Select Case hl
Case Is > 0
If b$ = Chr$(24) Then _Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1 + hscr - hl, hl) ' Only copy to clipboard for 'cut' and not delete or paste over highlighted text calls.
j = ml + string_pos - hl
Locate , ml
Print Space$(flen(fb.InputField));
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos - hl) + Mid$(text$(fb.InputField), hscr + string_pos + 1)
Locate , ml
If j < ml Then hscr = hscr + string_pos - hl: j = ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , j
Case 0
' Do nothing
Case Is < 0
If b$ <> Chr$(0) + "S" Then _Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1 + hscr, Abs(hl))
Locate , ml
Print Space$(flen(fb.InputField));
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + Mid$(text$(fb.InputField), hscr + string_pos + 1 + Abs(hl))
Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , ml + string_pos
End Select
hl = 0 ' No need for hl_off.
Return
copy:
Select Case hl
Case Len(text$(fb.InputField)) ' Select all.
_Clipboard$ = text$(fb.InputField)
Case 1 To Len(text$(fb.InputField)) - 1
_Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1 - hl, hl)
Case 0
' Do nothing
Case Is < 0
_Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1, Abs(hl))
End Select
Return
paste:
If Len(_Clipboard$) Then
If InStr(_Clipboard$, Chr$(13)) Then
tmp$ = "": j = 0
For i = 1 To Len(_Clipboard$)
x$ = Mid$(_Clipboard$, i, 1)
If x$ = Chr$(13) And j = 0 Then
tmp$ = tmp$ + " "
j = -1
Else
If Asc(x$) > 32 Then j = 0
If j = 0 Then tmp$ = tmp$ + x$
End If
Next
Else
tmp$ = _Clipboard$
End If
If Len(text$(fb.InputField)) - Abs(hl) + Len(tmp$) <= textlenmax(fb.InputField) Then
If hl Then GoSub cut: string_pos = Pos(0) - ml '|--------------->
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + tmp$ + Mid$(text$(fb.InputField), hscr + string_pos + 1)
If Pos(0) + Len(tmp$) + 1 >= mr Then
i = hscr
hscr = hscr + Pos(0) + Len(tmp$) + 1 - mr
j = Pos(0) + Len(tmp$) - (hscr - i)
Else
j = Pos(0) + Len(tmp$)
End If
Locate , ml: Print Space$(flen(fb.InputField));
Locate , ml: Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , j
Else
Beep ' Too many characters to paste.
End If
End If
Return
select_all:
GoSub cur_end '|--------------->
hl = Len(text$(fb.InputField))
Locate , ml
Color fb.hl1, fb.hl2
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Color fb.input_frg, fb.input_bkg
Return
mouse_click_relocate:
If text$(fb.InputField) = "" Then
Locate yfield(fb.InputField), ml: Print Mid$(text$(fb.InputField), 1, flen(fb.InputField));
Else
If mx <= xfield(fb.InputField) + Len(text$(fb.InputField)) Then
Locate my, mx
Else
If Len(text$(fb.InputField)) >= flen(fb.InputField) - 1 Then
Locate yfield(fb.InputField), xfield(fb.InputField) + flen(fb.InputField) - 1
Else
Locate yfield(fb.InputField), xfield(fb.InputField) + Len(text$(fb.InputField))
End If
End If
End If
Return
End Sub
Sub fb_input_popup (fb As fields_and_buttons, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$)
Static initiate, nomi, oldmy, oldmx
Static atmp As String
Static menu_restrict()
Static MenuHL, OldMenuHL, MenuT, MenuR, MenuB, MenuL, shadowB, shadowR
y = CsrLin: x = Pos(0)
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
Rem fb.CurShow = 0: Locate , , fb.CurShow ' Hide cursor
If drag = 0 And FlattenImage& = 0 Then
PCopy 0, 2
fb_screencopy
_DisplayOrder _Hardware , _Software
_PutImage (0, 0), FlattenImage&
End If
If initiate Then
_PutImage ((MenuR - 1) * _FontWidth, MenuT * _FontHeight), shadowR
_PutImage (MenuL * _FontWidth, (MenuB - 1) * _FontHeight), shadowB
End If
If PopDrg > 0 And oldmx = mx And oldmy = my Then Exit Sub
If initiate = 0 Then
initiate = 1
Restore PopupMenuData
PopupMenuData: ' eof must be lowercase.
Data Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
Data Close..........Esc,eof
t = _NewImage(200, 20, 32)
_Dest t
Line (0, 0)-(190, 15), _RGB32(128, 128, 128, 190), BF
shadowB = _CopyImage(t, 33)
_FreeImage t
t = _NewImage(20, 200, 32)
_Dest t
Line (0, 0)-(14, 191), _RGB32(128, 128, 128, 190), BF
shadowR = _CopyImage(t, 33)
_FreeImage t
_Dest 0
nomi = 0
Do
Read tmp$
If tmp$ = "eof" Then Exit Do
nomi = nomi + 1
ReDim _Preserve menu$(nomi)
menu$(nomi) = tmp$
Loop
End If
Do
If PopDrg < 0 Then
PopDrg = -MenuL
fb.mvar = 0: MenuHL = 0: OldMenuHL = 0
popit = -1
Rem PCopy 1, 0 ' Use without hardware background.
Cls , fb.Bg
Else
If drag And oldmx <> mx Or drag And oldmy <> my Then
If my > MenuT - 2 And my < MenuT + 2 And mx >= MenuL And mx <= MenuR Or PopDrg Then
PopDrg = MenuL - (oldmx - mx):
If PopDrg < 1 Then PopDrg = 1 ' Prevents going over left page margin.
fb.mvar = 0
Cls , fb.Bg
Rem PCopy 1, 0 ' Removes current popup. Use instead of CLS without hardware background.
popit = -1 ' Reopens popup in next cycle.
End If
End If
End If
Select Case fb.mvar
Case 0 ' Open popup menu.
menu_variety = 1
h = 5 ' Variable to determine margin spaces from the right of menu.
If nomi > _Height - 2 Or Len(menu$(1)) > _Width - 4 Then nomi = 0: initiate = 0: Exit Sub ' Not enough room to open popup.
ReDim menu_restrict(nomi) ' Restrictions.
If text$(fb.InputField) = "" Then
For i = 1 To nomi - 2: menu_restrict(i) = 1: Next
Else
If hl = 0 Then
For i = 1 To 4: menu_restrict(i) = 1: Next
End If
End If
If Len(_Clipboard$) Then menu_restrict(3) = 0 Else menu_restrict(3) = 1 ' End Restrictions.
For i = 1 To nomi ' Determine menu width by largest menu item.
j = Len(menu$(i))
If j > k Then k = j
Next
fb.mwidth = k + h
fb.mheight = nomi * 2 + 1 ' Add one for the separate border element.
Select Case menu_variety
Case 0 ' Fixed menu to left.
MenuT = 3: MenuL = 1: MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
Case 1 ' Movable menu.
Select Case PopDrg
Case Is < 0
MenuL = Abs(PopDrg)
PopDrg = 0 ' Drag cycle completed.
Case Is > 0
MenuT = my
MenuL = PopDrg
Case 0
MenuT = my
MenuL = mx
End Select
If MenuT + fb.mheight > _Height Then MenuT = _Height - fb.mheight ' -1 for shadow.
If MenuL + fb.mwidth >= _Width Then MenuL = _Width - fb.mwidth - 1 ' -1 for shadow.
MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
End Select
fb.mvar = -1 ' Identifies the menu is open.
Rem PCopy 0, 1 ' Place current page in memory to be restored when popup is closed. Use instead of CLS without hardware background.
Cls , fb.Bg
Color fb.cp1, fb.cp2
Locate MenuT, MenuL
Print Chr$(218) + String$(fb.mwidth - 2, 196) + Chr$(191) ' Menu top border.
For i = 1 To fb.mheight - 2
Color fb.cp1, fb.cp2: Locate , MenuL
Print Chr$(179); Space$(fb.mwidth - 2) + Chr$(179)
Next
Color fb.cp1, fb.cp2: Locate , MenuL
Print Chr$(192) + String$(fb.mwidth - 2, 196) + Chr$(217); ' Menu bottom border.
For i = 0 To nomi - 1 ' Show menu items.
Locate MenuT + 1 + i * 2, MenuL + 2
If menu_restrict(i + 1) Then
Color fb.cp3, fb.cp2 ' Restricted menu item.
Else
Color fb.cp1, fb.cp2 ' Usable menu item
End If
Print menu$(i + 1)
Color fb.cp1, fb.cp2
Locate , MenuL
If i + 1 < nomi Then Print "Ã" + String$(fb.mwidth - 2, Chr$(196)) + "´";
Next
Case -1
If b$ = Chr$(0) + "H" Or mw = -1 Then ' Keyboard ---------------
If (MenuHL - MenuT + 1) \ 2 > 1 Then
MenuHL = MenuHL - 2
b$ = ""
End If
ElseIf b$ = Chr$(0) + "P" Or mw = 1 Then
If MenuHL = 0 Then
MenuHL = MenuT + 1
Else
If (MenuHL - MenuT + 1) \ 2 < nomi Then
MenuHL = MenuHL + 2
End If
End If
b$ = ""
ElseIf b$ = Chr$(13) And MenuHL Or mb = 2 And MenuHL Then
If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
fb.mvar = (MenuHL - MenuT + 1) \ 2
popit = 0
b$ = ""
Exit Do
End If ' ----------------------------------------------------
ElseIf Len(b$) Then ' Menu selections by key.
Select Case b$
Case Chr$(0) + "S", Chr$(22), Chr$(24), Chr$(1), Chr$(3): popit = 0: Exit Do
Case Chr$(27): b$ = "": fb.mvar = 0: popit = 0: Exit Do ' Simply close popup.
Case Else: b$ = "" ' Prevents any non-menu responses from affecting any other routines in the cycle.
End Select ' ------------------------------------------------
Else ' Mouse input.
i = my >= MenuT And my < MenuB And mx > MenuL And mx < MenuR
If my <> oldmy Or mx <> oldmx Or lb = 2 And drag = 0 Or rb = 2 Then
If i Then
hot` = (my - MenuT) \ 2 <> (my - MenuT) / 2 ' Local variable to determine if click is on a menu item or space between.
If hot` Then
If lb = 2 And MenuHL <> my Or rb = 2 And MenuHL <> my Then hot` = 0
MenuHL = my
End If
Else
hot` = 0
End If
End If
End If
If rb = 2 And MenuHL <> my Then
If Not hot` Then ' If inside menu it will go to next condition.
If my <> MenuT Or mx <> MenuL Then ' Reopen only if mouse position has changed.
If Not i Then
fb.mvar = 0: Exit Do ' Right click to close menu and reopen in new location.
End If
End If
End If
End If
If lb = 2 Or rb = 2 Then ' Left mouse click.
If hot` Then ' Get selection if non-restricted.
If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
fb.mvar = (MenuHL - MenuT + 1) \ 2
popit = 0
End If
Exit Do
Else ' Close popup if click was outside the menu; otherwise click is ignored.
If Not i And rb <> 2 Then ' Never close the popup with a right click.
popit = 0
fb.mvar = 0
End If
Exit Do
End If
End If ' --------------------------------------------------------
If MenuHL <> OldMenuHL Then
If OldMenuHL Then
atmp = Space$(fb.mwidth - 2) ' This and next line center menu item to menu.
Mid$(atmp, 2, Len(menu$((OldMenuHL - MenuT + 1) \ 2))) = menu$((OldMenuHL - MenuT + 1) \ 2)
Locate OldMenuHL, MenuL + 2 - 1
If menu_restrict((OldMenuHL - MenuT + 1) \ 2) Then Color fb.cp3, fb.cp2 Else Color fb.cp1, fb.cp2
Print atmp;
End If
atmp = Space$(fb.mwidth - 2)
Mid$(atmp, 2, Len(menu$((MenuHL - MenuT + 1) \ 2))) = menu$((MenuHL - MenuT + 1) \ 2)
Locate MenuHL, MenuL + 2 - 1
If menu_restrict((MenuHL - MenuT + 1) \ 2) Then Color fb.cp2, fb.cp3 Else Color fb.cp2, fb.cp1
Print atmp;
Color fb.cp1, fb.cp2
End If
OldMenuHL = MenuHL
End Select
Exit Do
Loop
oldmy = my: oldmx = mx
If popit = 0 Then
MenuHL = 0: OldMenuHL = 0
Cls 0, fb.Bg ' Removes software popup but not hardware shadow and replaces white background.
_DisplayOrder _Software , _Hardware ' All white blank background.
Rem PCopy 1, 0: ' Removes popup, any popup highlighting, and restores screen. Use instead of CLS without hardware background.
End If
Color restore_color1, restore_color2
Locate y, x
_KeyClear
Select Case fb.mvar
Case 1: b$ = Chr$(24) ' Cut
Case 2: b$ = Chr$(3) ' Copy
Case 3: b$ = Chr$(22) ' Paste
Case 4: b$ = Chr$(0) + "S" ' Delete
Case 5: b$ = Chr$(1) ' Select All
Case 6 ' Do nothing. (Close Menu).
End Select
If fb.mvar > 0 Or Len(b$) Then fb.mvar = 0
End Sub
Sub fb_demo (fb As fields_and_buttons, nul As String * 1, lb, mb, rb, mw, my, mx)
Static cnt As Integer, y As Integer
_ControlChr Off
ReDim a$(_Height)
_KeyClear
If fb.mapping = 0 Then _Title "Mouse / Keyboard Demo with Array Mapping" Else _Title "Mouse / Keyboard Demo with Screen Mapping"
fb.Fg = 0
fb.Bg = 5
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 = 7: fb.B1HvrBg = 7: fb.B1FlashFg = 1: fb.B1FlashBg = 7
fb.B2BdrFg = 8: fb.B2BdrHover = 1: fb.B2BdrFlash = 9
fb.B3OutRed = 95: fb.B3OutGrn = 95: fb.B3OutBlu = 95
fb.B3InRed = 155: fb.B3InGrn = 155: fb.B3InBlu = 155
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
' Input Field Colors
fb.page_color = _BackgroundColor
fb.input_frg = 15
fb.input_bkg = 0
fb.hl1 = 15 ' Highlight text forground.
fb.hl2 = 1 ' Highlight text background.
fb.skin_frg = 0 ' These next 4 are for popup input windows, not full page.
fb.skin_bkg = 5
fb.skin_shadow_frg = 8
fb.skin_shadow_bkg = 0
' Popup Colors
fb.cp2 = 6 ' Popup background.
fb.cp4 = 3 ' Popup shadow.
fb.cp1 = 0 ' Available menu item.
fb.cp3 = 7 ' Unavailable menu item.
' Display Demo Items
fb.a = "Hover:": fb_fields fb, 2, 51, 2, 0, nul
fb.a = "Button Style:": fb_fields fb, 4, 51, 2, 0, nul
fb.a = "Tab:": fb_fields fb, 6, 51, 2, 0, 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, 33, 51, 19, 38, "Text goes here."
Rem For i = 1 To _Height - 1: Locate i, 1: Print mRow$(i);: Next ' Test mapping area.
SkipAct = 0: z1 = Timer
fb.idle = 10
Do
If FlattenImage& Then If fb.PopStatus = 0 Then FlattenImage& = 0: PCopy 2, 0 ' Full cycle
MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
If FlattenImage& Then _PutImage (0, 0), FlattenImage&
If fb.PopStatus = 0 Then
If drag Then
If olddrag <> drag Then
If drag > 0 Then a$ = "Drag Right. Status = " + LTrim$(Str$(drag)) Else a$ = "Drag Left. Status = " + LTrim$(Str$(drag))
GoSub print_array
olddrag = drag
End If
Else
olddrag = 0
End If
If oldlb <> lb Then
Select Case lb
Case 0
a$ = "Left Button Up - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
a$ = "Number of clicks = " + LTrim$(Str$(clkcnt)): GoSub print_array
Case -1
a$ = "Left Button Down - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
Case 1
a$ = "Left Button Pressed - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
Case 2
a$ = "Left Button Released - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
End Select
End If
If oldmb <> mb Then
Select Case mb
Case 0: a$ = "Middle Button Up - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
Case -1: a$ = "Middle Button Down - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
Case 1: a$ = "Middle Button Pressed - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
Case 2: a$ = "Middle Button Released - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
End Select
End If
If oldrb <> rb Then
Select Case rb
Case 0: a$ = "Right Button Up - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
Case -1: a$ = "Right Button Down - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
Case 1: a$ = "Right Button Pressed - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
Case 2: a$ = "Right Button Released - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
End Select
End If
If oldmw <> mw Then
If mw < 0 Then a$ = "Mouse Wheel Up - Wheel Status = " + LTrim$(Str$(mw)): GoSub print_array
If mw > 0 Then a$ = "Mouse Wheel Down - Wheel Status = " + LTrim$(Str$(mw)): GoSub print_array
End If
If fb.BSelect Then a$ = "Button Selected = " + LTrim$(Str$(fb.BSelect)): GoSub print_array
If oldalt% <> alt% Then
If alt% < 0 Then a$ = "Alt Button Down" Else a$ = "Alt Button Released"
GoSub print_array
End If
If oldctrl% <> ctrl% Then
If ctrl% < 0 Then a$ = "Ctrl Button Down" Else a$ = "Ctrl Button Released"
GoSub print_array
End If
If oldshift% <> shift% Then
If shift% < 0 Then a$ = "Shift Button Down" Else a$ = "Shift Button Released"
GoSub print_array
End If
If AltStatus% And OldAltStatus% <> AltStatus% Then
If AltToggle% Then a$ = "Alt Key Pressed / Alt Toggle Status: On" Else a$ = "Alt Key Pressed / Alt Toggle Status: Off"
GoSub print_array
End If
If k& < 0 Then oldb$ = ""
Select Case Len(b$)
Case 1
If oldb$ <> b$ Then x = CVI(MKI$(Asc(b$))): a$ = "You Pressed: " + Chr$(x) + " Chr$(" + LTrim$(Str$(x)) + ")": GoSub print_array
oldb$ = b$
Case 2
If oldb$ <> b$ Then a$ = "You Pressed: " + "nul + " + LTrim$(Str$(Asc(Mid$(b$, 2, 1)))) + " Chr$(0) + " + Chr$(34) + Mid$(b$, 2, 1) + Chr$(34): GoSub print_array
oldb$ = b$
End Select
oldlb = lb: oldrb = rb: oldmb = mb: oldmw = mw: oldalt% = alt%: oldctrl% = ctrl%: oldshift% = shift%: OldAltStatus% = AltStatus%
End If
If act Or Abs(z1 - Timer) < fb.idle Or fb.SkipAct <> 0 Then
If door = -1 Then
_PaletteColor 5, _RGB32(255, 255, 255, 0)
Palette 6, 63
End If
If fb.SkipAct = 0 Then If act Then z1 = Timer
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
door = 0
Else
If door = 0 Then
_PaletteColor 5, _RGB32(215, 215, 215, 235)
_PaletteColor 6, _RGB32(205, 205, 205)
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
_Limit 10
End If
door = -1
End If
Loop
print_array:
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
Return
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 ' Note: Do not exit as mouse buttons may also be going through a cycle when mouse clicks are converted to key entries.
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
act = 1
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
If rb > 0 Then If rb = 1 Then rb = -1: act = 1 Else rb = 0: act = -1
If mb > 0 Then If mb = 1 Then mb = -1: act = 1 Else mb = 0: act = -1
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
If ctrl% Then ' Convert select all, cut, copy, paste.
Select Case LCase$(b$)
Case "a": b$ = Chr$(1)
Case "x": b$ = Chr$(24)
Case "c": b$ = Chr$(3)
Case "v": b$ = Chr$(22)
Case Chr$(0) + "k": b$ = Chr$(0) + "s"
Case Chr$(0) + "m": b$ = Chr$(0) + "t"
End Select
End If
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 SubThis version uses a hardware popup menu.
Code: (Select All)
Dim Shared PopDrg
Dim Shared demo As Integer, clean As _Bit
ReDim Shared text$(0), textlen(0), textlenmax(0), 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), bl3(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), BStyle(0)
Type fields_and_buttons
a As String
pad 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
SkipAct As Integer
idle As Single
PopStatus As Integer
HardwareBg As Long
' Style
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
B3TxtRed As Integer
B3TxtGrn As Integer
B3TxtBlu As Integer
B3OutRed As Integer
B3OutGrn As Integer
B3OutBlu As Integer
B3InRed As Integer
B3InGrn As Integer
B3InBlu 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
' Input Types
CurStyle As Integer
CurShow As Integer
hl1 As Integer
hl2 As Integer
InputField As Integer
mhovery As Integer
mhoverx As Integer
mvar As Integer
mtop As Integer
mleft As Integer
myclose As Integer
mxclose As Integer
page_color As Integer
skin_frg As Integer
skin_bkg As Integer
input_frg As Integer
input_bkg As Integer
skin_shadow_frg As Integer
skin_shadow_bkg As Integer
mwidth As Integer
mheight As Integer
' Popup Colors
cp2 As Integer ' Popup background.
cp4 As Integer ' Popup shadow.
cp1 As Integer ' Available menu item.
cp3 As Integer ' Unavailable menu item.
End Type
Dim fb As fields_and_buttons
demo = 1
If demo Then
Width 80, 35
fb_palette fb
_ScreenMove 0, 0
Color 0, fb.Bg: Cls
Input "Choose a button mapping method 0 or 1: ", fb.mapping
Cls
GoTo start
End If
fb_palette fb
' Begin User Routine.
fb.a = " Button Hybrid ": fb_make fb, 4, 31, 3
fb.a = " Button Graphics ": fb_make fb, 8, 31, 4
fb.a = " Button Text ": fb_make fb, 12, 31, 2
fb.a = " Button Text ": fb_make fb, 15, 31, 1
fb.a = " Button HTML ": fb_make fb, 19, 31, 5
fb.a = "Text:": fb_fields fb, _Height - 4, 31, 15, 15, "Text goes here."
fb.a = "More Text:": fb_fields fb, _Height - 2, 31, 30, 50, "Additional Text goes here."
start:
Do
fb_control fb, b$, mx, my, lb, mb, rb, drag
Loop
Sub fb_control (fb As fields_and_buttons, b$, mx, my, lb, mb, rb, drag)
Static initiate As Integer, z1, door, autokey$ ' autokey$ needs to either be preserved here or passed back.
If initiate = 0 Then
initiate = 1
fb_palette fb
If demo Then
fb.nof = 0: fb.nob = 0: fb.tabmax = 0
ReDim fld$(0), FType(0), btnmap(0), btnfld(0), BStyle(0)
ReDim y1(0), x1(0), y2(0), x2(0), button$(0)
clean = -1: fb_fields fb, y, x, length, lengthmax, filler$
clean = -1: fb_map fb, mapid
clean = -1: fb_make fb, y, x, ButtonStyle
Dim nul As String * 1 ' Used only for demo.
fb_demo fb, nul$, lb, mb, rb, mw, my, mx
End If
If fb.idle = 0 Then If fb.SkipAct = 0 Then fb.idle = 15 ' 15-second Default.
End If
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) < fb.idle Or fb.SkipAct <> 0 Then
If door = -1 Then
_PaletteColor 5, _RGB32(255, 255, 255, 0)
Palette 6, 63
End If
If fb.SkipAct = 0 Then If act Then z1 = Timer
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
door = 0
Else
If door = 0 Then
_PaletteColor 5, _RGB32(215, 215, 215, 235)
_PaletteColor 6, _RGB32(205, 205, 205)
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
_Limit 10
End If
door = -1
End If
End Sub
Sub fb_palette (fb As fields_and_buttons)
' Reserved colors 3, 5, 6.
_PaletteColor 3, _RGB32(0, 0, 0, 70) ' Popup shadow.
_PaletteColor 5, _RGB32(255, 255, 255, 0) ' Software page color (Transparent).
_PaletteColor 0, _RGB32(10, 10, 10) ' Needed to separate black for png _saveimage transperancy.
Palette 6, 63 ' Bright white for background uses.
' Button Colors.
fb.Fg = 0
fb.Bg = 5
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 = 7: fb.B1HvrBg = 7: fb.B1FlashFg = 1: fb.B1FlashBg = 7
fb.B2BdrFg = 8: fb.B2BdrHover = 1: fb.B2BdrFlash = 9
fb.B3OutRed = 95: fb.B3OutGrn = 95: fb.B3OutBlu = 95
fb.B3InRed = 155: fb.B3InGrn = 155: fb.B3InBlu = 155
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
' Input Field Colors
fb.page_color = _BackgroundColor
fb.input_frg = 15
fb.input_bkg = 0
fb.hl1 = 15 ' Highlight text forground.
fb.hl2 = 1 ' Highlight text background.
fb.skin_frg = 0 ' These next 4 are for popup input windows, not full page.
fb.skin_bkg = 5
fb.skin_shadow_frg = 8
fb.skin_shadow_bkg = 0
' Popup Colors
fb.cp2 = 6 ' Popup background.
fb.cp4 = 3 ' Popup shadow.
fb.cp1 = 0 ' Available menu item.
fb.cp3 = 7 ' Unavailable menu item.
End Sub
Sub fb_main (fb As fields_and_buttons, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$)
Static BTabHl As Integer, chngfld As Integer
s1 = CsrLin: s2 = Pos(0)
b_hover = 0: fb.fld = 0: fb.BSelect = 0
If fb.mapping Then ' Background was mapped.
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 ' Input field.
fb.fld = i
Case 5 ' Button.
fb.fld = i
b_hover = btnmap(fb.fld)
Exit For
End Select
End If
Next
End If
If lb = 1 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)
If Abs(chngfld) <> fb.tb Then chngfld = fb.tb
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
End If
For k = 1 To fb.nob
If demo Then BStyle(k) = (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 And fb.PopStatus = 0 Then ' Display button on Tab selection.
Select Case BStyle(k)
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
_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 ' Display all buttons standard, hover, or selected.
Select Case BStyle(k)
Case 1
If fb.PopStatus = 0 Then
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
End If
Case 2
If fb.PopStatus = 0 Then
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);
End If
Case 3
If h = 0 And b_hover = k And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl2(k)
ElseIf Abs(h) And b_hover = k And fb.PopStatus = 0 Or fb.SimClick = k And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl3(k)
If h = 2 Then fb.BSelect = k
Else
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16), bl1(k)
End If
Case 4
If h = 0 And b_hover = k And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), gfx2(k)
ElseIf Abs(h) And b_hover = k And fb.PopStatus = 0 Or fb.SimClick = k And fb.PopStatus = 0 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 And fb.PopStatus = 0 Then
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), h2(k)
ElseIf Abs(h) And b_hover = k And fb.PopStatus = 0 Or fb.SimClick = k And fb.PopStatus = 0 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
Select Case FType(fb.tb)
Case 1
fb_field_input fb, chngfld, tabmap(fb.tb), lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, autokey$
Case 5
If b_hover = 0 Or force Then If fb.PopStatus = 0 Then BTabHl = btnmap(fb.tb)
End Select
If demo And fb.PopStatus = 0 Then
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$(BStyle(b_hover))); 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
_Display
Locate s1, s2, 0 ' Hide cursor
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, lengthmax, filler$)
Static initiate As Integer, cnt As Integer
If initiate = 0 Or clean Then
initiate = 1
cnt = 0
If fb.Bg <> _BackgroundColor Then Color fb.Fg, fb.Bg: Cls
If clean Then clean = 0: initiate = 0: Exit Sub
End If
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
fb.nof = fb.nof + 1: fb.tabmax = fb.tabmax + 1: cnt = cnt + 1
ReDim _Preserve text$(fb.nof), textlen(cnt), textlenmax(cnt), 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) = 1
textlen(cnt) = length
textlenmax(cnt) = lengthmax
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
text$(cnt) = filler$
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 initiate As Integer, btnnbr As Integer
If initiate = 0 Or clean Then
initiate = 1
btnnbr = 0
If fb.Bg <> _BackgroundColor Then Color fb.Fg, fb.Bg: Cls
If clean Then clean = 0: initiate = 0: Exit Sub
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), BStyle(fb.nof)
BStyle(fb.nof) = ButtonStyle ' Passed variable from main.
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 BStyle(fb.nof)
Case 1 ' Single line button with blank border. 3-rows tall and name, with space ends, wide.
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. 3-rows tall and name, with space ends, wide.
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. 3-rows tall and name, with space ends + 2, wide.
fb.pad = 2 ' Add button style padding.
j = Len(fb.a)
k = btnnbr
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr), bl1(btnnbr), bl2(btnnbr), bl1(btnnbr), bl3(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: fb_map fb, 6
Locate y, x - 1: fb_map fb, -1
Locate y + 1, x - 1: 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.B3OutRed, fb.B3OutGrn, fb.B3OutBlu), BF
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), BF
Color _RGB32(fb.B3TxtRed, fb.B3TxtGrn, fb.B3TxtBlu), _RGB32(fb.B3InRed, fb.B3InGrn, fb.B3InBlu): _PrintString (_FontWidth, _FontHeight), fb.a
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.B3OutRed, fb.B3OutGrn, fb.B3OutBlu), BF
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), BF
Color _RGB32(fb.B3TxtRed, fb.B3TxtGrn, fb.B3TxtBlu), _RGB32(fb.B3InRed, fb.B3InGrn, fb.B3InBlu): _PrintString (_FontWidth, _FontHeight), fb.a
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
t& = _NewImage((j + 3) * 8, 4 * 16, 32)
_Dest t&
Rem _PutImage (0, 0), bl1(btnnbr)
Line (2, 7 + 2)-((j + 2) * 8 - 2, 16 * 2 + 7 - 2), _RGB32(fb.B3OutRed, fb.B3OutGrn, fb.B3OutBlu), BF
Line (8, 15)-((j + 1) * 8, 16 + 15), _RGB32(fb.B3Ln1Red, fb.B3Ln1Grn, fb.B3Ln1Blu), BF
Color _RGB32(fb.B3InRed, fb.B3InGrn, fb.B3InBlu), _RGB32(fb.B3TxtRed, fb.B3TxtGrn, fb.B3TxtBlu): _PrintString (_FontWidth, _FontHeight), fb.a
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
bl3(btnnbr) = _CopyImage(t, 33)
_FreeImage t&
_Dest 0
Case 4 ' Graphics button.
fb.pad = 2 ' Add button style padding.
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)
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
caption$ = Mid$(" " + fb.a + " ", 1, j + fb.pad)
gfx1(btnnbr) = fb_gfx((j + fb.pad) * 8, 2 * 16, 170, 170, 170, -9, -9, -1, caption$)
gfx2(btnnbr) = fb_gfx((j + fb.pad) * 8, 2 * 16, 200, 200, 200, -8, -7, -1, caption$)
gfx3(btnnbr) = fb_gfx((j + fb.pad) * 8, 2 * 16, 200, 200, 200, -1, -1, -1, caption$)
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
fb.pad = 0 ' Remove any button style padding.
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 initiate As Integer, mapfld As Integer
If initiate = 0 Or clean Then
initiate = 1
ReDim mRow$(_Height)
mapfld = 96
If clean Then clean = 0: initiate = 0: Exit Sub
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) + fb.pad, Chr$(mapfld))
If mapid < 6 And mapid > -1 Then Print fb.a;
End Sub
Sub fb_field_input (fb As fields_and_buttons, chngfld As Integer, ifield, lb, mb, rb, my, mx, mw, shift%, clkcnt, drag, b$, autokey$) ' Single line keyboard routine for input.
Static initiate, ml, mr, y, x, ovw, hscr, restore_color1, restore_color2
Static hl, string_pos, mhover_close, s1color, s2color
Static mhlinput As _Bit, popit
Static restricted_keys$
Static flen(), yfield(), xfield(), maxflen(), menu$()
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
If initiate = 0 Then
initiate = 1
End If
If initiate = 1 Or chngfld > 0 Then
initiate = 2
If hl Then Locate y, x: GoSub hl_off
b$ = "" ' Needed to prevent an autokey event if tab was used to open this input field.
Locate y1(fb.tb), x1(fb.tb)
Color fb.input_frg, fb.input_bkg ' Initiate input text color.
fb.InputField = ifield: If fb.InputField = 0 Then fb.InputField = 1
ReDim _Preserve yfield(fb.InputField) ' Row.
ReDim _Preserve xfield(fb.InputField) ' Column.
ReDim _Preserve flen(fb.InputField) ' Field length.
ReDim _Preserve maxflen(fb.InputField) ' Max text length.
flen(fb.InputField) = textlen(fb.InputField)
maxflen(fb.InputField) = textlenmax(fb.InputField)
yfield(fb.InputField) = CsrLin
xfield(fb.InputField) = Pos(0)
If fb.CurStyle = 0 Then fb.CurStyle = 7: fb.CurShow = 1 ' Default cursor.
hscr = 0: fb.mhovery = 0: fb.mhoverx = 0: mhlinput = 0
ml = Pos(0)
mr = ml + flen(fb.InputField)
If chngfld > 0 Then
chngfld = -chngfld
If lb <> 0 Then Locate my, mx
End If
y = CsrLin: x = Pos(0) ' Initial cursor position.
fb.CurShow = 1: Locate y, x, fb.CurShow, 7, fb.CurStyle ' Show cursor.
End If
Color fb.input_frg, fb.input_bkg: Locate y, x, 1
If PopDrg Then If drag = 0 Then PopDrg = -1: popit = -1 Else popit = -1
If popit Then
fb.CurShow = 0: Locate , , fb.CurShow ' Hide cursor
fb_input_popup fb, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$
If popit = 0 Then fb.CurShow = 1: Locate , , fb.CurShow, 7, fb.CurStyle ' Show cursor
If b$ = "" Then Exit Sub
Else ' Non-popup events are handled here. Popup key events are handled in the next conditon block.
Do
string_pos = Pos(0) - ml ' Track text position from 0 to maxflen(fb.InputField).
If InStr(restricted_keys$, LCase$(b$)) And Len(b$) = 1 Then
_MessageBox " Invalid character.", "File names cannot contain the following characters: " + restricted_keys$, "info"
b$ = ""
End If
If fb.myclose Then ' Self contained close on x click routine. Includes hover and left click release.
If my = fb.myclose And mx = fb.mxclose Or mhover_close Then
If mhover_close And lb = 2 Then Exit Do ' Close popup and exit input routine.
y = CsrLin: x = Pos(0)
s1color = _DefaultColor: s2color = _BackgroundColor
j = mhover_close
If my = fb.myclose And mx = fb.mxclose Then
If mhover_close = 0 Then Color fb.skin_bkg, 4: mhover_close = 1
Else
If mhover_close Then Color fb.skin_frg, fb.skin_bkg: mhover_close = 0
End If
If j <> mhover_close Then
Locate fb.myclose, fb.mxclose - 1: Print " x ";
Color s1color, s2color
Locate y, x
End If
End If
End If
If mhlinput Then If drag = 0 And lb = 0 Then mhlinput = 0 ' Quit mouse input line highlighting.
If lb > 0 Or drag Then ' Mouse button events.
Do
If drag Then
If my = yfield(fb.InputField) Or mhlinput Then
If mx >= ml - hscr And mx <= ml + Len(text$(fb.InputField)) - hscr Or mhlinput Then
mhlinput = -1
If drag > 0 Then
If mx > Pos(0) - 1 Then
shift% = -1: GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
y = CsrLin: x = Pos(0)
End If
Else
If mx < Pos(0) Then
shift% = -1: GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
y = CsrLin: x = Pos(0)
End If
End If
End If
Exit Do
End If
End If
If lb = 1 Or clkcnt > 1 Then
For i = 1 To UBound(yfield) ' Find input line.
If my = yfield(i) And mx >= xfield(i) And mx <= xfield(i) + flen(i) Then ' Mouse cursor in an input field.
If hl Then GoSub hl_off '|--------------->
Rem If i <> 1 Then If text$(1) = "" Then Beep: Exit Do ' Uniqueue restriction when no text is present in first input field.
fb.InputField = i
If clkcnt > 1 Then
GoSub select_all '|--------------->
Else
GoSub mouse_click_relocate '|--------------->
End If
y = CsrLin: x = Pos(0)
Exit For
End If
Next
Exit Do
End If
If lb = 2 Then ' Mouse button pressed and released.
'</----------------------- USER DEFINED ROUTINE -----------------------/>
Exit Do
End If
Exit Do
Loop
End If
If rb = 2 Then ' Right mouse button released.
If textlenmax(fb.InputField) Then ' Only open popup if the field accepts input.
If fb.mvar < 1 Then
If my <> yfield(fb.InputField) Then ' Check for change input field click.
For i = 1 To UBound(yfield)
If my = yfield(i) Then ' Change input fields.
Rem If i <> 1 Then If text$(1) = "" Then Beep: Exit Do ' Uniqueue restriction when no text is present in first input field.
If i <> fb.InputField Then ' Remove any highlighting if input line is being changed.
If hl Then GoSub hl_off '|--------------->
End If
fb.InputField = i
GoSub mouse_click_relocate '|--------------->
Exit For
End If
Next
End If
popit = -1
End If
End If
End If
Exit Do ' Flow through.
Loop
End If
If Len(b$) Then
Select Case b$
Case Chr$(27) ' Esc key.
Rem Exit Do ' Leave sub.
Case Chr$(9), Chr$(13) ' Tab or Enter key.
initiate = 1
If hl Then GoSub hl_off '|--------------->
autokey$ = Chr$(9)
Rem Exit Do ' Leave sub.
Case Chr$(8) ' Backspace key.
GoSub backspace '|--------------->
Case Chr$(0) + "S" ' Delete key.
GoSub delete '|--------------->
Case Chr$(0) + "M" ' Arrow right key.
GoSub cursor_forward '|--------------->
Case Chr$(0) + "K" ' Arrow left key.
GoSub cursor_back '|--------------->
Case Chr$(0) + "t" ' Ctrl + Arrow right key.
GoSub ctrl_rt '|--------------->
Case Chr$(0) + "s" ' Ctrl + Arrow left key.
GoSub ctrl_lt '|--------------->
Case Chr$(0) + "G" ' Home
GoSub cur_home '|--------------->
Case Chr$(0) + "O" ' End
GoSub cur_end '|--------------->
Case Chr$(0) + "R" ' Insert/overwrite toggle.
ovw = 1 - ovw
If ovw Then fb.CurStyle = 30 Else fb.CurStyle = 7
Locate , , fb.CurShow, 7, fb.CurStyle ' Change cursor appearance. Assumes cursor is shown, not hidden.
Case Chr$(22) ' Ctrl + V - Paste
GoSub paste '|--------------->
Case Chr$(3) ' Ctrl + C - Copy
GoSub copy '|--------------->
Case Chr$(24) ' Ctrl + X - Cut
GoSub cut '|--------------->
Case Chr$(1) ' Select all.
GoSub select_all '|--------------->
Case Chr$(32) To "z"
GoSub print_chr '|--------------->
End Select
y = CsrLin: x = Pos(0) ' Track cursor.
End If
Color restore_color1, restore_color2
If popit <> 0 Or PopDrg <> 0 Then fb.PopStatus = 1 Else fb.PopStatus = 0
Exit Sub
print_chr:
If hl Then GoSub cut '|--------------->
string_pos = Pos(0) - ml
If string_pos + ml < mr - 1 And Len(text$(fb.InputField)) < flen(fb.InputField) - 1 Then
If ml + Len(text$(fb.InputField)) < mr Then
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, string_pos) + b$ + Mid$(text$(fb.InputField), string_pos + 1 + ovw)
Locate , ml: Print Space$(flen(fb.InputField));: Locate , ml
Print text$(fb.InputField);
Locate , ml + string_pos + 1
End If
Else ' Horizontal scrolling.
If Len(text$(fb.InputField)) < maxflen(fb.InputField) Then
If string_pos = flen(fb.InputField) - 1 Or string_pos = flen(fb.InputField) - 2 And string_pos < Len(text$(fb.InputField)) - hscr - 1 Then
j = 1 ' At right margin.
Else
j = 0
End If
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + b$ + Mid$(text$(fb.InputField), hscr + string_pos + 1 + ovw)
hscr = hscr + j
Locate , ml
If ovw Then Print Space$(flen(fb.InputField));: Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , ml + string_pos + 1 - j
End If
End If
Return
backspace:
If hl And shift% = 0 Then GoSub cut: Return '|--------------->
If string_pos = 0 And hscr > 0 Or string_pos > 0 Then
If hl Then GoSub hl_off '|--------------->
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos - 1) + Mid$(text$(fb.InputField), hscr + string_pos + 1)
If hscr Then hscr = hscr - 1: j = 0 Else j = 1
Locate , ml: Print Space$(flen(fb.InputField));
Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , x - j
End If
Return
delete:
If hl Then
GoSub cut '|--------------->
Else
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + Mid$(text$(fb.InputField), hscr + string_pos + 2)
Locate , ml: Print Space$(flen(fb.InputField));
Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , x
End If
Return
cur_home:
Do
GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
Loop Until hscr = 0 And string_pos = 0
Return
cur_end:
Do
GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
Loop Until string_pos + 1 > Len(text$(fb.InputField)) - hscr
Return
cursor_forward:
If hl And shift% = 0 Then GoSub hl_off '|--------------->
If string_pos + 1 <= Len(text$(fb.InputField)) - hscr Then
If ml + string_pos + 1 = mr And Len(text$(fb.InputField)) >= flen(fb.InputField) And shift% = 0 Then
hscr = hscr + 1
Locate , ml: Print Space$(flen(fb.InputField));: Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
If string_pos <> Len(text$(fb.InputField)) - hscr Then Locate , Pos(0) - 1
ElseIf shift% And string_pos < Len(text$(fb.InputField)) - hscr Then
If string_pos = flen(fb.InputField) - 1 Then
hscr = hscr + 1
Color fb.input_frg, fb.input_bkg
Locate , ml: Print Space$(flen(fb.InputField));: Locate , ml
If string_pos - hl > flen(fb.InputField) Then
Print Mid$(text$(fb.InputField), hscr + 1, (flen(fb.InputField)) - 1);
Else
Print Mid$(text$(fb.InputField), hscr + 1, string_pos - hl - 1);
End If
If hl < 0 Then Color fb.input_frg, fb.input_bkg Else Color fb.hl1, fb.hl2
hl = hl + 1
If Pos(0) = ml Then
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField) - 1);
Else
Print Mid$(text$(fb.InputField), hscr + 1 + string_pos - hl, (flen(fb.InputField)) - (string_pos - hl) - 1);
End If
Else
If hl < 0 Then Color fb.input_frg Else Color fb.hl1, fb.hl2
hl = hl + 1
Print Mid$(text$(fb.InputField), hscr + string_pos + 1, 1);
End If
Else
If hl Then GoSub hl_off '|--------------->
If Pos(0) < mr Then Locate , Pos(0) + 1
End If
Color fb.input_frg
End If
Return
cursor_back:
If hl And shift% = 0 Then GoSub hl_off '|--------------->
If string_pos = 0 And shift% = 0 Then
If hscr Then hscr = hscr - 1: Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));: Locate , ml
ElseIf shift% Then
If string_pos = 0 Then
If hscr Then
hscr = hscr - 1
If hl > 0 Then Color fb.input_frg, fb.input_bkg Else Color fb.hl1, fb.hl2
hl = hl - 1
j = Abs(hl): If j > (flen(fb.InputField)) Then j = flen(fb.InputField)
Print Mid$(text$(fb.InputField), hscr + 1, j);
Color fb.input_frg, fb.input_bkg: Print Mid$(text$(fb.InputField), hscr + 1 + j, (flen(fb.InputField)) - j);
Locate , ml
End If
Else
Locate , Pos(0) - 1
If hl > 0 Then Color fb.input_frg, fb.input_bkg Else Color fb.hl1, fb.hl2
Print Mid$(text$(fb.InputField), hscr + string_pos, 1);
Locate , Pos(0) - 1
hl = hl - 1
End If
Color fb.input_frg, fb.input_bkg
Else
If hl Then GoSub hl_off '|--------------->
Locate , Pos(0) - 1
End If
Return
ctrl_rt:
Do
GoSub cursor_forward '|--------------->
string_pos = Pos(0) - ml
Loop Until Mid$(text$(fb.InputField), hscr + string_pos, 1) = " " Or string_pos >= Len(text$(fb.InputField)) - hscr
Return
ctrl_lt:
Do
GoSub cursor_back '|--------------->
string_pos = Pos(0) - ml
Loop Until Mid$(text$(fb.InputField), hscr + string_pos, 1) = " " Or Pos(0) = ml And hscr = 0
Return
hl_off:
j = Pos(0)
Locate , ml
Color fb.input_frg, fb.input_bkg
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , j
hl = 0
Return
cut:
Color fb.input_frg, fb.input_bkg
Select Case hl
Case Is > 0
If b$ = Chr$(24) Then _Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1 + hscr - hl, hl) ' Only copy to clipboard for 'cut' and not delete or paste over highlighted text calls.
j = ml + string_pos - hl
Locate , ml
Print Space$(flen(fb.InputField));
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos - hl) + Mid$(text$(fb.InputField), hscr + string_pos + 1)
Locate , ml
If j < ml Then hscr = hscr + string_pos - hl: j = ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , j
Case 0
' Do nothing
Case Is < 0
If b$ <> Chr$(0) + "S" Then _Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1 + hscr, Abs(hl))
Locate , ml
Print Space$(flen(fb.InputField));
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + Mid$(text$(fb.InputField), hscr + string_pos + 1 + Abs(hl))
Locate , ml
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , ml + string_pos
End Select
hl = 0 ' No need for hl_off.
Return
copy:
Select Case hl
Case Len(text$(fb.InputField)) ' Select all.
_Clipboard$ = text$(fb.InputField)
Case 1 To Len(text$(fb.InputField)) - 1
_Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1 - hl, hl)
Case 0
' Do nothing
Case Is < 0
_Clipboard$ = Mid$(text$(fb.InputField), string_pos + 1, Abs(hl))
End Select
Return
paste:
If Len(_Clipboard$) Then
If InStr(_Clipboard$, Chr$(13)) Then
tmp$ = "": j = 0
For i = 1 To Len(_Clipboard$)
x$ = Mid$(_Clipboard$, i, 1)
If x$ = Chr$(13) And j = 0 Then
tmp$ = tmp$ + " "
j = -1
Else
If Asc(x$) > 32 Then j = 0
If j = 0 Then tmp$ = tmp$ + x$
End If
Next
Else
tmp$ = _Clipboard$
End If
If Len(text$(fb.InputField)) - Abs(hl) + Len(tmp$) <= textlenmax(fb.InputField) Then
If hl Then GoSub cut: string_pos = Pos(0) - ml '|--------------->
text$(fb.InputField) = Mid$(text$(fb.InputField), 1, hscr + string_pos) + tmp$ + Mid$(text$(fb.InputField), hscr + string_pos + 1)
If Pos(0) + Len(tmp$) + 1 >= mr Then
i = hscr
hscr = hscr + Pos(0) + Len(tmp$) + 1 - mr
j = Pos(0) + Len(tmp$) - (hscr - i)
Else
j = Pos(0) + Len(tmp$)
End If
Locate , ml: Print Space$(flen(fb.InputField));
Locate , ml: Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Locate , j
Else
Beep ' Too many characters to paste.
End If
End If
Return
select_all:
GoSub cur_end '|--------------->
hl = Len(text$(fb.InputField))
Locate , ml
Color fb.hl1, fb.hl2
Print Mid$(text$(fb.InputField), hscr + 1, flen(fb.InputField));
Color fb.input_frg, fb.input_bkg
Return
mouse_click_relocate:
If text$(fb.InputField) = "" Then
Locate yfield(fb.InputField), ml: Print Mid$(text$(fb.InputField), 1, flen(fb.InputField));
Else
If mx <= xfield(fb.InputField) + Len(text$(fb.InputField)) Then
Locate my, mx
Else
If Len(text$(fb.InputField)) >= flen(fb.InputField) - 1 Then
Locate yfield(fb.InputField), xfield(fb.InputField) + flen(fb.InputField) - 1
Else
Locate yfield(fb.InputField), xfield(fb.InputField) + Len(text$(fb.InputField))
End If
End If
End If
Return
End Sub
Sub fb_input_popup (fb As fields_and_buttons, menu$(), hl, popit, lb, mb, rb, my, mx, mw, drag, b$)
Static initiate, h, nomi, oldmy, oldmx
Static menu_restrict()
Static menu_variety, MenuHL, MenuT, MenuR, MenuB, MenuL, shadowM, hwpop&
menu_variety = 1
y = CsrLin: x = Pos(0)
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
Rem fb.CurShow = 0: Locate , , fb.CurShow ' Hide cursor
If fb.mvar Then
_PutImage ((MenuL - 1) * _FontWidth, (MenuT - 1) * _FontHeight), hwpop&
If MenuHL Then _PutImage (MenuL * _FontWidth, (MenuHL - 1) * _FontHeight), shadowM
End If
If PopDrg > 0 And oldmx = mx And oldmy = my Then Exit Sub
If initiate = 0 Then
initiate = 1
h = 5 ' Variable to determine margin spaces from the right of menu.
Restore PopupMenuData
PopupMenuData: ' eof must be lowercase.
Data Cut.........Ctrl+X,Copy........Ctrl+C,Paste.......Ctrl+V,Clear..........Del,Select All..Ctrl+A
Data Close..........Esc,eof
nomi = 0
Do
Read tmp$
If tmp$ = "eof" Then Exit Do
nomi = nomi + 1
ReDim _Preserve menu$(nomi)
menu$(nomi) = tmp$
Loop
If nomi > _Height - 2 Or Len(menu$(1)) > _Width - 4 Then nomi = 0: initiate = 0: Exit Sub ' Not enough room to open popup.
For i = 1 To nomi ' Determine menu width by largest menu item.
j = Len(menu$(i))
If j > k Then k = j
Next
fb.mwidth = k + h
fb.mheight = nomi * 2 + 1 ' Add one for the separate border element.
End If
Do
If PopDrg < 0 Then
PopDrg = -MenuL
fb.mvar = 0: MenuHL = 0
popit = -1
Else
If drag And oldmx <> mx Or drag And oldmy <> my Then
If my > MenuT - 2 And my < MenuT + 2 And mx >= MenuL And mx <= MenuR Or PopDrg Then
PopDrg = MenuL - (oldmx - mx)
If PopDrg < 1 Then PopDrg = 1 ' Prevents going over left page margin.
fb.mvar = 0
MenuHL = 0
popit = -1 ' Reopens popup in next cycle.
End If
End If
End If
Select Case fb.mvar
Case 0 ' Open popup menu.
fb.mvar = -1 ' Identifies the menu is open.
If PopDrg = 0 Then
ReDim menu_restrict(nomi) ' Restrictions.
If text$(fb.InputField) = "" Then
For i = 1 To nomi - 2: menu_restrict(i) = 1: Next
Else
If hl = 0 Then
For i = 1 To 4: menu_restrict(i) = 1: Next
End If
End If
If Len(_Clipboard$) Then menu_restrict(3) = 0 Else menu_restrict(3) = 1 ' End Restrictions.
MenuT = 1: MenuL = 1: MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
t& = _NewImage((fb.mwidth - 1) * _FontWidth, _FontHeight, 32)
_Dest t&
Line (0, 0)-((fb.mwidth - 2) * _FontWidth, _FontHeight), _RGB32(128, 128, 128, 190), BF
shadowM = _CopyImage(t&, 33)
_FreeImage t&
t& = _NewImage((fb.mwidth + 2) * _FontWidth, (fb.mheight + 1) * _FontHeight, 32)
_Dest t&
Line (0, fb.mheight * _FontHeight)-(fb.mwidth * _FontWidth, fb.mheight * _FontHeight), _RGB32(240, 240.240), BF
Line ((fb.mwidth) * _FontWidth, _FontHeight)-((fb.mwidth + 2) * _FontWidth, (fb.mheight + 1) * _FontHeight), _RGB32(0, 0, 0, 50), BF
Line (_FontWidth * 2, (fb.mheight) * _FontHeight)-(fb.mwidth * _FontWidth - 1, (fb.mheight + 1) * _FontHeight), _RGB32(0, 0, 0, 50), BF
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Locate MenuT, MenuL
Print Chr$(218) + String$(fb.mwidth - 2, 196) + Chr$(191) ' Menu top border.
For i = 1 To fb.mheight - 2
Locate , MenuL
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print Chr$(179); Space$(fb.mwidth - 2) + Chr$(179)
Next
Locate , MenuL
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Print Chr$(192) + String$(fb.mwidth - 2, 196) + Chr$(217); ' Menu bottom border.
For i = 0 To nomi - 1 ' Show menu items.
Locate MenuT + 1 + i * 2, MenuL + 2
If menu_restrict(i + 1) Then
Color _RGB32(128, 128, 128), _RGB32(255, 255, 255)
Else
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
End If
Print menu$(i + 1)
Color _RGB32(0, 0, 0), _RGB32(255, 255, 255)
Locate , MenuL
If i + 1 < nomi Then Print "Ã" + String$(fb.mwidth - 2, Chr$(196)) + "´";
Next
hwpop& = _CopyImage(t&, 33)
_FreeImage t&
_Dest 0
End If
MenuHL = 0 ' Removes any menu highlighting when using a right click to move menu.
Select Case menu_variety
Case 0 ' Fixed menu to left.
MenuT = 3: MenuL = 1: MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
Case 1 ' Movable menu.
Select Case PopDrg
Case Is < 0
MenuL = Abs(PopDrg)
PopDrg = 0 ' Drag cycle completed.
Case Is > 0
MenuT = my
MenuL = PopDrg
Case 0
MenuT = my
MenuL = mx
End Select
If MenuT + fb.mheight > _Height Then MenuT = _Height - fb.mheight ' -1 for shadow.
If MenuL + fb.mwidth >= _Width Then MenuL = _Width - fb.mwidth - 1 ' -1 for shadow.
MenuR = MenuL + fb.mwidth: MenuB = MenuT + fb.mheight
End Select
Case -1 ' Hover or menu actions.
If b$ = Chr$(0) + "H" Or mw = -1 Then ' Keyboard ---------------
If (MenuHL - MenuT + 1) \ 2 > 1 Then
MenuHL = MenuHL - 2
b$ = ""
End If
ElseIf b$ = Chr$(0) + "P" Or mw = 1 Then
If MenuHL = 0 Then
MenuHL = MenuT + 1
Else
If (MenuHL - MenuT + 1) \ 2 < nomi Then
MenuHL = MenuHL + 2
End If
End If
b$ = ""
ElseIf b$ = Chr$(13) And MenuHL Or mb = 2 And MenuHL Then
b$ = ""
If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
fb.mvar = (MenuHL - MenuT + 1) \ 2
popit = 0
Exit Do
End If ' ----------------------------------------------------
ElseIf Len(b$) Then ' Menu selections by key.
Select Case b$
Case Chr$(0) + "S", Chr$(22), Chr$(24), Chr$(1), Chr$(3): popit = 0: Exit Do
Case Chr$(27): b$ = "": fb.mvar = 0: popit = 0: Exit Do ' Simply close popup.
Case Else: b$ = "" ' Prevents a non-menu response from getting into the input line routine.
End Select ' ------------------------------------------------
Else ' Mouse input.
i = my >= MenuT And my < MenuB And mx > MenuL And mx < MenuR
If my <> oldmy Or mx <> oldmx Or lb = 2 And drag = 0 Or rb = 2 Then
If i Then
hot` = (my - MenuT) \ 2 <> (my - MenuT) / 2 ' Local variable to determine if click is on a menu item or space between.
If hot` Then
If lb = 2 And MenuHL <> my Or rb = 2 And MenuHL <> my Then hot` = 0
MenuHL = my
End If
Else
hot` = 0
End If
End If
End If
If rb = 2 And MenuHL <> my Then
If Not hot` Then ' If inside menu it will go to next condition.
If my <> MenuT Or mx <> MenuL Then ' Reopen only if mouse position has changed.
If Not i Then
fb.mvar = 0: Exit Do ' Right click to close menu and reopen in new location.
End If
End If
End If
End If
If lb = 2 Or rb = 2 Then ' Left mouse click.
If hot` Then ' Get selection if non-restricted.
If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
fb.mvar = (MenuHL - MenuT + 1) \ 2
popit = 0
End If
Exit Do
Else ' Close popup if click was outside the menu; otherwise click is ignored.
If Not i And rb <> 2 Then ' Never close the popup with a right click.
popit = 0
fb.mvar = 0
End If
Exit Do
End If
End If ' --------------------------------------------------------
End Select
Exit Do
Loop
oldmy = my: oldmx = mx
If popit = 0 Then MenuHL = 0
Color restore_color1, restore_color2
Locate y, x
_KeyClear
Select Case fb.mvar
Case 1: b$ = Chr$(24) ' Cut
Case 2: b$ = Chr$(3) ' Copy
Case 3: b$ = Chr$(22) ' Paste
Case 4: b$ = Chr$(0) + "S" ' Delete
Case 5: b$ = Chr$(1) ' Select All
Case 6 ' Close
End Select
If fb.mvar > 0 Or Len(b$) Then fb.mvar = 0 ' A selection was reported above or by keyboard shortcut.
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 ' Note: Do not exit as mouse buttons may also be going through a cycle when mouse clicks are converted to key entries.
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
act = 1
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
If rb > 0 Then If rb = 1 Then rb = -1: act = 1 Else rb = 0: act = -1
If mb > 0 Then If mb = 1 Then mb = -1: act = 1 Else mb = 0: act = -1
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
If ctrl% Then ' Convert select all, cut, copy, paste.
Select Case LCase$(b$)
Case "a": b$ = Chr$(1)
Case "x": b$ = Chr$(24)
Case "c": b$ = Chr$(3)
Case "v": b$ = Chr$(22)
Case Chr$(0) + "k": b$ = Chr$(0) + "s"
Case Chr$(0) + "m": b$ = Chr$(0) + "t"
End Select
End If
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_demo (fb As fields_and_buttons, nul As String * 1, lb, mb, rb, mw, my, mx)
Static cnt As Integer, y As Integer
_ControlChr Off
ReDim a$(_Height)
_KeyClear
If fb.mapping = 0 Then _Title "Mouse / Keyboard Demo with Array Mapping" Else _Title "Mouse / Keyboard Demo with Screen Mapping"
fb.Fg = 0
fb.Bg = 5
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 = 7: fb.B1HvrBg = 7: fb.B1FlashFg = 1: fb.B1FlashBg = 7
fb.B2BdrFg = 8: fb.B2BdrHover = 1: fb.B2BdrFlash = 9
fb.B3OutRed = 95: fb.B3OutGrn = 95: fb.B3OutBlu = 95
fb.B3InRed = 155: fb.B3InGrn = 155: fb.B3InBlu = 155
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
' Input Field Colors
fb.page_color = _BackgroundColor
fb.input_frg = 15
fb.input_bkg = 0
fb.hl1 = 15 ' Highlight text forground.
fb.hl2 = 1 ' Highlight text background.
fb.skin_frg = 0 ' These next 4 are for popup input windows, not full page.
fb.skin_bkg = 5
fb.skin_shadow_frg = 8
fb.skin_shadow_bkg = 0
' Popup Colors
fb.cp2 = 6 ' Popup background.
fb.cp4 = 3 ' Popup shadow.
fb.cp1 = 0 ' Available menu item.
fb.cp3 = 7 ' Unavailable menu item.
' Display Demo Items
fb.a = "Hover:": fb_fields fb, 2, 51, 2, 0, nul
fb.a = "Button Style:": fb_fields fb, 4, 51, 2, 0, nul
fb.a = "Tab:": fb_fields fb, 6, 51, 2, 0, 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, 33, 51, 19, 38, "Text goes here."
Rem For i = 1 To _Height - 1: Locate i, 1: Print mRow$(i);: Next ' Test mapping area.
SkipAct = 0: z1 = Timer
fb.idle = 10
Do
MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
If fb.PopStatus = 0 Then
If drag Then
If olddrag <> drag Then
If drag > 0 Then a$ = "Drag Right. Status = " + LTrim$(Str$(drag)) Else a$ = "Drag Left. Status = " + LTrim$(Str$(drag))
GoSub print_array
olddrag = drag
End If
Else
olddrag = 0
End If
If oldlb <> lb Then
Select Case lb
Case 0
a$ = "Left Button Up - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
a$ = "Number of clicks = " + LTrim$(Str$(clkcnt)): GoSub print_array
Case -1
a$ = "Left Button Down - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
Case 1
a$ = "Left Button Pressed - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
Case 2
a$ = "Left Button Released - Button Status = " + LTrim$(Str$(lb)): GoSub print_array
End Select
End If
If oldmb <> mb Then
Select Case mb
Case 0: a$ = "Middle Button Up - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
Case -1: a$ = "Middle Button Down - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
Case 1: a$ = "Middle Button Pressed - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
Case 2: a$ = "Middle Button Released - Button Status = " + LTrim$(Str$(mb)): GoSub print_array
End Select
End If
If oldrb <> rb Then
Select Case rb
Case 0: a$ = "Right Button Up - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
Case -1: a$ = "Right Button Down - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
Case 1: a$ = "Right Button Pressed - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
Case 2: a$ = "Right Button Released - Button Status = " + LTrim$(Str$(rb)): GoSub print_array
End Select
End If
If oldmw <> mw Then
If mw < 0 Then a$ = "Mouse Wheel Up - Wheel Status = " + LTrim$(Str$(mw)): GoSub print_array
If mw > 0 Then a$ = "Mouse Wheel Down - Wheel Status = " + LTrim$(Str$(mw)): GoSub print_array
End If
If fb.BSelect Then a$ = "Button Selected = " + LTrim$(Str$(fb.BSelect)): GoSub print_array
If oldalt% <> alt% Then
If alt% < 0 Then a$ = "Alt Button Down" Else a$ = "Alt Button Released"
GoSub print_array
End If
If oldctrl% <> ctrl% Then
If ctrl% < 0 Then a$ = "Ctrl Button Down" Else a$ = "Ctrl Button Released"
GoSub print_array
End If
If oldshift% <> shift% Then
If shift% < 0 Then a$ = "Shift Button Down" Else a$ = "Shift Button Released"
GoSub print_array
End If
If AltStatus% And OldAltStatus% <> AltStatus% Then
If AltToggle% Then a$ = "Alt Key Pressed / Alt Toggle Status: On" Else a$ = "Alt Key Pressed / Alt Toggle Status: Off"
GoSub print_array
End If
If k& < 0 Then oldb$ = ""
Select Case Len(b$)
Case 1
If oldb$ <> b$ Then x = CVI(MKI$(Asc(b$))): a$ = "You Pressed: " + Chr$(x) + " Chr$(" + LTrim$(Str$(x)) + ")": GoSub print_array
oldb$ = b$
Case 2
If oldb$ <> b$ Then a$ = "You Pressed: " + "nul + " + LTrim$(Str$(Asc(Mid$(b$, 2, 1)))) + " Chr$(0) + " + Chr$(34) + Mid$(b$, 2, 1) + Chr$(34): GoSub print_array
oldb$ = b$
End Select
oldlb = lb: oldrb = rb: oldmb = mb: oldmw = mw: oldalt% = alt%: oldctrl% = ctrl%: oldshift% = shift%: OldAltStatus% = AltStatus%
End If
If act Or Abs(z1 - Timer) < fb.idle Or fb.SkipAct <> 0 Then
If door = -1 Then
_PaletteColor 5, _RGB32(255, 255, 255, 0)
Palette 6, 63
End If
If fb.SkipAct = 0 Then If act Then z1 = Timer
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
door = 0
Else
If door = 0 Then
_PaletteColor 5, _RGB32(215, 215, 215, 235)
_PaletteColor 6, _RGB32(205, 205, 205)
fb_main fb, b$, mx, my, lb, rb, mb, mw, shift%, drag, autokey$
_Limit 10
End If
door = -1
End If
Loop
print_array:
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
Return
End SubPete
![[Image: french-army-knife.jpg]](https://i.ibb.co/tLyN9Bh/french-army-knife.jpg)
