Since I was going in this direction, next. Here is an early continued WIP of the mouse with fileds and buttons project, with a popup added...
You can change the fb.style 1 - 5, but if you use 5 the OK button will be displayed as Activate and you will need to download the buttons from my other WIP post.
Pete
Code: (Select All)
_Title "Roll The Dice by SierraKen"
Dim Shared overlay, demo As Integer
Dim As Single lb, mb, rb, mw, my, mx
ReDim Shared fld$(0), button$(0), mRow$(0)
ReDim Shared x(0), y(0), y1(0), y2(0), x1(0), x2(0), fnx(0), btnmap(0), FType(0)
Type fields_and_buttons
a As String
initiate As Integer
tabmax As Integer
tb As Integer
SimClick As Integer
fld As Integer
nof As Integer
nob As Integer
mapping As Integer
style As Integer
BSelect As Integer
Bg As Integer ' Begin button colors.
BBdr As Integer
BBdrHover As Integer
BBdrFlash As Integer
BFg As Integer
BBg As Integer
BBg1 As Integer
BHvrFg As Integer
BHvrBk As Integer
BFgFlash As Integer
BBgFlash As Integer
BHybFg As Integer
BHybBg1 As Integer
BHybBg2 As Integer
BHybBdr1 As Integer
BHybBdr2 As Integer
End Type
Dim fb As fields_and_buttons
fb.BBdr = 8: fb.BBdrHover = 1: fb.BBdrFlash = 9: fb.BFg = 15: fb.BBg = 3: fb.BBg1 = 1: fb.BHvrFg = 3: fb.BHvrBk = 1: fb.BFgFlash = 1: fb.BBgFlash = 3
fb.Bg = 5: fb.BHybBg1 = 6: fb.BHybFg = 6: fb.BHybBg2 = 7: fb.BHybBdr1 = 0: fb.BHybBdr2 = 255
If fb.style = 0 Then fb.style = 2
Palette 5, 63
Palette 6, 56
Palette 7, 63
Color 0, 7: Cls
Randomize Timer
Do
Do
defaultInput$ = " "
message$ = "How many sides is your dice (3-100)?"
result$ = _InputBox$(title$, message$, defaultInput$)
If _Trim$(result$) = "" Then End
num = Val(result$)
If num < 3 Or num > 100 Or num <> Int(num) Then
Rem _MessageBox "Roll The Dice", "Pick only between 3 and 100."
msg$ = "Pick only between 3 and 100.": GoSub pete
Exit Do
End If
dice = Int(Rnd * num) + 1
dice$ = Str$(dice)
Rem _MessageBox "Roll The Dice", "Your roll: " + dice$
msg$ = "Your roll: " + dice$: GoSub pete
Loop
Loop
End
pete:
popup 6, 19, 9, 32 ' Top, Left, Height, Width.
Locate 7, 19 - 1 + (32 - Len(msg$)) \ 2: print_array msg$
If fb.style = 5 Then
fb.a = "Activate": fb_text_buttons fb, 11, 30
Else
fb.a = " OK ": fb_text_buttons fb, 10, 30
End If
Do
MyMouse_and_Keyboard lb, mb, rb, my, mx, mw, shift%, AltStatus%, AltToggle%, alt%, ctrl%, clkcnt, drag, k&, b$, autokey$
fb_main fb, b$, button$(), mx, my, lb
If fb.BSelect Then Exit Do
Loop
_AutoDisplay
PCopy 1, 0
Palette 7, 63
fb.initiate = 0
fb.tb = 0: fb.tabmax = 0: fb.nof = 0: fb.nob = 0
ReDim fld$(0), button$(0), mRow$(0)
ReDim x(0), y(0), y1(0), y2(0), x1(0), x2(0), fnx(0), btnmap(0), FType(0)
Return
Sub print_array (a$)
s1 = CsrLin: s2 = Pos(0)
Print a$;
Locate s1, s2
End Sub
Sub MyMouse_and_Keyboard (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
_Limit 60
If AltStatus% Then AltStatus% = 0
If Len(autokey$) Then
b$ = Mid$(autokey$, 1, InStr(autokey$ + ",", ",") - 1)
autokey$ = Mid$(autokey$, InStr(autokey$ + ",", ",") + 1)
Exit Sub
Else
k& = _KeyHit
If k& = 100307 Or k& = 100308 Then
AltStatus% = -1
AltToggle% = 1 - AltToggle%
Exit Sub
End If
If k& > 0 Then
b$ = MKI$(k&)
If Mid$(b$, 2, 1) = Chr$(135) Then b$ = "" ' Keys like like Shift, Ctrl, and Alt.
If Right$(b$, 1) = Chr$(0) Then b$ = Left$(b$, 1)
Else
b$ = ""
End If
End If
If z1 Then If Abs(Timer - z1) > .25 Then z1 = 0: clkcnt = 0
If lb > 0 Then
If lb = 1 Then
lb = -1
Else
lb = 0
End If
End If
If rb > 0 Then If rb = 1 Then rb = -1 Else rb = 0
If mb > 0 Then If mb = 1 Then mb = -1 Else mb = 0
While _MouseInput
mwy = mwy + _MouseWheel
Wend
my = _MouseY
mx = _MouseX
If lb = -1 Then
If oldmy And oldmx <> mx Or oldmy And oldmy <> my Then
If mx <> oldmx Then drag = Sgn(mx - oldmx) ' Prevent zero which can occur if mouse moves off row when being dragged horizontally.
End If
End If
If drag = 0 Then
If mwy <> oldmw Then
mw = Sgn(mwy - oldmwy): mwy = 0
Else
mw = 0
End If
oldmwy = mwy
If _KeyDown(100303) Or _KeyDown(100304) Then shift% = -1 Else If shift% Then shift% = 0
If _KeyDown(100305) Or _KeyDown(100306) Then ctrl% = -1 Else If ctrl% Then ctrl% = 0
If _KeyDown(100307) Or _KeyDown(100308) Then alt% = -1 Else If alt% Then alt% = 0
End If
If lb = -1 And _MouseButton(1) = 0 Then
lb = 2: drag = 0: hover = 0
ElseIf rb = -1 And _MouseButton(2) = 0 Then
rb = 2
ElseIf mb = -1 And _MouseButton(3) = 0 Then
mb = 2
End If
If _MouseButton(1) Then
If lb = 0 Then
lb = 1: z1 = Timer
clkcnt = clkcnt + 1
End If
ElseIf _MouseButton(2) And rb = 0 Then
rb = 1
ElseIf _MouseButton(3) And mb = 0 Then
mb = 1
End If
oldmy = my: oldmx = mx
End Sub
Sub fb_main (fb As fields_and_buttons, b$, button$(), mx, my, lb)
Static prev_fld, HtmlBtn
s1 = CsrLin: s2 = Pos(0)
b_hover = 0: fb.fld = 0: fb.BSelect = 0
If fb.mapping Then
If Len(mRow$(my)) Then
i = Asc(Mid$(mRow$(my), mx, 1))
If i > 96 Then
fb.fld = i - 96
If FType(fb.fld) = 5 Then b_hover = btnmap(fb.fld)
End If
End If
Else
For i = 1 To fb.nof ' number of fields.
If my >= y1(i) And my <= y2(i) And mx >= x1(i) And mx <= x2(i) Then
Select Case FType(i)
Case 1
fb.fld = i
Case 5
fb.fld = i
b_hover = btnmap(fb.fld)
Exit For
End Select
End If
Next
End If
If lb = 2 And FType(fb.fld) = 1 Then
If FType(fb.tb) = 5 Then h = 1: fb_button_tab fb, h, HtmlBtn ' Unhighlight a tab highighted button.
If FType(fb.tb) = 1 Then
If demo Then Locate , Pos(0) + 2, 1, 7, 1: s1 = CsrLin: s2 = Pos(0)
End If
fb.tb = fb.fld - 1
b$ = Chr$(9)
End If
If prev_fld And prev_fld <> fb.fld Then ' Remove button hover effect when present.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
i = prev_fld
j = Len(button$(btnmap(i)))
Select Case fb.style
Case 1 'Single line button with blank border.
Color fb.BBg1, fb.Bg
Locate y1(i) - 1, x1(i): Print String$(j, 220);
Locate y1(i) + 1, x1(i): Print String$(j, 223);
Color fb.BFg, fb.BBg1
Locate y1(i), x1(i): Print button$(btnmap(i));
Case 2 ' Text button with line border.
Color fb.BBdr, fb.Bg
Locate y1(i), x1(i): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x1(i): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x1(i): Print Chr$(192) + String$(j, 196) + Chr$(217);
Case 3 ' Text hybrid button with graphics line border.
j = Len(button$(btnmap(i)))
k = btnmap(i)
_Dest overlay
Line (8 * (x(k) - 1) + 2, 16 * (y(k) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(k) - 1) - 2, 16 * 2 + 16 * (y(k) - 1) + 7 - 2), _RGB32(155, 155, 155), B
Line (8 * (x(k) - 1), 16 * (y(k) - 1) + 7)-((j + 2) * 8 + 8 * (x(k) - 1), 16 * 2 + 16 * (y(k) - 1) + 7), _RGB32(fb.BHybBdr1, fb.BHybBdr1, fb.BHybBdr1), B
Line (8 * (x(k) - 1) + 8, 16 * (y(k) - 1) + 15)-((j + 1) * 8 + 8 * (x(k) - 1), y(k) * 16 + 15), _RGB32(fb.BHybBdr2, fb.BHybBdr2, fb.BHybBdr2), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_FreeImage Overlay_Hardware
_Dest 0
Color fb.BHybFg, fb.BHybBg2
Locate y1(i) + 1, x1(i) + 1: Print button$(btnmap(i));
End Select
prev_fld = 0
force = -1 ' Local variable to force any tab button field to remain highlighted.
Color c1, c2
Locate s1, s2
End If
If fb.tabmax And b$ = Chr$(9) Then
If fb.tb = fb.tabmax Then ' Redo cycle.
If FType(fb.tb) = 5 Then
h = 1: fb_button_tab fb, h, HtmlBtn ' Remove tab highlighted button in last field.
End If
fb.tb = 0: HtmlBtn = 0
Else
If FType(fb.tb + 1) = 5 Then
If FType(fb.tb) = 5 Then
h = 1: fb_button_tab fb, h, HtmlBtn
End If
fb.tb = fb.tb + 1 ' Note: Button will be highlighted at end of subroutine.
HtmlBtn = 0
force = 1: ' Local variable to force any tab button field to remain highlighted.
Else
fb.tb = fb.tb + 1 ' Increase tab field for text / non-button fields.
i = Val(Mid$(fld$(fb.tb), 6, 5))
j = Val(Mid$(fld$(fb.tb), 16, 5)) + 1
Locate y1(fb.tb), fnx(fb.tb)
If demo Then Locate , Pos(0) + 2, 1, 7, 1
s1 = CsrLin: s2 = Pos(0)
End If
End If
End If
If fb.tb Then
If b$ = Chr$(13) Then
If FType(fb.tb) = 5 Then
fb.SimClick = 1 ' Simulate a left button click.
End If
End If
If FType(fb.tb) = 1 Then
Locate , , 1
Else
Locate , , 0
End If
End If
If b_hover Or fb.SimClick Then ' Add hover effect.
If fb.SimClick Then
h = fb.SimClick
If h = -1 Then h = 0
l = btnmap(fb.tb)
q = fb.tb
Else
prev_fld = fb.fld
h = lb
q = fb.fld
l = b_hover
End If
If demo Then
Select Case l
Case 1, 2: fb.style = 1
Case 3, 4: fb.style = 2
Case 5, 6: fb.style = 3
Case 7, 8: fb.style = 4
Case 9, 10: fb.style = 5
End Select
End If
Select Case h
Case 0, -1, 1 ' Static or color change if button clicked.
s1 = CsrLin: s2 = Pos(0)
c1 = _DefaultColor: c2 = _BackgroundColor
j = Len(button$(l))
Select Case fb.style
Case 1 'Single line button with blank border remover hover.
If Abs(h) = 1 Then Color fb.BBgFlash, fb.Bg Else Color fb.BHvrFg, fb.Bg
Locate y1(q) - 1, x1(q): Print String$(j, 220);
Locate y1(q) + 1, x1(q): Print String$(j, 223);
If Abs(h) = 1 Then Color fb.BFgFlash, fb.BBgFlash Else Color fb.BFg, fb.BBg
Locate y1(q), x1(q): Print button$(l);
Case 2 ' Text button with line border remove hover.
If Abs(h) = 1 Then Color fb.BBdrFlash, fb.Bg Else Color fb.BBdrHover, fb.Bg
Locate y1(q), x1(q): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x1(q): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x1(q): Print Chr$(192) + String$(j, 196) + Chr$(217);
Rem Locate y1(q) + 1, x1(q) + 1: Print button$(l);
Case 3 ' Text hybrid button with graphics line border remove hover.
j = Len(button$(l))
k = btnmap(q)
If Abs(h) = 1 Then Color fb.Bg, fb.BHybFg Else Color fb.BHybFg, fb.BHybBg2
Locate y1(q) + 1, x1(q) + 1: Print button$(l);
_Dest overlay
Line (8 * (x(k) - 1) + 2, 16 * (y(k) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(k) - 1) - 2, 16 * 2 + 16 * (y(k) - 1) + 7 - 2), _RGB32(0, 155, 155), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_FreeImage Overlay_Hardware
_Dest 0
End Select
Color c1, c2
Locate s1, s2
Case 2 ' Button selection completed.
fb.BSelect = l
fb.SimClick = 0
End Select
If fb.SimClick = -1 Then fb.SimClick = 2
If fb.SimClick = 1 Then fb.SimClick = -1
End If
If demo Or fb.style = 4 Then
If demo Then i2 = 7: i3 = 8 Else i2 = 1: i3 = fb.nob
For k = i2 To i3
j = Len(button$(k)): a$ = " " + button$(k) + " "
HTMLBStatic = fb_gfx_hyb_hw(j * 8, 2 * 16, 170, 170, 170, -9, -9, -1, Mid$(a$, 1, j))
HTMLBHover = fb_gfx_hyb_hw(j * 8, 2 * 16, 200, 200, 200, -8, -7, -1, Mid$(a$, 1, j))
HTMLBPress = fb_gfx_hyb_hw(j * 8, 2 * 16, 200, 200, 200, -1, -1, -1, Mid$(a$, 1, j))
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
If HtmlBtn = k And lb = 0 Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), HTMLBHover
Else
If lb = 0 And b_hover = k Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), HTMLBHover
ElseIf Abs(lb) = 1 And b_hover = k Then
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), HTMLBPress
Else
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), HTMLBStatic
End If
End If
_FreeImage HTMLBHover
_FreeImage HTMLBPress
_FreeImage HTMLBStatic
_FreeImage Overlay_Hardware
Next
_Dest 0
End If
If demo Or fb.style = 5 Then
If demo Then i2 = 9: i3 = 10 Else i2 = 1: i3 = fb.nob
For k = i2 To i3
_Dest overlay
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
If HtmlBtn = k And lb = 0 Then
img& = _LoadImage(button$(k) + "-hover.png", 32)
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), img&
Else
If lb = 0 And b_hover = k Then
img& = _LoadImage(button$(k) + "-hover.png", 32)
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), img&
ElseIf Abs(lb) = 1 And b_hover = k Then
img& = _LoadImage(button$(k) + "-active.png", 32)
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), img&
Else
img& = _LoadImage(button$(k) + "-static.png", 32)
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), img&
End If
End If
_FreeImage img&
_FreeImage Overlay_Hardware
Next
_Dest 0
End If
If prev_fld <> b_hover And prev_fld = fb.fld Or force Then
If FType(fb.tb) = 5 Then
If b_hover = 0 Or force Then h = 2: fb_button_tab fb, h, HtmlBtn
End If
End If
If demo Then
q1 = CsrLin: q2 = Pos(0)
Color 15, 0
Locate 2, 66 - 7: Print b_hover;: Locate 4, 71 - 5
If b_hover Then Print fb.style; Else j = 0: Print j;
Locate 6, 63 - 6: Print fb.tb;
Color 0, 5
Locate q1, q2
End If
Locate s1, s2
_Display
End Sub
Sub fb_button_tab (fb As fields_and_buttons, h, HtmlBtn)
Dim As Integer i, j, k
s1 = CsrLin: s2 = Pos(0)
temp = fb.style
If demo Then
Select Case btnmap(fb.tb)
Case 1, 2: fb.style = 1
Case 3, 4: fb.style = 2
Case 5, 6: fb.style = 3
Case 7, 8: fb.style = 4
Case 9, 10: fb.style = 5
End Select
End If
i = fb.tb
j = Len(button$(btnmap(i)))
k = btnmap(i)
Select Case h
Case 1: ' Remove tab button highlighting.
Select Case fb.style
Case 1 ' Single line button with blank border.
Color fb.BBg1, fb.Bg
Locate y1(i) - 1, x1(i): Print String$(j, 220);
Locate y1(i) + 1, x1(i): Print String$(j, 223);
Color fb.BFg, fb.BBg1
Locate y1(i), x1(i): Print button$(btnmap(fb.tb));
Case 2 ' Text button with line border.
Color fb.BBdr, fb.Bg
Locate y1(i), x1(i): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x1(i): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x1(i): Print Chr$(192) + String$(j, 196) + Chr$(217);
Case 3 ' Text hybrid button with graphics line border.
_Dest overlay
Line (8 * (x(k) - 1) + 2, 16 * (y(k) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(k) - 1) - 2, 16 * 2 + 16 * (y(k) - 1) + 7 - 2), _RGB32(155, 155, 155), B
Line (8 * (x(k) - 1), 16 * (y(k) - 1) + 7)-((j + 2) * 8 + 8 * (x(k) - 1), 16 * 2 + 16 * (y(k) - 1) + 7), _RGB32(fb.BHybBdr1, fb.BHybBdr1, fb.BHybBdr1), B
Line (8 * (x(k) - 1) + 8, 16 * (y(k) - 1) + 15)-((j + 1) * 8 + 8 * (x(k) - 1), y(k) * 16 + 15), _RGB32(fb.BHybBdr2, fb.BHybBdr2, fb.BHybBdr2), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_FreeImage Overlay_Hardware
_Dest 0
Color fb.BHybFg, fb.BHybBg2
Locate y1(i) + 1, x1(i) + 1: Print button$(btnmap(fb.tb));
Case 4 ' Graphics hybrid button.
HTMLBStatic = fb_gfx_hyb_hw(j * 8, 2 * 16, 170, 170, 170, -9, -9, -1, Mid$(a$, 1, j))
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_PutImage ((x(k) - 1) * 8, (y(k) - 1) * 16 + 8), HTMLBStatic
_FreeImage HTMLBStatic
_FreeImage Overlay_Hardware
Case 5 ' HTML button.
_Dest overlay
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
img& = _LoadImage(button$(btnmap(i)) + "-static.png", 32)
_PutImage ((x(k) - 1) * 8 + 4, (y(k) - 1) * 16), img&
_FreeImage img&
_FreeImage Overlay_Hardware
_Dest 0
End Select
Case 2 ' Tab button highlighting.
Select Case fb.style
Case 1 ' Tab highlight single line button with blank border.
Color fb.BHvrFg, fb.Bg
Locate y1(i) - 1, x1(i): Print String$(j, 220);
Locate y1(i) + 1, x1(i): Print String$(j, 223);
Color fb.BFg, fb.BBg
Locate y1(i), x1(i): Print button$(btnmap(fb.tb));
Case 2 ' Tab highlight text button with line border.
Color fb.BBdrHover, fb.Bg
Locate y1(i), x1(i): Print Chr$(218) + String$(j, 196) + Chr$(191)
Locate , x1(i): Print Chr$(179);: Locate , Pos(0) + j: Print Chr$(179)
Locate , x1(i): Print Chr$(192) + String$(j, 196) + Chr$(217);
Case 3 ' Text hybrid button with graphics line border.
Color fb.BHybFg, fb.BHybBg2
Locate y1(i) + 1, x1(i) + 1: Print button$(btnmap(fb.tb));
_Dest overlay
Line (8 * (x(k) - 1) + 2, 16 * (y(k) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(k) - 1) - 2, 16 * 2 + 16 * (y(k) - 1) + 7 - 2), _RGB32(0, 155, 155), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_FreeImage Overlay_Hardware
_Dest 0
Case 4, 5
HtmlBtn = btnmap(fb.tb)
End Select
End Select
Locate s1, s2
fb.style = temp
End Sub
Sub fb_text_buttons (fb As fields_and_buttons, y, x)
Static btnnbr
If fb.initiate = 0 Then
fb.initiate = 1
btnnbr = 0
If demo Or fb.style >= 3 Then
overlay = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)
End If
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)
FType(fb.nof) = 5
btnnbr = btnnbr + 1
btnmap(fb.nof) = btnnbr
fld$(fb.nof) = Space$(25)
ReDim _Preserve y1(fb.nof), x1(fb.nof), y2(fb.nof), x2(fb.nof), button$(fb.nof)
button$(btnnbr) = String$(j, 0) ' Fill any spaces with the null character.
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(fb.a))) \ 2) = _Trim$(fb.a)
Select Case fb.style
Case 1 ' Single line button with blank border.
y = Abs(y)
Color fb.BFg, fb.BBg1: Locate y, x: fb.a = button$(btnnbr): fb_map fb, 5
Color fb.BBg1, fb.Bg: Locate y - 1, x: fb.a = String$(j, Chr$(220)): fb_map fb, 0
Locate y + 1, x: fb.a = String$(j, Chr$(223)): fb_map fb, 0
Case 2 ' Text button with line border.
Color fb.BBdr, fb.Bg
Locate y - 1, x - 1: fb.a = Chr$(218) + String$(j, 196) + Chr$(191): fb_map fb, 6
Locate y, x - 1: fb.a = Chr$(179): fb_map fb, 0
Locate , Pos(0) + j: fb.a = Chr$(179): fb_map fb, 0
Locate y + 1, x - 1: fb.a = Chr$(192) + String$(j, 196) + Chr$(217): fb_map fb, 7
Locate y, x: fb.a = button$(btnnbr): fb_map fb, 0
Case 3 ' Text hybrid button with graphics line border.
i = btnnbr
j = Len(fb.a)
k = btnnbr
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr)
y(k) = y - 1: x(k) = x - 1
button$(i) = String$(j, 0)
Mid$(button$(i), 1 + (j - Len(_Trim$(fb.a))) / 2) = _Trim$(fb.a)
Locate y - 1, x - 1: Color fb.BHybBg1, fb.Bg: fb.a = String$(j + 2, "Ü"): fb_map fb, 6
Locate y, x - 1: Color fb.Bg, fb.BHybBg1: fb.a = String$(j + 2, 0): fb_map fb, 0
Locate y + 1, x - 1: Color fb.BHybBg1, fb.Bg: fb.a = String$(j + 2, "ß"): fb_map fb, 7
Locate y, x: Color fb.BHybFg, fb.BHybBg2: fb.a = button$(i): fb_map fb, 0
_Dest overlay
Line (8 * (x(k) - 1) + 2, 16 * (y(k) - 1) + 7 + 2)-((j + 2) * 8 + 8 * (x(k) - 1) - 2, 16 * 2 + 16 * (y(k) - 1) + 7 - 2), _RGB32(155, 155, 155), B
Line (8 * (x(k) - 1), 16 * (y(k) - 1) + 7)-((j + 2) * 8 + 8 * (x(k) - 1), 16 * 2 + 16 * (y(k) - 1) + 7), _RGB32(fb.BHybBdr1, fb.BHybBdr1, fb.BHybBdr1), B
Line (8 * (x(k) - 1) + 8, 16 * (y(k) - 1) + 15)-((j + 1) * 8 + 8 * (x(k) - 1), y(k) * 16 + 15), _RGB32(fb.BHybBdr2, fb.BHybBdr2, fb.BHybBdr2), B
Overlay_Hardware = _CopyImage(overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_FreeImage Overlay_Hardware
_Dest 0
Case 4 ' Graphics hybrid button.
j = Len(fb.a)
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr)
y(btnnbr) = y - 1: x(btnnbr) = x - 1
button$(btnnbr) = String$(j + 2, 0)
Mid$(button$(btnnbr), 1 + (j - Len(_Trim$(fb.a))) / 2) = _Trim$(fb.a)
fb.a = button$(btnnbr)
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
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
_FreeImage img&
button$(btnnbr) = _Trim$(fb.a)
fb.a = String$(j, i)
ReDim _Preserve x(btnnbr), y(btnnbr), button$(btnnbr)
y(btnnbr) = y - 1: x(btnnbr) = x - 1
Locate y - 1, x - 1: fb_map fb, 10
For k = 0 To i - 2
Locate y + k, x - 1: fb_map fb, -1
Next
End Select
Color c1, c2
Locate s1, s2
End Sub
Function fb_gfx_hyb_hw (wide, tall, r, g, b, rc, gc, bc, caption$)
' Button function courtesy of the Amazing Steve.
Dim k As _Unsigned Long
Dest = _Dest
t = _NewImage(wide, tall, 32)
_Dest t
For i = 0 To 10
rm = rm + rc
gm = gm + gc
bm = bm + bc
k = _RGB32(r + rm, g + gm, b + bm)
Line (x + i, y + i)-(x + wide - i, y + tall - i), k, B
Next
Paint (x + i, y + i), k
Color _RGB32(r, g, b), 0
_PrintString (x + (wide - _PrintWidth(caption$)) / 2, y + (tall - _FontHeight) / 2), caption$
fb_gfx_hyb_hw = _CopyImage(t, 33)
_FreeImage t
_Dest Dest
End Function
Sub fb_map (fb As fields_and_buttons, mapid)
Static mapfld As Integer
If UBound(mRow$) = 0 Then
ReDim mRow$(_Height)
mapfld = 96
End If
If fb.mapping And mRow$(CsrLin) = "" Then mRow$(CsrLin) = Space$(_Width)
Select Case mapid
Case 1 ' Simple text field.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
y2(mapfld - 96) = CsrLin
x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 5 ' Single line button with blank padding.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
y2(mapfld - 96) = CsrLin
x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 6 ' Text or hybrid button top.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin: x1(mapfld - 96) = Pos(0)
Case 7 ' Text or hybrid button bottom.
y2(mapfld - 96) = CsrLin: x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 8 ' Graphics hybrid button top.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
Case 9 ' Graphics hybrid button bottom.
y2(mapfld - 96) = CsrLin
x2(mapfld - 96) = Pos(0) + Len(fb.a)
Case 10 ' HTML button.
mapfld = mapfld + 1 ' Advance.
y1(mapfld - 96) = CsrLin
x1(mapfld - 96) = Pos(0)
y2(mapfld - 96) = CsrLin + Asc(Mid$(fb.a, 1, 1))
x2(mapfld - 96) = Pos(0) + Len(fb.a)
End Select
If fb.mapping Then Mid$(mRow$(CsrLin), Pos(0)) = String$(Len(fb.a), Chr$(mapfld))
If mapid < 8 And mapid > -1 Then Print fb.a;
End Sub
Sub popup (m.top, m.left, m.height, m.width)
pop = 1
c.MenuBdrFg = 0
c.MenubrdBg = 5
c.MenuSdwFg = 6
c.MenuSdwBg = 0
c.MenuFg = 0
c.MenuBg = 5
spacing = 1
PCopy 0, 1
Palette 7, 7
Locate m.top - pop, m.left - pop
For h = 1 To m.height
If h = 1 Then
Color c.MenuBdrFg, c.MenubrdBg
Print Chr$(218) + String$(m.width - 2, 196) + Chr$(191)
j = CsrLin
For i = 1 To m.height - 2
If CsrLin < _Height Then Locate j, m.left - pop Else Locate , m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
Color c.MenuBdrFg, c.MenubrdBg: Print Space$(m.width - 2);
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(179);
j = j + 1
Next
Locate j, m.left - pop
Color c.MenuBdrFg, c.MenubrdBg: Print Chr$(192) + String$(m.width - 2, 196) + Chr$(217);
If pop Then ' Shadow effect.
Color c.MenuSdwFg, c.MenuSdwBg ' Shadow below.
Locate CsrLin + 1, m.left - pop + 2
For i = 1 To m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
Next
Locate m.top - pop + 1 ' Shadow to the right.
For i = 1 To m.height - 1
Locate , m.left - pop + m.width
j = Screen(CsrLin, Pos(0))
Print Chr$(j);
j = Screen(CsrLin, Pos(0))
Print Chr$(j)
Next
End If
End If
Color c.MenuFg, c.MenuBg
Locate m.top - pop + h + (h - 1) * spacing, m.left - pop + 2 - 1
Next h
End SubYou can change the fb.style 1 - 5, but if you use 5 the OK button will be displayed as Activate and you will need to download the buttons from my other WIP post.
Pete