Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
G_Buttons_32
#1
Here's a buttons ui scheme and demo I've been fiddling with on and off the past few weeks. It's rude crude and a little ugly. I'm likely going to wrap this up into another UI scheme I'm working on but there's enough functionality here to share for someone else to get some use out of.   The main gimmick is the use a color image buffer used to track button locations graphically. You can pretty much draw and forget their specific x and y coordinates elsewhere in a program with this setup.

Code: (Select All)
'G_Buttons_32
' a graphical UI demo by James D. Jarvis
' this program uses 2 calls to new image to create a pair of screens at the same size
' s1&     is the display screen that the user will see
'bt& is the button tracking screen
'
'the button tracking screen duplicates the positions of each button on the display screen
'on the display screen buttons can be drawn in any manner the user wishes
'on the tracking screen each button is drawn as a solid shape in the same color reference as the button number
' there are currently 256 reference colors setup in the program and as such 255 buttons are allowed
'0 is ignored as it is used to cleanup inactive buttons on the button tracking screen
' more buttons can probably be created by altering the buttoncount variable   and using additional reference colors
' when  creating additional reference colors please keep in mind the colors values defined previously to avoid duplication
'
'the mouse positions on the display screen is identical to the position on the button tracking screen
'a call to pset(x,y) where x and y are the mouse position will return the coloron the button tracking screen
'   buttons can be resized, moved, erased,   as the programmer wishes. it is even possibl1 to pair a button with sprites
' or image click areas in a largere graphic should the technique be programmed to do so,  Just use a 1 color version of the sprite or click area
' current commands are
' drawallbuttons    which draws all buttons on the display scrren s1& and the button tracking screen bt%
'  draw button(b) which draw a specific button at its previouslt defiend coordinates
'  hidebutton(b) will chnage a button.state  to off and erase the button from both screens, a call to drawallbutton is alwasy made in this subroutine
'  turnonbutton(b) will changethe state of a button and redraw it on the both screens. this will bring an overlapping button to the top
' erasbutton(b) is normally called from inside hidebutton(b) but is its own subroutine this will remove a button
' from both screens but WILL NOT change the button state
'
'button type
'   name  is a String   that hold the name of the button  , this is not normally the displayed text
'   shape is an Integer    this is a flag 1- simple box button 2- round button 3- text button
'   text is a String     this is the button text that will be printed on the display screen inside the button is SHOWTEXT is in the container
'   x is an Integer     this is the topleft X coordinate of a button
'   y is an Integer     this is the topleft Y coordinate of a button
'   HH i an Integer      the button height in pixels
'   WW is an Integer    the button width in pixels
'   state is a String     the button state "OFF" and "ON" are the usualy values,
'   container is a String   this is a multi puroiose datat store for the button that will include the SHOWTEXT flag or any other fstrign data the porgrammer wishes
'   borderK is an long the outline color of the button  this will also be the text color of a button
'   fillK is an long        the fill color of the button this is ignored with textbuttons
'
'   currently the program supports very simple buttons
' bbox : is a simple box button
' bcircle is a simple circle
' btext alows a text string to be used as a button
' btbevel is a rectangle image that look lile a slightly fancier button
' not YET FULLY IMPLEMENTED    ....   there is aholder function that gives a big old ugly button
' BTFRAME is an expanded text box with a frame structure of defined charcters held in the button container
'...............#FCTRnnn#  frame value for top right corner of frame nnn is ascii value
'...............#FCTLnnn#  top left
'...............#FCBRnnn#  bottom right
'...............#FCBLnnn#  bottom left
'...............#FCHHnnn# horizontal rule
'...............#FCVVnnn#  verticalrule

_Title "G_Buttons_32"
Dim Shared ff&
Dim Shared S1&, bt&
Dim Shared block$, fsize
Dim Shared buttoncount
buttoncount = 255
Dim Shared Klr&(0 To 255), kl As _Unsigned Long
block$ = Chr$(219)
S1& = _NewImage(640, 480, 32)
Screen S1&
bt& = _NewImage(640, 480, 32)
rootpath$ = Environ$("SYSTEMROOT") 'normally "C:\WINDOWS"
fontname$ = "comic" 'oh yeah an ugly font for an ugly demo
fontfile$ = rootpath$ + "\Fonts\" + fontname$ + ".ttf" 'TTF file in Windows
fsize = 16
style$ = ""
ff& = _LoadFont(fontfile$, fsize, style$)
_Font ff&
_PrintMode _KeepBackground

