Very Simple GUI - Printable Version

Code: (Select All)
Option _Explicit

_Title "GUI Forms Designer" 'b+ build from GUI Get Filename test app 2022-06-16

' 2022-06-18 still organizing this file with: b+ Very Simple GUI.txt file

' 2022-06-19 compiled first working test form



'$include:'vs GUI.BI'



'   Set Globals from BI

Xmax = 1280: Ymax = 700: GuiTitle$ = "GUI Form Designer" ' <<<<<  Window size shared throughout program

OpenWindow Xmax, Ymax, GuiTitle$ ' need to do this before drawing anything from NewControls



'   Dim and set Globals for GUI app

Dim Shared As Long LblName, TbName, LstType, LblType, LblSelType

LblName = NewControl(4, 14, 434, 42, 16, "Name")

TbName = NewControl(2, 62, 426, 136, 32, "name/handle")

LblType = NewControl(4, 10, 476, 80, 16, "Type:") '

LstType = NewControl(3, 10, 493, 80, 112, "Button~Text Box~List Box~Label~Picture") '

LblSelType = NewControl(4, 10, 606, 80, 16, "here") '



Dim Shared As Long LblX, TbX, LblY, TbY, LblW, TbW, LblH, TbH

LblX = NewControl(4, 100, 476, 16, 16, "X ") '

TbX = NewControl(2, 116, 468, 80, 32, "1000") '

LblY = NewControl(4, 100, 518, 16, 16, "Y ") '

TbY = NewControl(2, 116, 510, 80, 32, "200") '

LblW = NewControl(4, 100, 560, 16, 16, "W ") '

TbW = NewControl(2, 116, 552, 80, 32, "300") '

LblH = NewControl(4, 100, 602, 16, 16, "H ") '

TbH = NewControl(2, 116, 594, 80, 32, "1400") '



Dim Shared As Long LblText, TbText

LblText = NewControl(4, 10, _Height - 58, 80, 16, "Text: ")

TbText = NewControl(2, 10, _Height - 42, _Width - 20, 32,_

 "Need lot's and lot's of room here for very long labels that might stretch across the screen.")



Dim Shared As Long BtnAdd

BtnAdd = NewControl(1, 210, 552, 120, 74, "Add to List")



ReDim Shared ControlList$(5) ' keep this one dynamic with ReDim

Dim Shared As Long NList

Dim Clist$ ' just for here



' install some prevously Previewed values

NList = 5

ControlList$(1) = "Btn1 = NewControl(1, 20, 20, 100, 32, " + Chr$(34) + "Btn 1 Here" + Chr$(34) + ")"

ControlList$(2) = "Tb1 = NewControl(2, 200, 10, 100, 32, " + Chr$(34) + "Text Box 1" + Chr$(34) + ")"

ControlList$(3) = "Lst1 = NewControl(3, 350, 10, 350, 192, " + Chr$(34) + "List Box 1" + Chr$(34) + ")"

ControlList$(4) = "Lbl1 = NewControl(4, 10, 100, 200, 32, " + Chr$(34) + "Label 1" + Chr$(34) + ")"

ControlList$(5) = "Pic1 = NewControl(5, 10, 200, 200, 200, " + Chr$(34) + "Picture 1" + Chr$(34) + ")"

Clist$ = Join$(ControlList$(), "~")



Dim Shared As Long LblCon, LstCon, LblSelCon

LblCon = NewControl(4, 340, 10, 820, 20, "Controls List:")

LstCon = NewControl(3, 340, 40, 820, _Height - 52 - 20 - 42, Clist$)

LblSelCon = NewControl(4, 340, _Height - 20 - 52, 820, 16, "Selected Control Here")



Dim Shared As Long BtnPreview, BtnDelete, BtnEdit

BtnPreview = NewControl(1, 1170, 40, 100, 32, "Preview")

BtnDelete = NewControl(1, 1170, 82, 100, 32, "Delete")

BtnEdit = NewControl(1, 1170, 124, 100, 32, "Edit")



Dim Shared As Long PicTestMouse

PicTestMouse = NewControl(5, 10, 40, 320, 340, "Test Mouse Clicks Here")

Dim Shared aaa, bbb, ccc, dbbb, dccc

dccc = -2 / 45: dbbb = 1 / 45

aaa = 0: ccc = 106: bbb = 27



MainRouter ' after all controls setup



'  EDIT these to your programs needs

