@Sprezzo
Same old stuff, but gathering it all up into libraries. Well, old but with the added new stuff like hardware acceleration to add some effects in SCREEN 0 that were not possible in the old days.
So the problem I'm having with it is the popup shadow. You can open the popup by...
1) Left click on any character in the sample text input box.
2) Right click.
3) Hover the mouse near the top of the popup, depress the left mouse button, and start dragging the window around the screen.
Notice when the shadow moves over the first four 'software' buttons, it doesn't dim the button color it covers. This also happens with the software text, but it is less noticeble... umless the text has been highlighted. That becomes plenty noticeble.
There are rabbit holes everywhere to fix this, but nothing I've found is straight forward enough to bother with. Ironically _SCREENIMAGE could be used with other statements to make a temporary screen under the popup, which is a full hardware image. That would allow for a software popup with a hardware opaque shadow to correctly display. The problem is _SCREENIMAGE is dependent on exact coordinates of the QB64 window, minus the title bar. It would probably require API additions to track that, and my hunch is the screen contents wouldn't be perfectly aligned anymore, but really, really close. After the popup is closed, a copy of the old software screen would be put back, and the hardware images would return as the program cycles through their display statements. I wish _COPYIMAGE had this ability to capture the QB64 window contents in SCREEN 0 like _SCREENIMAGE does for the desktop.
Anyway, if you are inclined, download the buttons below to your QB64 folder and give it a good quantum spin. The demo is on, but if you change it to demo = 0 , in line 101, you can put in your own statements to place the various button types and text fields on a screen. See the examples I included beginning at line 114: ' Begin User Routine.
Pete
- Give Bill enough string and he'll tunnel himself.
Same old stuff, but gathering it all up into libraries. Well, old but with the added new stuff like hardware acceleration to add some effects in SCREEN 0 that were not possible in the old days.
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), a$(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 = 10
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, rb, drag
Loop
Sub fb_control (fb As fields_and_buttons, b$, mx, my, lb, 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
t = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)
_Dest t
Cls , _RGB32(255, 255, 255)
fb.HardwareBg = _CopyImage(t, 33)
_FreeImage t
_Dest 0
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
w& = _CopyImage(0)
_DisplayOrder _Hardware , _Software ' Hardware under software.
Cls , fb.Bg
PCopy w&, 0
If fb.idle = 0 Then If fb.SkipAct = 0 Then fb.idle = 5 ' Default.
End If
MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
_PutImage (0, 0), fb.HardwareBg
If act Or Abs(z1 - Timer) < fb.idle Or fb.SkipAct <> 0 Then
If door = -1 Then _PaletteColor 5, _RGB32(0, 0, 0, 0)
If fb.SkipAct = 0 Then If act Then z1 = Timer
fb_main fb, b$, mx, my, lb, rb, mw, shift%, drag, autokey$
door = 0
Else
If door <> -1 Then _PaletteColor 5, _RGB32(0, 0, 0, 50)
If door = 0 Then fb_main fb, b$, mx, my, lb, rb, mw, shift%, drag, autokey$
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).
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, 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 b$ = "" Then Exit Sub
If popit = 0 Then fb.CurShow = 1: Locate , , fb.CurShow, 7, fb.CurStyle ' Show cursor
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 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
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 toggel.
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$) <= Abs(hl) + Len(tmp$) Then
If hl Then GoSub cut '|--------------->
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, MenuT, MenuR, MenuB, MenuL, myalt, mxalt, shadowB, shadowR
y = CsrLin: x = Pos(0)
restore_color1 = _DefaultColor: restore_color2 = _BackgroundColor
Rem fb.CurShow = 0: Locate , , fb.CurShow ' Hide cursor
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
mxalt = 0
If b$ = Chr$(0) + "H" Or mw = -1 Then
If (MenuHL - MenuT + 1) \ 2 > 1 Then
myalt = MenuHL - 2: mxalt = -1
End If
ElseIf b$ = Chr$(0) + "P" Or mw = 1 Then
If MenuHL = 0 Then
myalt = MenuT + 1: mxalt = -1
Else
If (MenuHL - MenuT + 1) \ 2 < nomi Then
myalt = MenuHL + 2: mxalt = -1
End If
End If
ElseIf b$ = Chr$(13) Or mb = 2 Then
If menu_restrict((MenuHL - MenuT + 1) \ 2) = 0 Then
fb.mvar = (MenuHL - MenuT + 1) \ 2
popit = 0
Exit Do
End If
End If
If PopDrg < 0 Then
PopDrg = -MenuL
fb.mvar = 0: MenuHL = 0
popit = -1
PCopy 1, 0
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
PCopy 1, 0 ' Removes current popup.
popit = -1 ' Reopens popup in next cycle.
End If
End If
End If
Select Case fb.mvar
Case -1 ' Hover.
If mxalt = 0 Then myalt = my: mxalt = mx
i = myalt >= MenuT And myalt < MenuB And mxalt > MenuL And mxalt < MenuR
If i Or mxalt = -1 Then
j = (myalt - MenuT) \ 2 <> (myalt - MenuT) / 2 And myalt <> oldmy
If j Or mxalt = -1 Then ' Works for odd or even number top margins.
If MenuHL Then ' Remove highlighting from previous hover.
atmp = Space$(fb.mwidth - 2) ' This and next line center menu item to menu.
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.cp3, fb.cp2 Else Color fb.cp1, fb.cp2
Print atmp
End If
atmp = Space$(fb.mwidth - 2)
Mid$(atmp, 2, Len(menu$((myalt - MenuT + 1) \ 2))) = menu$((myalt - MenuT + 1) \ 2)
Locate myalt, MenuL + 2 - 1
If menu_restrict((myalt - MenuT + 1) \ 2) Then Color fb.cp2, fb.cp3 Else Color fb.cp2, fb.cp1
Print atmp;
Color fb.cp1, fb.cp2
MenuHL = myalt
End If
If lb = 2 Then
If menu_restrict((myalt - MenuT + 1) \ 2) = 0 Then
fb.mvar = (myalt - MenuT + 1) \ 2
popit = 0
Exit Do
End If
End If
Else
' Toggle close popup menu.
If i = 0 And drag = 0 Then ' One exception is too close to top of menu to prevent closing on a drag event.
If lb <> 0 Or rb <> 0 Then
popit = 0
fb.mvar = 0: Exit Do
End If
End If
End If
If Len(b$) Then
Select Case b$
Case Chr$(0) + "S", Chr$(22), Chr$(24), Chr$(1), Chr$(3): Exit Do
Case Chr$(27): b$ = "": fb.mvar = 0: popit = 0: Exit Do ' Simply close popup.
End Select
End If
Case Else ' 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 + 1 ' One below input line.
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.
PCopy 0, 1 ' Place current page in memory to be restored when popup is closed.
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
End Select
Exit Do
Loop
oldmy = my: oldmx = mx
If popit = 0 Then PCopy 1, 0: MenuHL = 0 ' Removes popup, any popup highlighting, and restores screen.
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 Then fb.mvar = 0
End Sub
Sub MyMouse_and_Keyboard (act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$)
Dim As Integer oldmw
Static As Integer oldmy, oldmx, mwy, oldmwy
Static z1 As Single
Do
_Limit 60
act = 0
If AltStatus% Then AltStatus% = 0
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
act = 1
Exit Do
Else
k& = _KeyHit
If k& = 100307 Or k& = 100308 Then
AltStatus% = -1
AltToggle% = 1 - AltToggle%
act = 1
Exit Do
End If
If k& > 0 Then
b$ = MKI$(k&)
If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and Alt.
If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
act = 3
Else
b$ = ""
End If
End If
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1: act = 1
Else
lb = 0: act = -1
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1: act = 1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1: act = 1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel: act = 1
Wend
my = _MouseY
mx = _MouseX
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1: act = 1 Else If shift% Then shift% = 0
If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1: act = 1 Else If ctrl% Then ctrl% = 0
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1: act = 1 Else If alt% Then alt% = 0
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
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
w& = _CopyImage(0)
_DisplayOrder _Hardware , _Software ' Hardware under software.
Cls , fb.Bg ' Apply transparent software background.
PCopy w&, 0 ' Copy previously made software images back to the screen.
Do
MyMouse_and_Keyboard act, lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
_PutImage (0, 0), fb.HardwareBg
If act Or Abs(z1 - Timer) < fb.idle Or fb.SkipAct <> 0 Then
If door = -1 Then _PaletteColor 5, _RGB32(0, 0, 0, 0)
If fb.SkipAct = 0 Then If act Then z1 = Timer
fb_main fb, b$, mx, my, lb, rb, mw, shift%, drag, autokey$
door = 0
Else
If door <> -1 Then _PaletteColor 5, _RGB32(0, 0, 0, 50)
If door = 0 Then fb_main fb, b$, mx, my, lb, rb, mw, shift%, drag, autokey$
door = -1
End If
If fb.PopStatus = 0 Then
If drag Then
If olddrag <> drag Then
If drag > 0 Then GoSub print_array: a$ = "Drag Right. Status = " + LTrim$(Str$(drag)) Else GoSub print_array: a$ = "Drag Left. Status = " + LTrim$(Str$(drag))
olddrag = drag
End If
Else
olddrag = 0
End If
If oldlb <> lb Then
Select Case lb
Case 0
GoSub print_array: a$ = "Left Button Up - Button Status = " + LTrim$(Str$(lb))
GoSub print_array: a$ = "Number of clicks = " + LTrim$(Str$(clkcnt))
Case -1
GoSub print_array: a$ = "Left Button Down - Button Status = " + LTrim$(Str$(lb))
Case 1
GoSub print_array: a$ = "Left Button Pressed - Button Status = " + LTrim$(Str$(lb))
Case 2
GoSub print_array: a$ = "Left Button Released - Button Status = " + LTrim$(Str$(lb))
End Select
End If
If oldmb <> mb Then
Select Case mb
Case 0: GoSub print_array: a$ = "Middle Button Up - Button Status = " + LTrim$(Str$(mb))
Case -1: GoSub print_array: a$ = "Middle Button Down - Button Status = " + LTrim$(Str$(mb))
Case 1: GoSub print_array: a$ = "Middle Button Pressed - Button Status = " + LTrim$(Str$(mb))
Case 2: GoSub print_array: a$ = "Middle Button Released - Button Status = " + LTrim$(Str$(mb))
End Select
End If
If oldrb <> rb Then
Select Case rb
Case 0: GoSub print_array: a$ = "Right Button Up - Button Status = " + LTrim$(Str$(rb))
Case -1: GoSub print_array: a$ = "Right Button Down - Button Status = " + LTrim$(Str$(rb))
Case 1: GoSub print_array: a$ = "Right Button Pressed - Button Status = " + LTrim$(Str$(rb))
Case 2: GoSub print_array: a$ = "Right Button Released - Button Status = " + LTrim$(Str$(rb))
End Select
End If
If oldmw <> mw Then
If mw < 0 Then GoSub print_array: a$ = "Mouse Wheel Up - Wheel Status = " + LTrim$(Str$(mw))
If mw > 0 Then GoSub print_array: a$ = "Mouse Wheel Down - Wheel Status = " + LTrim$(Str$(mw))
End If
If fb.BSelect Then GoSub print_array: a$ = "Button Selected = " + LTrim$(Str$(fb.BSelect))
If oldalt% <> alt% Then
If alt% < 0 Then GoSub print_array: a$ = "Alt Button Down" Else GoSub print_array: a$ = "Alt Button Released"
End If
If oldctrl% <> ctrl% Then
If ctrl% < 0 Then GoSub print_array: a$ = "Ctrl Button Down" Else GoSub print_array: a$ = "Ctrl Button Released"
End If
If oldshift% <> shift% Then
If shift% < 0 Then GoSub print_array: a$ = "Shift Button Down" Else GoSub print_array: a$ = "Shift Button Released"
End If
If AltStatus% And OldAltStatus% <> AltStatus% Then
If AltToggle% Then GoSub print_array: a$ = "Alt Key Pressed / Alt Toggle Status: On" Else GoSub print_array: a$ = "Alt Key Pressed / Alt Toggle Status: Off"
End If
If k& < 0 Then oldb$ = ""
Select Case Len(b$)
Case 1
If oldb$ <> b$ Then x = CVI(MKI$(Asc(b$))): GoSub print_array: a$ = "You Pressed: " + Chr$(x) + " Chr$(" + LTrim$(Str$(x)) + ")"
oldb$ = b$
Case 2
If oldb$ <> b$ Then GoSub print_array: a$ = "You Pressed: " + "nul + " + LTrim$(Str$(Asc(Mid$(b$, 2, 1)))) + " Chr$(0) + " + Chr$(34) + Mid$(b$, 2, 1) + Chr$(34)
oldb$ = b$
End Select
oldlb = lb: oldrb = rb: oldmb = mb: oldmw = mw: oldalt% = alt%: oldctrl% = ctrl%: oldshift% = shift%: OldAltStatus% = AltStatus%
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 SubSo the problem I'm having with it is the popup shadow. You can open the popup by...
1) Left click on any character in the sample text input box.
2) Right click.
3) Hover the mouse near the top of the popup, depress the left mouse button, and start dragging the window around the screen.
Notice when the shadow moves over the first four 'software' buttons, it doesn't dim the button color it covers. This also happens with the software text, but it is less noticeble... umless the text has been highlighted. That becomes plenty noticeble.
There are rabbit holes everywhere to fix this, but nothing I've found is straight forward enough to bother with. Ironically _SCREENIMAGE could be used with other statements to make a temporary screen under the popup, which is a full hardware image. That would allow for a software popup with a hardware opaque shadow to correctly display. The problem is _SCREENIMAGE is dependent on exact coordinates of the QB64 window, minus the title bar. It would probably require API additions to track that, and my hunch is the screen contents wouldn't be perfectly aligned anymore, but really, really close. After the popup is closed, a copy of the old software screen would be put back, and the hardware images would return as the program cycles through their display statements. I wish _COPYIMAGE had this ability to capture the QB64 window contents in SCREEN 0 like _SCREENIMAGE does for the desktop.
Anyway, if you are inclined, download the buttons below to your QB64 folder and give it a good quantum spin. The demo is on, but if you change it to demo = 0 , in line 101, you can put in your own statements to place the various button types and text fields on a screen. See the examples I included beginning at line 114: ' Begin User Routine.
Pete
- Give Bill enough string and he'll tunnel himself.