'building the reference colors  this is to keep track of them probably don't have to actually do this
Klr&(0) = _RGB32(0, 0, 0)
Klr&(1) = _RGB32(0, 0, 168)
Klr&(2) = _RGB32(0, 168, 0)
Klr&(3) = _RGB32(0, 168, 168)
Klr&(4) = _RGB32(168, 0, 0)
Klr&(5) = _RGB32(168, 0, 168)
Klr&(6) = _RGB32(168, 84, 0)
Klr&(7) = _RGB32(168, 168, 168)
Klr&(8) = _RGB32(84, 84, 84)
Klr&(9) = _RGB32(84, 84, 252)
Klr&(10) = _RGB32(84, 252, 84)
Klr&(11) = _RGB32(84, 252, 252)
Klr&(12) = _RGB32(252, 84, 84)
Klr&(13) = _RGB32(252, 84, 252)
Klr&(14) = _RGB32(252, 252, 84)
Klr&(15) = _RGB32(252, 252, 252)

For c = 16 To 255
    Klr&(c) = _RGB32(1, 1, c)
Next c

Const bbox = 1 'plain box buttons
Const bcircle = 2 'a circle button
Const btext = 3 ' text as button
Const bframe = 4 'a framed text button.... still not implemented
Const btbevel = 5 'a rectangular button with a bevelish look
Const bzone = 6 'a whole panel zone as a button  used to note a click in a panel or the area of a panel, panel buttons drawn under all other buttons

Type buttontype
    name As String
    shape As Integer
    text As String
    x As Integer
    y As Integer
    HH As Integer
    WW As Integer
    state As String
    container As String
    borderK As Long 'border and type color of a button, this uses one of the reference colors for now, might ditch this idea entirely
    fillK As Long
End Type
Dim Shared btn(buttoncount) As buttontype

btn(1).name = "One"
btn(1).text = "BEEP"
btn(1).state = "ON"
btn(1).shape = bbox
btn(1).x = 50: btn(1).y = 50: btn(1).HH = 50: btn(1).WW = 50
btn(1).container = "SHOWTEXT SHOWFILL"
btn(1).borderK = Klr&(14)
btn(1).fillK = Klr&(1)

btn(2).name = "Two"
btn(2).state = "ON"
btn(2).text = "4?"
btn(2).shape = bbox
btn(2).x = 50: btn(2).y = 100: btn(2).HH = 50: btn(2).WW = 50
btn(2).container = "SHOWTEXT SHOWFILL"
btn(2).borderK = Klr&(14)
btn(2).fillK = Klr&(7)


btn(3).name = "Three"
btn(3).text = "Move4"
btn(3).state = "ON"
btn(3).shape = bcircle
btn(3).x = 200: btn(3).y = 200: btn(3).HH = 30: btn(3).WW = 0
btn(3).container = "SHOWFILL SHOWTEXT"
btn(3).borderK = Klr&(14)
btn(3).fillK = Klr&(4)


btn(4).name = "Four"
btn(4).text = "Button 4"
btn(4).state = "ON"
btn(4).shape = btext
btn(4).x = 200: btn(4).y = 200: btn(4).HH = 30: btn(4).WW = 0
btn(4).container = ""
btn(4).borderK = Klr&(14)
btn(4).fillK = Klr&(5)

btn(5).name = "Five"
btn(5).state = "ON"
btn(5).text = "+6"
btn(5).shape = bbox
btn(5).x = 50: btn(5).y = 151: btn(5).HH = 50: btn(5).WW = 50
btn(5).container = "SHOWTEXT"
btn(5).borderK = Klr&(14)
btn(5).fillK = Klr&(6)

btn(6).name = "Six"
btn(6).state = "OFF"
btn(6).text = "Beep2"
btn(6).shape = bbox
btn(6).x = 50: btn(6).y = 201: btn(6).HH = 50: btn(6).WW = 50
btn(6).container = ""
btn(6).borderK = Klr&(14)
btn(6).fillK = Klr&(7)

btn(7).name = "Seven"
btn(7).text = "Shrink8"
btn(7).state = "ON"
btn(7).shape = btbevel
btn(7).x = 250: btn(7).y = 50: btn(7).HH = 30: btn(7).WW = 120
btn(7).container = "SHOWFILL SHOWTEXT"
btn(7).borderK = Klr&(14)
btn(7).fillK = Klr&(5)