Sub BtnClickEvent (i As Long) ' attach you button click code in here

    Dim As Long j

    Dim b$, t$

    Select Case i

        Case BtnAdd

            NList = NList + 1

            ReDim _Preserve ControlList$(NList)

            ControlList$(NList) = NewControlStr$(1)

            con(LstCon).Text = Join$(ControlList$(), "~")

            drwLst LstCon, -1

        Case BtnPreview

            Open "GUI_Preview.bas" For Output As #1

            Print #1, "'$include:'vs GUI.BI'"

            Print #1, "'   Set Globals from BI              your Title here VVV"

            Print #1, "Xmax = 1280: Ymax = 700: GuiTitle$ = " + Chr$(34) + "GUI Form Designer" + Chr$(34) '<<  Window size shared throughout

            Print #1, "OpenWindow Xmax, Ymax, GuiTitle$ ' need to do this before drawing anything from NewControls"

            Print #1, "'   Dim and set Globals for GUI app"

            Print #1, "Dim Shared As Long ";

            For j = 1 To UBound(ControlList$)

                t$ = LeftOf$(ControlList$(j), " = NewControl(")

                If _Trim$(t$) <> "" Then

                    If Len(b$) Then b$ = b$ + ", " + t$ Else b$ = t$

                End If

            Next

            Print #1, b$

            For j = 1 To UBound(ControlList$)

                Print #1, ControlList$(j)

            Next

            Print #1, ""

            Print #1, "MainRouter ' after all controls setup"

            Print #1, ""

            Print #1, "Sub BtnClickEvent (i As Long)"

            Print #1, "   Select Case i"

            Print #1, "   End Select"

            Print #1, "End Sub"

            Print #1, ""

            Print #1, "Sub LstSelectEvent (control As Long)"

            Print #1, "   Select Case control"

            Print #1, "   End Select"

            Print #1, "End Sub"

            Print #1, ""

            Print #1, "Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long)"

            Print #1, "   Select Case i"

            Print #1, "   End Select"

            Print #1, "End Sub"

            Print #1, ""

            Print #1, "Sub PicFrameUpdate (i As Long)"

            Print #1, "   Select Case i"

            Print #1, "   End Select"

            Print #1, "End Sub"

            Print #1, ""

            Print #1, "'$include:'vs GUI.BM'"

            Close #1

            _Delay .5

            ' It worked!!! IDE Run Menu: "Output EXE to Source Folder" bulleted

            Shell "C:\Users\marka\Downloads\qb64_win-x64-0.8.2\qb64\qb64.exe -c " + _

            Chr$(34) + "C:\Users\marka\Desktop\QB64 work\000 work QB64\GUI Tools\GUI_Preview.bas" + Chr$(34)

            _Delay 3

            Shell Chr$(34) + "C:\Users\marka\Desktop\QB64 work\000 work QB64\GUI Tools\GUI_Preview.exe" + Chr$(34)

            '................  Of couse you will need to fix this for your system setup ..............................



        Case BtnDelete

            If con(LstCon).Text2 <> "" Then

                Remove con(LstCon).Text2, ControlList$()

                con(LstCon).Text = Join$(ControlList$(), "~")

                con(LstCon).N2 = 1 ' better than leaving it on a likely blank

                con(LstCon).Text2 = ""

                drwLst LstCon, 0

                con(LblSelCon).Text = ""

                drwLbl LblSelCon

            End If

        Case BtnEdit

            If con(LstCon).Text2 <> "" Then

                con(TbName).Text = _Trim$(LeftOf$(con(LstCon).Text2, " ="))

                drwTB TbName, 0

                ReDim T$(1 To 1)

                Split RightOf$(con(LstCon).Text2, "NewControl("), ", ", T$()

                Select Case _Trim$(T$(1))

                    Case "1": con(LstType).Text2 = "Button"

                    Case "2": con(LstType).Text2 = "Text Box"

                    Case "3": con(LstType).Text2 = "List Box"

                    Case "4": con(LstType).Text2 = "Label"

                    Case "5": con(LstType).Text2 = "Picture"

                End Select

                con(LblSelType).Text = con(LstType).Text2

                drwLbl LblSelType

                con(TbX).Text = _Trim$(T$(2))

                drwTB TbX, 0

                con(TbY).Text = _Trim$(T$(3))

                drwTB TbY, 0

                con(TbW).Text = _Trim$(T$(4))

                drwTB TbW, 0

                con(TbH).Text = _Trim$(T$(5))

                drwTB TbH, 0

                con(TbText).Text = LeftOf$(RightOf$(_Trim$(T$(6)), Chr$(34)), Chr$(34))

                drwTB TbText, 0

                BtnClickEvent BtnDelete 'clear the item from LstCon

            End If

    End Select

End Sub



