And the cake is finally baked. Final Demo Version. I'll clean up the code when I decide what I want to use out of it, later...
3 Buttons. Text, Graphics, and HTML Image.
Thanks to Steve for the Graphics Button Function from years past. Easy to modify to make a variety of different appearances.
Pete
3 Buttons. Text, Graphics, and HTML Image.
Code: (Select All)
Const FALSE = 0, TRUE = Not FALSE
Screen 0, 0, 0, 0
Overlay = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)
Palette 5, 63 ' Bright white.
Palette 6, 56 ' Dark grey.
Color 0, 5 ' Bright white background.
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%)
' Border characters.
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) = "Ý"
' Draw outer border / Sides then corners.
Locate 1, 1
For i = 2 To _Width - 1
Locate 1, i: Print b(2);
Locate 25, i: Print b(2);
Next
For i = 2 To _Height - 1
Locate i, 1: Print b(4);
Locate i, _Width: Print b(4);
Next
Locate 1, 1: Print b(1);
Locate 1, _Width: Print b(3);
Locate _Height, 1: Print b(5);
Locate _Height, _Width: Print b(6);
' Draw a message border.
Locate 3, 18: Print b(1); String$(43, b(2)); b(3)
Locate , 18: Print b(4); String$(43, b(0)); b(4)
Locate , 18: Print b(4); String$(43, b(0)); b(4)
Locate , 18: Print b(4); String$(43, b(0)); b(4)
Locate , 18: Print b(5); String$(43, b(2)); b(6)
Locate 4, 20: Print " Pete's Amazing SCREEN 0 Button Demo"
Locate 6, 20: Print "Where SCREEN 0 takes on a whole newimage!";
' Button sizes.
b_text_y% = 10: b_text_x% = 56 ' Text Button.
button_text$ = " Activate ": bw% = 12: bh% = 2: b_graphics_x% = 16: b_graphics_y% = 57 ' Graphics Button.
GoSub format_graphics_button
b_html_y% = 325: b_html_x% = 453 ' HTML Button.
button_display$ = "on"
' User messages.
Locate b_text_y% + 2, 10: Print "Text button with cursor change on hover:";
Locate b_text_y% + 7, 10: Print "Graphics button with color change on hover:";
Locate b_text_y% + 12, 10: Print "HTML button with color change on hover:";
Do
GoSub b_text_display
GoSub b_graphics_display
GoSub b_html_display
_Display
Do
_Limit 30
' Keyboard input.
mykey$ = InKey$
If Len(mykey$) Then
If mykey$ = Chr$(27) Then System
If mykey$ = Chr$(9) Then
End If
End If
' Mouse input and toggle variables.
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: button_style = 0
If Mouse.StartX >= b_text_x% And Mouse.StartX <= b_text_x% + 13 And Mouse.StartY >= b_text_y% And Mouse.StartY <= b_text_y% + 2 And Not Active Then
' Text Button
If Not Active Then mouseshow$ = "LINK": _MouseShow mouseshow$
Active = TRUE: button_style = 1
ElseIf Mouse.StartX >= b_graphics_y% And Mouse.StartX <= b_graphics_y% + 11 And Mouse.StartY >= b_graphics_x% And Mouse.StartY <= b_graphics_x% + 1 And Not Active Then
' Graphics Button
If Not Active Then b_graphics_hover = -1: GoSub b_graphics_hover_display
Active = TRUE: button_style = 2
ElseIf Mouse.StartX * 8 >= b_html_x% And Mouse.StartX * 8 <= b_html_x% + 11 * 8 And Mouse.StartY * 16 >= b_html_y% And Mouse.StartY * 16 <= b_html_y% + 2 * 16 And Not Active Then
' Html Button
If Not Active Then b_html_hover = -1: GoSub b_html_hover_display
Active = TRUE: button_style = 3
End If
' Hover off.
If Not Active And mouseshow$ = "LINK" Then mouseshow$ = "DEFAULT": _MouseShow mouseshow$
If Not Active And b_graphics_hover Then b_graphics_hover = 0: Exit Do
If Not Active And b_html_hover Then b_html_hover = 0: Exit Do
' Left click on button.
If Active And Mouse.LButDown And Mouse.LtClick = 0 Then
Mouse.LtClick = -1
Select Case button_style
Case 1 ' Text Button
GoSub b_text_press_display
Exit Do
Case 2 ' Graphics Button
GoSub b_graphics_press_display
Exit Do
Case 3 ' HTML Button
GoSub b_html_press_display
Exit Do
End Select
End If
Loop
Loop
'=========================================SUBROUTINES===============================================
b_text_display:
Locate b_text_y%, b_text_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 , b_text_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 , b_text_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 b_text_y% + 1, b_text_x% + 2: Color 7, 6: Print b(12);: Color 6, 7: Print "Activate";: Color 7, 6: Print b(13);
Return
b_text_press_display:
If button_display$ = "on" Then
Locate b_text_y%, b_text_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 , b_text_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 , b_text_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 b_graphics_display
_Display
_Delay .1
End If
Return
format_graphics_button:
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
b_graphics_display:
If button_display$ = "on" Then
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_PutImage ((b_graphics_y% - 1) * 8, (b_graphics_x% - 1) * 16), Gdown
_FreeImage Overlay_Hardware
End If
Return
b_graphics_hover_display:
If button_display$ = "on" Then
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_PutImage ((b_graphics_y% - 1) * 8, (b_graphics_x% - 1) * 16), Ghover
_Display
_FreeImage Overlay_Hardware
End If
Return
b_graphics_press_display:
If button_display$ = "on" Then
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_PutImage ((b_graphics_y% - 1) * 8, (b_graphics_x% - 1) * 16), Gdown
_Display
_FreeImage Overlay_Hardware
_Delay .1
End If
Return
b_html_display:
If button_display$ = "on" Then
_Dest Overlay
img& = _LoadImage("activate-static.png", 32)
_PutImage (b_html_x%, b_html_y%), img&
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage img&
_FreeImage Overlay_Hardware
End If
Return
b_html_hover_display:
If button_display$ = "on" Then
_Dest Overlay
img& = _LoadImage("activate-hover.png", 32)
_PutImage ((b_graphics_y% - 1) * 8, (b_graphics_x% - 1) * 16), Gdown
_PutImage (b_html_x%, b_html_y%), img&
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_Display
_FreeImage img&
_FreeImage Overlay_Hardware
End If
Return
b_html_press_display:
If button_display$ = "on" Then
_Dest Overlay
img& = _LoadImage("activate-active.png", 32)
_Delay .05
_PutImage ((b_graphics_y% - 1) * 8, (b_graphics_x% - 1) * 16), Gdown
_PutImage (b_html_x%, b_html_y%), img&
Overlay_Hardware = _CopyImage(Overlay, 33)
_PutImage (0, 0), Overlay_Hardware
_Dest 0
_FreeImage img&
_FreeImage Overlay_Hardware
_Display
_Delay .05
End If
Return
'=======================================SUBS & FUNCTIONS=============================================
Function Button_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$
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 SubThanks to Steve for the Graphics Button Function from years past. Easy to modify to make a variety of different appearances.
Pete