btn(8).name = "zone"
btn(8).text = ""
btn(8).state = "ON"
btn(8).shape = bzone
btn(8).x = 10: btn(8).y = 10: btn(8).HH = 50: btn(8).WW = 120
btn(8).container = ""
btn(8).borderK = Klr&(0)
btn(8).fillK = Klr&(0)


bbx = 400
by = 1
For z = 9 To buttoncount
    If z = 97 Then
        bbx = 450
        by = 1
    End If
    If z = 187 Then
        bbx = 500
        by = 1
    End If


    btn(z).name = "Button" + Str$(z)
    btn(z).state = "ON"
    btn(z).shape = bbox
    btn(z).x = bbx: btn(z).y = by * 5: btn(z).HH = 4: btn(z).WW = 20
    btn(z).container = "SHOWFILL"
    btn(z).borderK = Klr&(z)
    btn(z).fillK = Klr&(Int(z / 2))
    by = by + 1
Next z

btn(8).name = "Seven"
btn(8).text = "Kill 7"
btn(8).state = "ON"
btn(8).shape = btbevel
btn(8).x = 250: btn(8).y = 85: btn(8).HH = 30: btn(8).WW = 120
btn(8).container = "SHOWFILL SHOWTEXT"
btn(8).borderK = Klr&(14)
btn(8).fillK = Klr&(5)


_PrintString (10, 360), "Simple graphic buttons demo"
_PrintString (10, 375), "Press Q to quit at any time"
_PrintString (10, 390), "for no good reason at all you cna scribble"
_PrintString (10, 405), " on the screen  by holding down the mouse button"
_PrintString (10, 420), "when you do quit the program exits to"
_PrintString (10, 435), " a view of the button buffer"


drawallbuttons



kl = 14
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
mainloop:
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Do
    _Limit 1000
    Line (10, 50)-(15, 55), Klr&(kl), BF
    ask$ = InKey$
    If ask$ <> "" Then
        Select Case ask$
            Case Chr$(27)
                GoTo exitmain

            Case "<", Chr$(44)
                kl = kl - 1
                If kl < 0 Then kl = 255

            Case ">", Chr$(46)
                kl = kl + 1
                If kl > 255 Then kl = 0

        End Select

        ask$ = ""
    End If
    Mouser mx, my, mb
    If mb Then
        PSet (mx, my), Klr&(kl)
        Locate 2, 2
        _PrintMode _FillBackground
        Print "                                                      "
        _PrintMode _KeepBackground
        Do While mb 'wait for button release
            Mouser mx, my, mb
            PSet (mx, my), Klr&(kl)
            _Source bt&
            bk& = Point(mx, my)

            _Dest S1&

        Loop
        ' button handling code

        For kc = 0 To buttoncount
            If bk& = Klr&(kc) Then
                bk& = kc
            Else
                kb& = -1
            End If
        Next kc
        If bk& > 0 And bk& < buttoncount + 1 Then
            If btn(bk&).state <> "OFF" Then
                Select Case bk&
                    Case 1
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "Click  on BUTTON ONE          "
                        _PrintMode _KeepBackground
                        Beep
                        bk& = -1
                    Case 2
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "click on Button TWO           "
                        _PrintMode _KeepBackground
                        turnonbutton 4
                        remove_container 4, "_LOCKED"
                        bk& = -1
                    Case 3
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "click on Button Three           "
                        _PrintMode _KeepBackground
                        move_button 4, 4, 4
                        bk& = -1
                    Case 4
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "click on Button Four          "
                        _PrintMode _KeepBackground
                        bk& = -1
                        hidebutton 4
                    Case 5
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "click on Button Five           "
                        _PrintMode _KeepBackground
                        bk& = -1
                        add_container 6, "SHOWTEXT"
                        turnonbutton (6)

                    Case 6

                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "Click  on BUTTON six          "
                        _PrintMode _KeepBackground
                        Beep
                        Beep
                        bk& = -1
                    Case 7
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "Click  on BUTTON Seven          "

                        erasebutton (8)
                        btn(8).x = btn(8).x + 1
                        btn(8).WW = btn(8).WW - 2
                        _PrintMode _KeepBackground
                        drawbutton (8)


                    Case 8
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "Click  on BUTTON Eight          "
                        _PrintMode _KeepBackground

                        bk& = -1
                        hidebutton 7


                    Case 9 TO 255
                        Locate 2, 2
                        _PrintMode _FillBackground
                        Print "Click  on BUTTON "; Str$(bk&)
                        _PrintMode _KeepBackground

                End Select
            End If

        End If
    End If

Loop Until InKey$ = Chr$(27)
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
exitmain:
Screen bt&


