So what's that damn Pete up to now?

[Pete]

I guess I'm not quite picking up on what you're laying down. You mean make a button editor?

Pete

PS: I updated the code to clean it up a bit and save some cpu usage. My motto has always been design then refine. It's a much more stable approach to programming than the method employed by Clippy, who would code then explode.

[TerryRitchie]

I guess I'm not quite picking up on what you're laying down. You mean make a button editor?

Pete

PS: I updated the code to clean it up a bit and save some cpu usage. My motto has always been design then refine. It's a much more stable approach to programming than the method employed by Clippy, who would code then explode.

LOL, code then explode.

[Pete]

While we're waiting for B-Plus to B-Back, here's another B-utton!

Code: (Select All)

Palette 5, 63 ' Bright white.

Palette 6, 56 ' Dark grey.

Color 0, 5 ' Bright white background.

Cls



Dim b(15) 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) = "Ý"

b(15) = "ß"

b(14) = "Ü"



Overlay = _NewImage(_Width * _FontWidth, _Height * _FontHeight, 32)



b_text_y% = 1

b_text_x% = 2

GoSub b_text_display



_Dest Overlay

Line (9, 7)-(102, 38), _RGB32(0, 0, 0), B

Rem Line (16, 15)-(96, 31), _RGB32(0, 0, 126), B

Overlay_Hardware = _CopyImage(Overlay, 33)

_PutImage (0, 0), Overlay_Hardware

_Dest 0

_FreeImage Overlay_Hardware

_Display

Sleep

End



b_text_display:

Locate b_text_y%, b_text_x%: Color 6, 5: Print String$(12, b(14))

Locate , b_text_x%: Color 5, 6: Print String$(12, b(0))

Locate , b_text_x%: Color 6, 5: Print String$(12, b(15));

Locate b_text_y% + 1, b_text_x% + 1: Color 6, 7: Print b(0);: Print "Activate";: Print b(0);

Rem Locate b_text_y% + 1, b_text_x% + 1: Color 15, 1: Print b(0);: Print "Activate";: Print b(0);

Return

No special effects added. I just wanted to trim that first text button example, and this ASCII-Graphics hybrid does just that.

Pete

[Pete]

So I threw out that chunky text only button, and put a text-graphics hybrid one in its place...

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(15) 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) = "Ý"

b(14) = "Ü"

b(15) = "ß"



' 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% = 57 ' Text Button.

button_text$ = " Activate ": bw% = 12: bh% = 2: b_graphics_y% = 16: b_graphics_x% = 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% + 1, 12: Print "Text hybrid button. Cursor change on hover:";

Locate b_graphics_y% + 1, 12: Print "Graphics button. Color change on hover:";

Locate b_html_y% / 16 + 2, 12: Print "HTML button. 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_x% And Mouse.StartX <= b_graphics_x% + 11 And Mouse.StartY >= b_graphics_y% And Mouse.StartY <= b_graphics_y% + 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:

_Dest Overlay

Line (0 + ((b_text_x% - 1) * 8), 7 + ((b_text_y% - 1) * 16))-(96 + ((b_text_x% - 1) * 8), 39 + ((b_text_y% - 1) * 16)), _RGB32(0, 0, 0), B

Overlay_Hardware = _CopyImage(Overlay, 33)

_PutImage (0, 0), Overlay_Hardware

_Dest 0

_FreeImage Overlay_Hardware

Locate b_text_y%, b_text_x%: Color 6, 5: Print String$(12, b(14))

Locate , b_text_x%: Color 5, 6: Print String$(12, b(0))

Locate , b_text_x%: Color 6, 5: Print String$(12, b(15));

Locate b_text_y% + 1, b_text_x% + 1: Color 0, 7: Print b(0);: Print "Activate";: Print b(0);

Return



b_text_press_display:

If button_display$ = "on" Then

    GoSub b_graphics_display

    GoSub b_html_display

    Locate b_text_y% + 1, b_text_x% + 1: Color 6, 6: Print b(12);: Color 15, 6: Print "Activate";: Color 6, 6: Print b(13);

    _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_x% - 1) * 8, (b_graphics_y% - 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_x% - 1) * 8, (b_graphics_y% - 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_x% - 1) * 8, (b_graphics_y% - 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_x% - 1) * 8, (b_graphics_y% - 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_x% - 1) * 8, (b_graphics_y% - 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 Sub

Right click and select "Save As" to download the 3 html buttons, below.

Pete

[bplus]

Anyone want to do Palette specially as applies to Screen 0 for word of the month, @Pete?

Missed that day at school, specailly want the old Pro Tips.

[SMcNeill]

Word of the Day: Palette

This command is outdated, obsolete, and should go the way of the cavemen just like LET and Line Numbers.  Use _PaletteColor instead.  ?

[Pete]

You're lucky TheBOB is from Canada, or he'd be clubbing you to death right now!

Pete

[bplus]

I went clubbing once, woke up with a tattoo:
   

[Pete]

Pretty ASCII backwards.

Pete