Sub LstSelectEvent (control As Long)

    Select Case control

        Case LstType

            con(LblSelType).Text = con(LstType).Text2

            drwLbl LblSelType

        Case LstCon

            con(LblSelCon).Text = Mid$(con(LstCon).Text2, 1, 600 / 8 - 2)

            drwLbl LblSelCon

    End Select

End Sub



Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long) ' attach your Picture click code in here

    Select Case i

        Case PicTestMouse 'test handling a click event

            _Dest con(i).N1

            If Pmy > 20 Then

                _PrintString (Pmx, Pmy), Str$(Pmx) + "," + Str$(Pmy)

                Circle (Pmx, Pmy), 1

            End If

            _Dest 0

            drwPic i, -1

    End Select

End Sub



Sub PicFrameUpdate (i As Long) ' attach your Picture click code in here

    Dim x, y

    Select Case i

        Case PicTestMouse 'test handling a click event

            _Dest con(i).N1

            ' loop code here    shared all variables that need to persist between calls

            Line (0, 0)-(319, 319), &H09220044, BF

            aaa = aaa + _Pi(2 / 360): bbb = bbb + dbbb: ccc = ccc + dccc

            If bbb < 5 Then bbb = 5: dbbb = -dbbb

            If bbb > 53 Then bbb = 53: dbbb = -dbbb

            If ccc < 53 Then ccc = 53: dccc = -dccc

            If ccc > 106 Then ccc = 106: dccc = -dccc

            x = 160 + 53 * Cos(aaa): y = 180 + 53 * Sin(aaa)

            drawShip x, y, _RGB32(255, 255, 0)

            x = 160 + ccc * Cos(aaa + _Pi(2 / 3)): y = 180 + bbb * Sin(aaa + _Pi(2 / 3))

            drawShip x, y, _RGB32(200, 0, 0)

            x = 160 + bbb * Cos(aaa + _Pi(4 / 3)): y = 180 + ccc * Sin(aaa + _Pi(4 / 3))

            drawShip x, y, _RGB32(0, 0, 160)

            _Dest 0

            drwPic i, 0

    End Select

End Sub



' some fun with Picture demo

Sub drawShip (x, y, colr As _Unsigned Long) 'shipType     collisions same as circle x, y radius = 30

    Static ls

    Dim light As Long, r As Long, g As Long, b As Long

    r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)

    fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)

    fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)

    fellipse x, y, 30, 7, _RGB32(r, g, b)

    For light = 0 To 5

        fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)

    Next

    ls = ls + 1

    If ls > 5 Then ls = 0

End Sub



' ======== helper subs for drawShip that you can use for other things specially fcirc = fill_circle  x, y, radius, color



Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)

    If xr = 0 Or yr = 0 Then Exit Sub

    Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64

    Dim x As Long, y As Long

    w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2

    Line (CX - xr, CY)-(CX + xr, CY), C, BF

    Do While y < yr

        y = y + 1

        x = Sqr((h2w2 - y * y * w2) \ h2)

        Line (CX - x, CY + y)-(CX + x, CY + y), C, BF

        Line (CX - x, CY - y)-(CX + x, CY - y), C, BF

    Loop

End Sub



Sub fcirc (x As Long, y As Long, R As Long, C As _Unsigned Long) 'vince version  fill circle x, y, radius, color

    Dim x0 As Long, y0 As Long, e As Long

    x0 = R: y0 = 0: e = 0

    Do While y0 < x0

        If e <= 0 Then

            y0 = y0 + 1

            Line (x - x0, y + y0)-(x + x0, y + y0), C, BF

            Line (x - x0, y - y0)-(x + x0, y - y0), C, BF

            e = e + 2 * y0

        Else

            Line (x - y0, y - x0)-(x + y0, y - x0), C, BF

            Line (x - y0, y + x0)-(x + y0, y + x0), C, BF

            x0 = x0 - 1: e = e - 2 * x0

        End If

    Loop

    Line (x - R, y)-(x + R, y), C, BF

End Sub



Function NewControlStr$ (dummy)

    Dim As Long typ

    dummy = 0

    Select Case con(LblSelType).Text

        Case "Button": typ = 1

        Case "Text Box": typ = 2

        Case "List Box": typ = 3

        Case "Label": typ = 4

        Case "Picture": typ = 5

    End Select

    NewControlStr$ = con(TbName).Text + " = NewControl(" + _trim$(str$(typ)) + ", "+ con(TbX).Text + ", " + con(TbY).Text + ", " +_

     con(TbW).Text + ", " + con(TbH).Text + ", " + chr$(34) + con(TbText).Text+ chr$(34) + ")"

End Function





'$include:'vs GUI.BM'