End
Sub Mouser (x, y, b)
    mi = _MouseInput
    b = _MouseButton(1)
    x = _MouseX
    y = _MouseY
End Sub
Sub drawallbuttons ()
    For b = 1 To buttoncount
        kl = b
        If btn(b).state = "OFF" Then
            '  erasebutton (b)
        End If
        If btn(b).state = "ON" Then
            drawbutton (b)

        End If

    Next b

End Sub

Sub drawbutton (b)
    If btn(b).state <> "OFF" Then
        Select Case btn(b).shape

            Case bbox
                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), btn(b).borderK, B
                _Dest bt&
                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), Klr&(b), BF
                _Dest S1&
                If InStr(btn(b).container, "SHOWFILL") > 0 Then Line (btn(b).x + 1, btn(b).y + 1)-(btn(b).x + btn(b).WW - 1, btn(b).y + btn(b).HH - 1), btn(b).fillK, BF


                If InStr(btn(b).container, "SHOWTEXT") > 0 Then
                    cx = (btn(b).x * 2 + btn(b).WW) / 2
                    cy = btn(b).y + btn(b).HH / 2 - (fsize / 2)
                    pw = _PrintWidth(btn(b).text)
                    pw = Int(pw / 2)
                    Color btn(b).borderK
                    _PrintString (cx - pw, cy), btn(b).text

                End If
            Case bcircle
                _Dest bt&
                Circle (btn(b).x, btn(b).y), btn(b).HH, Klr&(b)
                Circle (btn(b).x, btn(b).y), btn(b).HH - 1, Klr&(0)
                Paint (btn(b).x, btn(b).y), Klr&(0), Klr&(0)

                Paint (btn(b).x, btn(b).y), Klr&(b), Klr&(b)
                _Dest st&
                Circle (btn(b).x, btn(b).y), btn(b).HH, btn(b).borderK
                If InStr(btn(b).container, "SHOWFILL") > 0 Then
                    Circle (btn(b).x, btn(b).y), btn(b).HH - 1, Klr&(0)
                    Paint (btn(b).x, btn(b).y), Klr&(0), Klr&(0)
                    Paint (btn(b).x, btn(b).y), btn(b).fillK, btn(b).borderK
                End If
                pw = _PrintWidth(btn(b).text)
                pw = Int(pw / 2)

                If InStr(btn(b).container, "SHOWTEXT") > 0 Then _PrintString (btn(b).x - pw + 1, btn(b).y - (fsize / 2) + 1), btn(b).text
            Case btext
                _Dest bt&
                kl = b
                Color Klr&(kl)
                btxt$ = ""
                btxt$ = btn(b).text
                tl = Len(btxt$)
                btxt$ = ""
                For tt = 1 To tl: btxt$ = btxt$ + block$: Next tt
                _PrintString (btn(b).x, btn(b).y), btxt$
                _Dest S1&
                pw = _PrintWidth(btn(b).text)
                Color btn(b).borderK
                _PrintString (btn(b).x, btn(b).y), btn(b).text
            Case btframe
                _Dest bt&
                kl = b
                Color Klr&(kl)
                btxt$ = ""
                btxt$ = Chr$(186) + btn(b).text + Chr$(186)

                ' tl = _PrintWidth(btxt$)
                thl = _FontHeight: th = thl * 3
                cw = Len(btn(b).text)
                ft$ = Chr$(201): fb$ = Chr$(200)
                For r = 1 To cw
                    ft$ = ft$ + Chr$(205): fb$ = fb$ + Chr$(205)
                Next r
                ft$ = ft$ + Chr$(187): fb$ = fb$ + Chr$(188)
                tl = _PrintWidth(ft$) + 18

                Line (btn(b).x, btn(b).y)-(btn(b).x + tl, btn(b).y + th), Klr&(kl), BF
                _Dest S1&
                ' pw = _PrintWidth(btn(b).text)
                Color btn(b).borderK
                _PrintMode _FillBackground
                If InStr(btn(b).container, "SHOWFILL") > 0 Then Line (btn(b).x, btn(b).y)-(btn(b).x + tl, btn(b).y + th), btn(b).fillK, BF
                _PrintMode _KeepBackground
                _PrintString (btn(b).x, btn(b).y), ft$
                _PrintString (btn(b).x, btn(b).y + thl), btxt$
                _PrintString (btn(b).x, btn(b).y + thl + thl), fb$

            Case btbevel
                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), btn(b).borderK, B
                _Dest bt&
                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), Klr&(b), BF
                _Dest S1&
                If InStr(btn(b).container, "SHOWFILL") > 0 Then Line (btn(b).x + 1, btn(b).y + 1)-(btn(b).x + btn(b).WW - 1, btn(b).y + btn(b).HH - 1), btn(b).fillK, BF
                bevoff = Int(btn(b).HH / 5)
                inxl = btn(b).x + bevoff: inxr = btn(b).WW + btn(b).x - bevoff
                inytop = btn(b).y + bevoff: inybot = btn(b).y + btn(b).HH - bevoff
                Line (btn(b).x, btn(b).y)-(inxl, inytop), btn(b).borderK
                Line (btn(b).x, btn(b).y + btn(b).HH)-(inxl, inybot), btn(b).borderK
                Line (btn(b).x + btn(b).WW, btn(b).y)-(inxr, inytop), btn(b).borderK
                Line (btn(b).x + btn(b).WW, btn(b).y + btn(b).HH)-(inxr, inybot), btn(b).borderK
                Line (inxl, inytop)-(inxr, inybot), btn(b).borderK, B

                If InStr(btn(b).container, "SHOWTEXT") > 0 Then
                    cx = btn(b).x + (btn(b).WW) / 2
                    cy = btn(b).y + btn(b).HH / 2 - (fsize / 2) + bevoff / 3
                    pw = _PrintWidth(btn(b).text)
                    pw = Int(pw / 2)
                    Color btn(b).borderK
                    _PrintString (cx - pw, cy), btn(b).text

                End If


        End Select
    End If
    skiploop:
