OK finally the Form Designer and Picture Box Demo is ready. I had some loose ends to tie up and then decided to do a complete Picture Box Demo with the Form thing that allows you to preview your screen with buttons.
So here is all that over 1000 LOC now maybe not so siimple. Line 124 works with QB64 compiling the Preview screen in a Shell. I'd be surprised if it works in Linux but who knows, you will have to definitely rePath the files to your setup even in Windows.
So here is code for Form Designer and Picture Box Demo 282 LOC
Here is the code it writes for GUI_Preview:
And screen shot of Window Design and Demo, Compile and GUI_Preview running
And the zip with Source .bas, Gui_Priveiw.bas, Font File, Direntry.h, vs GUI.BI and vs GUI.BM and the docs b+ Very Simple GUI.txt
So here is all that over 1000 LOC now maybe not so siimple. Line 124 works with QB64 compiling the Preview screen in a Shell. I'd be surprised if it works in Linux but who knows, you will have to definitely rePath the files to your setup even in Windows.
So here is code for Form Designer and Picture Box Demo 282 LOC
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'
Here is the code it writes for GUI_Preview:
Code: (Select All)
'$include:'vs GUI.BI'
' Set Globals from BI your Title here VVV
Xmax = 1280: Ymax = 700: GuiTitle$ = "GUI Form Designer"
OpenWindow Xmax, Ymax, GuiTitle$ ' need to do this before drawing anything from NewControls
' Dim and set Globals for GUI app
Dim Shared As Long Tb1, Lst1, Lbl1, Pic1, BtnQuit
Tb1 = NewControl(2, 200, 10, 100, 32, "Text Box 1")
Lst1 = NewControl(3, 350, 10, 350, 192, "List Box 1")
Lbl1 = NewControl(4, 10, 100, 200, 32, "Label 1")
Pic1 = NewControl(5, 10, 200, 200, 200, "Picture 1")
BtnQuit = NewControl(1, 700, 300, 100, 32, "Quit")
MainRouter ' after all controls setup
Sub BtnClickEvent (i As Long)
Select Case i
End Select
End Sub
Sub LstSelectEvent (control As Long)
Select Case control
End Select
End Sub
Sub PicClickEvent (i As Long, Pmx As Long, Pmy As Long)
Select Case i
End Select
End Sub
Sub PicFrameUpdate (i As Long)
Select Case i
End Select
End Sub
'$include:'vs GUI.BM'
And screen shot of Window Design and Demo, Compile and GUI_Preview running
And the zip with Source .bas, Gui_Priveiw.bas, Font File, Direntry.h, vs GUI.BI and vs GUI.BM and the docs b+ Very Simple GUI.txt
b = b + ...