03-05-2024, 10:15 PM
UPDATE
Threw in a graphics button for comparison. It makes the text one look like it needs to subscribe to NutriSystem.
Pete
Threw in a graphics button for comparison. It makes the text one look like it needs to subscribe to NutriSystem.
Code: (Select All)
Const FALSE = 0, TRUE = Not FALSE
_ControlChr Off
Screen 0, 0, 0, 0
Palette 5, 63
Palette 6, 56
Color 0, 5
Cls
Type MouseType
EndX As Integer
EndY As Integer
StartX As Integer
StartY As Integer
LButDown As Integer
LtClick As Integer
End Type
Dim As MouseType Mouse
Dim As _Bit Active
Active = FALSE
enl% = 0: Call font_size_setup(enl%): _Delay .3
Dim b(13) As String * 1
b(0) = " "
b(1) = "Ú"
b(2) = "Ä"
b(3) = "¿"
b(4) = "³"
b(5) = "À"
b(6) = "Ù"
b(7) = "Ã"
b(8) = "´"
b(9) = "Ä"
b(10) = "Â"
b(11) = "Á"
b(12) = "Þ"
b(13) = "Ý"
y = 10: x = 50
Locate y + 1, 3: Print "Text button with hand cursor on hover:";
Locate y + 9, 3: Print "Graphics button with color change on hover:";
Do
Locate y, x: Color 5, 6: Print b(13);: Color 0, 6: Print b(1); String$(10, b(2)); b(3);: Color 5, 6: Print b(12)
Locate , x: Color 5, 6: Print b(13);: Color 0, 6: Print b(4); String$(10, b(0)); b(4);: Color 5, 6: Print b(12)
Locate , x: Color 5, 6: Print b(13);: Color 0, 6: Print b(5); String$(10, b(2)); b(6);: Color 5, 6: Print b(12);
Locate y + 1, x + 2: Color 7, 6: Print b(12);: Color 6, 7: Print "Activate";: Color 7, 6: Print b(13);
button_display$ = "on"
button_text$ = " Activate ": bw% = 12: bh% = 2: brow% = 18: bcol% = 51
GoSub formatbutton
Do
_Limit 30
While _MouseInput: Wend
Mouse.StartX = _MouseX
Mouse.StartY = _MouseY
Mouse.LButDown = _MouseButton(1)
If Not Mouse.LButDown And Mouse.LtClick Then Mouse.LtClick = 0
Active = FALSE: mybutton = 0
If Mouse.StartX >= x And Mouse.StartX <= x + 13 And Mouse.StartY >= 10 And Mouse.StartY <= 12 And Not Active Then
' Text Button
If Not Active Then mouseshow$ = "LINK": _MouseShow mouseshow$
Active = TRUE: mybutton = 1
ElseIf Mouse.StartX >= bcol% And Mouse.StartX <= bcol% + 11 And Mouse.StartY >= brow% And Mouse.StartY <= brow% + 1 And Not Active Then
' Graphics Button
If Not Active Then buttonhover = -1
Active = TRUE: mybutton = 2
End If
If Not Active And mouseshow$ = "LINK" Then mouseshow$ = "DEFAULT": _MouseShow mouseshow$
If Not Active And buttonhover Then buttonhover = 0
b$ = InKey$
If Len(b$) Or Active And Mouse.LButDown And Mouse.LtClick = 0 Then
Mouse.LtClick = -1
If b$ = Chr$(27) Then System
Select Case mybutton
Case 1 ' Text Button
Color 0, 7
Locate y, x: Color 5, 7: Print b(13);: Color 0, 7: Print b(1); String$(10, b(2)); b(3);: Color 5, 7: Print b(12)
Locate , x: Color 5, 7: Print b(13);: Color 0, 7: Print b(4); String$(10, b(0)); b(4);: Color 5, 7: Print b(12)
Locate , x: Color 5, 7: Print b(13);: Color 0, 7: Print b(5); String$(10, b(2)); b(6);: Color 5, 7: Print b(12);
GoSub bdisplay
_Delay .1
Exit Do
Case 2 ' Graphics Button
GoSub bpress
_Delay .1
Exit Do
End Select
End If
If buttonhover Then GoSub bhover Else GoSub bdisplay
Loop
Loop
formatbutton:
Gdown = Button_HW(bw% * 8, bh% * 16, 170, 170, 170, -9, -9, -1, Mid$(button_text$, 1, bw% - 2))
Ghover = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -8, -7, -1, Mid$(button_text$, 1, bw% - 2))
Gdrag = Button_HW(bw% * 8, bh% * 16, 200, 200, 200, -1, -1, -1, Mid$(button_text$, 1, bw% - 2))
Return
bdisplay:
If button_display$ <> "off" Then
_PutImage ((bcol% - 1) * 8, (brow% - 1) * 16), Gdown
End If
_Display
Return
bhover:
If button_display$ <> "off" Then
_PutImage ((bcol% - 1) * 8, (brow% - 1) * 16), Ghover
End If
_Display
Return
bpress:
If button_display$ <> "off" Then
_PutImage ((bcol% - 1) * 8, (brow% - 1) * 16), Gdown
End If
_Display
Return
Function Button_HW (wide, tall, r, g, b, rc, gc, bc, caption$)
' Button function courtesy of the Amazing Steve.
Dim k As _Unsigned Long, d As _Unsigned Long, bg As _Unsigned Long, t As _Unsigned Long
Dest = _Dest
t = _NewImage(wide, tall, 32)
_Dest t
For i = 0 To 10
rm = rm + rc
gm = gm + gc
bm = bm + bc
k = _RGB32(r + rm, g + gm, b + bm)
Line (x + i, y + i)-(x + wide - i, y + tall - i), k, B
Next
Paint (x + i, y + i), k
Color _RGB32(r, g, b), 0
_PrintString (x + (wide - _PrintWidth(caption$)) / 2, y + (tall - _FontHeight) / 2), caption$
Button_HW = _CopyImage(t, 33)
_FreeImage t
_Dest Dest
End Function
Sub font_size_setup (ENL%)
If displayfullscreen% = -1 Then Exit Sub
WINXX1% = CsrLin: WINYY1% = Pos(1)
winmode$ = "2"
If ENL% <> 0 Then
full = _FullScreen
If full = 0 Then
Select Case ENL%
Case -1: If SCRNSIZE% > 0 Then Else Exit Sub
Case 1: If SCRNSIZE% < 14 Then Else Exit Sub
End Select
Else
Exit Sub
End If
End If
SCRNSIZE% = SCRNSIZE% + ENL%
Select Case winmode$
Case "1"
full = _FullScreen
If full <> 0 Then _FullScreen _Off
GoSub ChangeFont
Case "2"
full = _FullScreen
If full <> 0 Then _FullScreen _Off
style$ = "MONOSPACE"
fontsize% = SCRNSIZE% + 13
If fontsize% < 14 Then winmode$ = ""
If fontsize% < 18 Then style$ = style$ + ", BOLD"
fontpath$ = Environ$("SYSTEMROOT") + "\fonts\lucon.ttf" 'Find Windows Folder Path.
GoSub ChangeFont
Case "3"
GoSub ChangeFont
_FullScreen _SquarePixels
full = _FullScreen
If full = 0 Then GoSub nofull
Case "4"
GoSub ChangeFont
_FullScreen _Stretch
full = _FullScreen
If full = 0 Then GoSub nofull
End Select
Locate WINXX1%, WINYY1%
Exit Sub
nofull:
_FullScreen _Off
Return
ChangeFont:
If winmode$ <> "2" Then
_Font 16 ' Inbuilt 8x16 default font.
currentf& = _Font
Else
currentf& = _LoadFont(fontpath$, fontsize%, style$)
_Font currentf&
End If
If currentf& <> f& And f& <> defaultf& Then _FreeFont f&
f& = currentf&
Return
End Sub
Pete