End Sub
Sub hidebutton (bb)

    _Dest bt&
    erasebutton (bb)
    btn(bb).state = "OFF"
    drawallbuttons

End Sub
Sub erasebutton (bb)
    b = bb
    If btn(b).state <> "OFF" Then
        _Dest bt&
        Select Case btn(b).shape
            Case bbox
                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), Klr&(0), BF
                _Dest S1&
                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), Klr&(0), BF

            Case bcircle

                Circle (btn(b).x, btn(b).y), btn(b).HH, Klr&(0)
                Paint (btn(b).x, btn(b).y), Klr&(0), Klr&(0)
            Case btext
                _Dest bt&
                pw = _PrintWidth(btn(b).text)
                Line (btn(b).x, btn(b).y)-(btn(b).x + pw, btn(b).y + 16), Klr&(0), BF
                _Dest S1&
                Line (btn(b).x, btn(b).y)-(btn(b).x + pw, btn(b).y + 16), Klr&(0), BF
            Case btbevel

                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), Klr&(0), BF
                _Dest S1&
                Line (btn(b).x, btn(b).y)-(btn(b).x + btn(b).WW, btn(b).y + btn(b).HH), Klr&(0), BF
        End Select
        _Dest S1&
    End If
End Sub
Sub turnonbutton (bb)
    btn(bb).state = "ON"
    drawbutton bb
End Sub
Sub replace_container (b, a$, c$)
    'repalces string a$ in a buttons container with  c$
    'if a$ is not in contiar the string is simnply added to the container"
    pc = InStr(btn(b).container, a$)
    If pc > 0 Then
        wl = Len(a$)
        ec = Len(btn(b).container)
        fr$ = Mid$(btn(b).container, 1, pc - 1)
        bck$ = Mid$(btn(b).container, pc + wl, ec - wl)
        btn(b).container = fr$ + c$ + bck$
    End If


End Sub
Sub add_container (b, a$)
    'adds the string a$ to the container of a button
    btn(b).container = btn(b).container + a$
End Sub
Sub remove_container (b, a$)
    pc = InStr(btn(b).container, a$)
    If pc > 0 Then
        wl = Len(a$)
        ec = Len(btn(b).container)
        fr$ = Mid$(btn(b).container, 1, pc - 1)
        bck$ = Mid$(btn(b).container, pc + wl, ec - wl)
        btn(b).container = fr$ + bck$
    End If

End Sub

Sub move_button (bb, mvx, mvy)
    'lckc = InStr(btn(b).container, "_LOCKED")
    ' If lckc < 1 Then
    erasebutton (bb)
    btn(bb).x = btn(bb).x + mvx
    btn(bb).y = btn(bb).y + mvy
    drawallbuttons
    '  End If
End Sub
Reply
#2
Okay, I played around with that way too long! Big Grin

Fun stuff,

Pete
Fake News + Phony Politicians = Real Problems

Reply




Users browsing this thread: 1 Guest(s)