Posts: 3,986
Threads: 178
Joined: Apr 2022
Reputation:
222
I reworked Labels they are now Controls that don't get activated, Control Type 4. Labels are now Centered or attempt to be, between x and x + w.
I reworked NewControl routine making it a Function that returns the Index number for the Control Handle (Long), you no longer need to know which number is what, you have them labeled like handles to images or sound files. Used naming convention learned in VB for control handles.
With the label drawing reworked I evened out the screen a bit and added labels under the List Boxes for showing the Selected items from them. This meant a LstSelectEvent Sub be added to Events Subs.
Code: (Select All) Option _Explicit
_Title "GUI - add Misc 2022-06" 'b+ 2022-06-13,
' 2022-06-14 & 15 add ListBoxes and Labels
' 2022-06-15 & 16, change labels to a control and change Sub NewControl to a Function that returns
' the index number to control variable name. (Take out ID as property in Control Type)
' This should make it easier to modify screens using variable names for your controls.
' change i, active in drwBtn and drwTB
' Very simple buttons and textboxes for starters"
' Use white border for active control, black for inactive ones.
' Use Tab and Shift+Tab for shifting active control else Mouse Click, to cursor position in TextBox
' or item in list box.
' Main loop will decide active control ID is basically the Index order for controls same as you
' post them with NewControl conType, X, Y, W, H, Text
' btn conType is 1, press enter to cause click event if tab to btn
' Active control moves down to next when clicked or enter press.
' textBox conType = 2
' height needs to be at least 32 pixels high for cursor below letters in box
' N1 is cursor position
' N2 to track toggle for blinking cursor
' Enter keypress on textBox will shift Active conrol down the index by 1
' Hint: When change text, change cursor N1 to len(con(i).text) + 1
' ListBox conType = 3
' for LstBx need to Join$ (Function below) an array into a comma delimited string for Text in NewControl
' N1 = page number we are on
' N2 = current location of the highlight bar on the page
' N3 = page width in chars
' N4 = page height + 2 lines (32 pixels) are left blank at top and bottom for mouse click navigation.
' N5 = Ubound of the list() base 1 ie last item number
' text = a splitable into array so need split N5 is (re)discovered in split when drawn
' Enter Keypress selects the highlited item in List bx and moves active control to next control in ID ie index
' Left click Blank Top Left side > Home
' Left Click Blank Top Right side > PgUp
' Left Click Blank Bottom Left side > End
' Left Click Blank Bottom Right side > PgDn
' Right Click Box to select highlited, active control moves to next in index
' note this wont activate or change highlite, only selects highlited item.
' Helper Sub Split and function Join$ added to manipulate arrays into strings (Join) or strings into arrays (Split).
' The Split sub is used in DrwLst to separate comma delimited string into an array for List Box to display.
' Also split text when need to find selected item.
' You can scroll lists with Mouse wheel!
' label box conType = 4
'
'reset your colors here FC = ForeColor BC = Back Color All the RGB32() are right here in constans section!
Dim Shared As _Unsigned Long screenBC, BtnFC, BtnBC, TbFC, TbBC, LstFC, LstBC, LblFC
screenBC = _RGB32(160, 180, 160)
BtnFC = _RGB32(0, 0, 0)
BtnBC = _RGB32(250, 250, 250)
TbFC = _RGB32(180, 180, 255)
TbBC = _RGB32(0, 0, 128)
LstFC = _RGB32(255, 180, 180)
LstBC = _RGB32(190, 0, 0)
LblFC = _RGB32(0, 0, 68)
Type Control ' all are boxes with colors, 1 is active
As Long ConType, X, Y, W, H, N1, N2, N3, N4, N5 ' N1, N2 sometimes controls need extra numbers for special functions
' ID is actually index number same order as you enter NewControls
As String Text, Text2 ' dims are pixels Text2 is for future selected text from list box
' default wnd = 0, btn = 1, txtBx = 2, LstBx = 3
End Type
Dim Shared Xmax, Ymax, NControls, ActiveControl
ReDim Shared con(0) As Control
Dim As Long kh, mx, my, mb1, mb2, i, shift1, shift2, lc
Xmax = 800: Ymax = 600 ' Window size shared throughout program
OpenWindow Xmax, Ymax, "Test GUI Starter" ' set your window screen size and title
'set your controls and labels ============================================================= appl plug-in
Dim Shared As Long LblScreen, Btn1, BtnClear, Tb1, Tb2, Tb3, Tb4, LblDay, LstDay, LblMonth, LstMonth, LblDate, LstDate, BtnDMD
Dim Shared As Long LblSelDay, LblSelMonth, LblSelDate
LblScreen = NewControl(4, 0, 150, _Width, 64, "b+ Very Simple GUI")
Btn1 = NewControl(1, 100, 10, 100, 32, "Button 1")
BtnClear = NewControl(1, 100, 60, 100, 32, "Clear")
Tb1 = NewControl(2, 20, 230, 200, 32, "Textbox 1")
Tb2 = NewControl(2, 240, 230, 200, 32, "Textbox 2")
Tb3 = NewControl(2, 460, 230, 100, 32, "Tb 3")
Tb4 = NewControl(2, 580, 230, 200, 32, "Test pqg 4")
LblDay = NewControl(4, 20, 270, 200, 32, "Day")
LstDay = NewControl(3, 20, 300, 200, 130, "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday")
LblSelDay = NewControl(4, 20, 440, 200, 16, "")
LblMonth = NewControl(4, 240, 270, 200, 32, "Month")
LstMonth = NewControl(3, 240, 300, 200, 130, "January,February,March,April,May,June,July,August,September,October,November,December")
LblSelMonth = NewControl(4, 240, 440, 200, 16, "")
LblDate = NewControl(4, 460, 270, 100, 32, "Date")
LstDate = NewControl(3, 460, 300, 100, 192, "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31")
LblSelDate = NewControl(4, 460, 502, 100, 16, "")
BtnDMD = NewControl(1, 580, 300, 200, 74, "Day, Month Date")
' ========================================================================================================================
Do
' mouse clicks and tabs will decide the active control
While _MouseInput
If con(ActiveControl).ConType = 3 Then
If _MouseWheel > 0 Then
LstKeyEvent ActiveControl, 20480
ElseIf _MouseWheel < 0 Then
LstKeyEvent ActiveControl, 18432
End If
End If
Wend
mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
If mb1 Then ' find which control
For i = 1 To NControls
If mx >= con(i).X And mx <= con(i).X + con(i).W Then
If my >= con(i).Y And my <= con(i).Y + con(i).H Then
If i <> ActiveControl And con(i).ConType <> 4 Then
activateControl ActiveControl, 0
ActiveControl = i
activateControl ActiveControl, -1
End If
Exit For
End If
End If
Next
If con(ActiveControl).ConType = 1 Then
BtnClickEvent ActiveControl
shiftActiveControl 1
ElseIf con(ActiveControl).ConType = 2 Then ' move cursor to click point
If mx >= con(ActiveControl).X And mx <= con(ActiveControl).X + con(ActiveControl).W Then
If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + con(ActiveControl).H Then
con(ActiveControl).N1 = Int((mx - con(ActiveControl).X - 4) / 8) + 1
drwTB ActiveControl, -1
End If
End If
ElseIf con(ActiveControl).ConType = 3 Then
If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + 16 Then ' top empty
If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'home else pgUp
LstKeyEvent ActiveControl, 18176 ' home
ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
LstKeyEvent ActiveControl, 18688 ' pgup
End If
ElseIf my >= con(ActiveControl).Y + con(ActiveControl).H - 16 And my <= con(ActiveControl).Y + con(ActiveControl).H Then ' bottom empty pgdn
If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'end else pgDn
LstKeyEvent ActiveControl, 20224 ' end
ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
LstKeyEvent ActiveControl, 20736 ' pgdn
End If
ElseIf my >= con(ActiveControl).Y + 16 And my < con(ActiveControl).Y + con(ActiveControl).H - 16 Then
con(ActiveControl).N2 = Int((my - con(ActiveControl).Y - 16) / 16) + 1
drwLst ActiveControl, -1
End If
End If
_Delay .2 ' user release key wait
End If
If mb2 Then ' use right clicking to select
If con(ActiveControl).ConType = 3 Then ' this does not make the lst active but if is can select the highlited
ReDim lst(1 To 1) As String
Split con(ActiveControl).Text, ",", lst()
con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
LstSelectEvent ActiveControl
shiftActiveControl 1
_Delay .2
End If
End If
kh = _KeyHit
shift1 = _KeyDown(100304)
shift2 = _KeyDown(100303)
If kh = 9 Then 'tab
If shift1 Or shift2 Then
shiftActiveControl -1
Else
shiftActiveControl 1
End If
ElseIf kh = 13 And con(ActiveControl).ConType = 1 Then ' enter on a btn
BtnClickEvent ActiveControl
shiftActiveControl 1
ElseIf kh = 13 And con(ActiveControl).ConType = 2 Then
shiftActiveControl 1
ElseIf kh = 13 And con(ActiveControl).ConType = 3 Then
ReDim lst(1 To 1) As String
Split con(ActiveControl).Text, ",", lst()
con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
LstSelectEvent ActiveControl
shiftActiveControl 1
End If
If con(ActiveControl).ConType = 2 Then
TBKeyEvent ActiveControl, kh ' this handles keypress in active textbox
If lc Mod 10 = 9 Then con(ActiveControl).N2 = 1 - con(ActiveControl).N2 ' this is for blinking cursor
If con(ActiveControl).N2 Then
Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), &HFFFFFFFF, BF
Else
Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), TbBC, BF
End If
ElseIf con(ActiveControl).ConType = 3 Then
LstKeyEvent ActiveControl, kh
End If
_Display
lc = lc + 1
_Limit 60
Loop Until _Exit
Sub shiftActiveControl (change As Long) ' change = 1 or -1
activateControl ActiveControl, 0 ' turn off last
Do
ActiveControl = ActiveControl + change
If ActiveControl > NControls Then ActiveControl = 1
If ActiveControl < 1 Then ActiveControl = NControls
Loop Until con(ActiveControl).ConType <> 4
activateControl ActiveControl, -1 ' turn on next
End Sub
Sub activateControl (i, activate)
Select Case con(i).ConType
Case 1: drwBtn i, activate
Case 2: drwTB i, activate
Case 3: drwLst i, activate
End Select
End Sub
Sub OpenWindow (WinWidth As Long, WinHeight As Long, title$)
Screen _NewImage(WinWidth, WinHeight, 32)
_ScreenMove 100, 20
_PrintMode _KeepBackground
_Title title$
Color &HFFFFFFFF, screenBC
Cls
End Sub
Function NewControl& (ConType As Long, X As Long, Y As Long, W As Long, H As Long, s$) ' dims are pixels
Dim As Long a
NControls = NControls + 1
ReDim _Preserve con(0 To NControls) As Control
'con(NControls).ID = NControls
con(NControls).ConType = ConType
con(NControls).X = X
con(NControls).Y = Y
con(NControls).W = W
con(NControls).H = H
con(NControls).Text = s$
ActiveControl = 1
If NControls = 1 Then a = 1 Else a = 0
Select Case ConType
Case 1: drwBtn NControls, a
Case 2: drwTB NControls, a: con(NControls).N1 = Len(s$) + 1: con(NControls).N2 = 0
' N1 is what letter position we are on or cursor for line, N2 is the toggle for cursor blinking
Case 3: con(NControls).N3 = Int((W - 16) / 8) ' page width - .5 charcter margin on each side 1 char scroll click bar
con(NControls).N4 = Int((H - 32) / 16) ' page height 2 empty lines for page up, page down clicking
con(NControls).N1 = 1 ' page number
con(NControls).N2 = 1 ' select highlite bar
con(NControls).Text2 = "" ' zero everything out for UDT's
drwLst NControls, a
Case 4: drwLbl NControls
End Select
NewControl& = NControls ' same as ID
End Function
Sub drwBtn (i As Long, active As Long) ' gray back, black text
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), BtnBC, BF
If active Then Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B Else _
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
Color BtnFC
_PrintString (con(i).X + (con(i).W - 8 * Len(con(i).Text)) / 2, (con(i).Y + (con(i).H - 16) / 2)), con(i).Text
End Sub
Sub drwTB (i As Long, active As Long) ' blue back, white text
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), TbBC, BF
If active Then
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
Else
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
End If
Color TbFC
_PrintString (con(i).X + 4, con(i).Y + (con(i).H - 16) / 2), con(i).Text
End Sub
Sub drwLst (i As Long, active As Long)
' new control will get numbers for constructing a screen
' N1 = page number we are on
' N2 = current location of the highlight bar on the page
' N3 = page width in chars
' N4 = page height + 2 lines are left blank at top and bottom
' N5 = Ubound of the list() base 1 ie last item number
Dim s$
Dim As Long j
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), LstBC, BF
If active Then
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
Else
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
End If
ReDim lst(1 To 1) As String
Split con(i).Text, ",", lst()
con(i).N5 = UBound(lst)
For j = 1 To con(i).N4
s$ = Space$(con(i).N3)
If (con(i).N1 - 1) * con(i).N4 + j <= con(i).N5 Then
Mid$(s$, 1, con(i).N3) = lst((con(i).N1 - 1) * con(i).N4 + j)
End If
If j <> con(i).N2 Then
Color LstFC
Else
Line (con(i).X + 1, con(i).Y + 16 + (j - 1) * 16)-Step(con(i).W - 2, 16), LstFC, BF
Color LstBC
End If
_PrintString (con(i).X + 4, con(i).Y + 16 + (j - 1) * 16), s$
Next
End Sub
Sub drwLbl (i As Long)
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), screenBC, BF
Static beenHere, fontHandle&(6 To 64)
Dim As Long j
If beenHere = 0 Then
For j = 6 To 64
fontHandle&(j) = _LoadFont("ARLRDBD.ttf", j)
Next
beenHere = -1
End If
Dim As _Unsigned Long curFont
curFont = _Font
_Font fontHandle&(con(i).H)
Color LblFC, _RGB32(0, 0, 0, 0)
_PrintString (con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2, con(i).Y), con(i).Text
_Font curFont
End Sub
Sub BtnClickEvent (i As Long) ' attach you button click code in here
Select Case i
' according to your appl needs ================================================
Case Btn1: Color &HFFFFFF00: _PrintString (500, 20), "You pushed my button!"
Case BtnClear: Line (500, 20)-Step(300, 40), screenBC, BF
Case BtnDMD
con(Tb1).Text = con(LstDay).Text2: con(Tb2).Text = con(LstMonth).Text2
con(Tb3).Text = con(LstDate).Text2: con(Tb4).Text = con(LstDay).Text2 + ", " + con(LstMonth).Text2 + " " + con(LstDate).Text2
' Hint: change cursor N1 when change Text
con(Tb1).N1 = Len(con(Tb1).Text) + 1
con(Tb2).N1 = Len(con(Tb2).Text) + 1
con(Tb3).N1 = Len(con(Tb3).Text) + 1
con(Tb4).N1 = Len(con(Tb4).Text) + 1
drwTB Tb1, 0: drwTB Tb2, 0: drwTB Tb3, 0: drwTB Tb4, 0 'update boxes
' ========================================================================= end plug-in
End Select
End Sub
' this is standard for all Text Boxes
Sub TBKeyEvent (i As Long, ky As Long) ' for all text boxes
If ky = 19200 Then 'left arrow
If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwTB i, -1
ElseIf ky = 19712 Then ' right arrow
If con(i).N1 < Int((con(i).W - 16) / 8) Then con(i).N1 = con(i).N1 + 1: drwTB i, -1
ElseIf ky = 18176 Then 'home
con(i).N1 = 1: drwTB i, -1
ElseIf ky = 20224 Then ' end
If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then con(i).N1 = Len(con(i).Text) + 1: drwTB i, -1
ElseIf ky >= 32 And ky <= 128 Then
If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Chr$(ky) + Mid$(con(i).Text, con(i).N1)
con(i).N1 = con(i).N1 + 1: drwTB i, -1
End If
ElseIf ky = 8 Then 'backspace
If con(i).N1 > 1 Then
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 2) + Mid$(con(i).Text, con(i).N1)
con(i).N1 = con(i).N1 - 1: drwTB i, -1
End If
ElseIf ky = 21248 Then 'delete
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Mid$(con(i).Text, con(i).N1 + 1): drwTB i, -1
End If
End Sub
' this is standard for all List Boxes
Sub LstKeyEvent (i As Long, ky As Long) ' for all text boxes
If ky = 18432 Then 'up arrow
If con(i).N2 > 1 Then
con(i).N2 = con(i).N2 - 1: drwLst i, -1
Else
If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: con(i).N2 = con(i).N4: drwLst i, -1
End If
ElseIf ky = 20480 Then ' down arrow
If con(i).N2 < con(i).N4 And (con(i).N1 - 1) * con(i).N4 + con(i).N2 < con(i).N5 Then
con(i).N2 = con(i).N2 + 1: drwLst i, -1
Else
If con(i).N2 = con(i).N4 Then ' can we start another page
If con(i).N1 < con(i).N5 / con(i).N4 Then
con(i).N1 = con(i).N1 + 1: con(i).N2 = 1: drwLst i, -1
End If
End If
End If
ElseIf ky = 18176 Then 'home
con(i).N1 = 1: con(i).N2 = 1: drwLst i, -1
ElseIf ky = 20224 Then ' end
If con(i).N5 Mod con(i).N4 = 0 Then
con(i).N1 = Int(con(i).N5 / con(i).N4)
con(i).N2 = con(i).N4
Else
con(i).N1 = Int(con(i).N5 / con(i).N4) + 1
con(i).N2 = con(i).N5 Mod con(i).N4
End If
drwLst i, -1
ElseIf ky = 18688 Then 'pgUp
If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwLst i, -1
ElseIf ky = 20736 Then 'pgDn
If con(i).N1 * con(i).N4 < con(i).N5 Then
con(i).N1 = con(i).N1 + 1
If con(i).N1 > Int(con(i).N5 / con(i).N4) Then ' > last whole page check high bar
If con(i).N2 > con(i).N5 Mod con(i).N4 Then con(i).N2 = con(i).N5 Mod con(i).N4
End If
drwLst i, -1
End If
End If
End Sub
Sub LstSelectEvent (control As Long)
Select Case control
Case LstDay: con(LblSelDay).Text = con(LstDay).Text2: drwLbl LblSelDay
Case LstMonth: con(LblSelMonth).Text = con(LstMonth).Text2: drwLbl LblSelMonth
Case LstDate: con(LblSelDate).Text = con(LstDate).Text2: drwLbl LblSelDate
End Select
End Sub
' This is used and available for maniupating strings to arrays ie change delimiters to commas
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
dpos = InStr(curpos, SplitMeString, delim)
Do Until dpos = 0
loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
arrpos = arrpos + 1
If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
curpos = dpos + LD
dpos = InStr(curpos, SplitMeString, delim)
Loop
loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub
' Available if need to create a string from an array
Function Join$ (arr() As String, delimiter$)
Dim i As Long, b$
For i = LBound(arr) To UBound(arr)
If i = LBound(arr) Then b$ = arr(LBound(arr)) Else b$ = b$ + delimiter$ + arr(i)
Next
Join$ = b$
End Function
b = b + ...
Posts: 34
Threads: 1
Joined: Apr 2022
Reputation:
2
I usually use a textbox depth of 25 in my programs, so I tried it and found that it works. The cursor is quite thick and it sits on the bottom line of the textbox but can be clearly seen.
A textbox of 20 depth can be used, but the cursor sits on the bottom line of the textbox. It can still be seen, but I'd rather stick to 25 as a minimum unless you are really short of space.
Posts: 34
Threads: 1
Joined: Apr 2022
Reputation:
2
With the code as it stands, it is possible to produce a quite complicated combination of boxes (textboxes), buttons and listboxes. Not many people want really complicated layouts. I'll try some of the interfaces that I have with other programming languages and see what happens.
Posts: 3,986
Threads: 178
Joined: Apr 2022
Reputation:
222
(06-16-2022, 11:36 AM)RNBW Wrote: With the code as it stands, it is possible to produce a quite complicated combination of boxes (textboxes), buttons and listboxes. Not many people want really complicated layouts. I'll try some of the interfaces that I have with other programming languages and see what happens.
Yes exactly, need to try out some applications to see where we are at and what's needed next.
Check boxes I think are easy (if you dont demand check marks, maybe X will do?) and same with radio buttons until you have to connect them in frames one goes "on" all others in frame go "off", tricky will be the frame part.
I am surprised you can do 25 height text boxes, but good news to me. I tried to keep cursor out of text so I wouldn't have to redraw the text when cursor goes through it (blinker part code).
I am thinking try a fileName and/or pathName retrieval form and got's to get picture box and try out some graphics for games or fun graphics like Fellippes fireworks.
b = b + ...
Posts: 34
Threads: 1
Joined: Apr 2022
Reputation:
2
I think I must qualify my statement about textbox depth. This is with a 1920 x 1080 display with the scale set at the recommended 150%. If others have a different display size perhaps they could check if my comment still applies. I've not had a display size other than 1920 x 1080 for some years.
Posts: 34
Threads: 1
Joined: Apr 2022
Reputation:
2
The other thing that would be very useful would be to set up a GUI library so that all we are doing is writing the actual working code calling the routines from the library.
Posts: 199
Threads: 15
Joined: Apr 2022
Reputation:
4
hello, bplus has done a very good job in only a few days. the name chosen "Very Simple GUI" seems logical. it will be enough to create a very simple gui with some gadgets, font management, possibly dpi support to manage the enlargement according to the system...
for a more sophisticated gui, i suggest to use the raylib library which is cross-platform and very efficient. starting from zero would not be profitable because it would require a lot of time...
Posts: 3,986
Threads: 178
Joined: Apr 2022
Reputation:
222
06-17-2022, 01:54 AM
(This post was last modified: 06-17-2022, 02:14 AM by bplus.)
Thanks to all for support and feedback.
For my next installment something practical, a filename selector that allows you to run a file in Shell (DontWait) or Kill it! (Might as well cleanout some old files while I am testing code.) For Kills, I do make you confirm your choice by typing y for yes in an InputBox$ (which added allot of code for a silly y. I tried Fellippe's very simple MessageBox and was getting crazy or no results. I had to make screen pretty wide to fit Pathed Filenames across the breadth of the screen.
So here is code, you need direntry.h in your QB64.exe folder, a copy is provided commented out at the bottom of this code, remove comments and paste in txt file editor and save as direntry.h in QB64.exe folder. Oh I had to change my delimiter for Join$ of arrays because I had files with comma's in the title which the splitter busted up! So now using ~ to delimit strings.
Code: (Select All) Option _Explicit
_Title "Get Filename test GUI-6-16" 'b+ 2022-06-16 test an appl with GUI as of 6-15
' from "GUI - add Misc 2022-06-15"
' 2022-06-14 & 15 add ListBoxes and Labels
' 2022-06-15 & 16, change labels to a control and change Sub NewControl to a Function that returns
' the index number to control variable name. (Take out ID as property in Control Type)
' This should make it easier to modify screens using variable names for your controls.
' change i, active in drwBtn and drwTB
' 2022-06-16 To test something serious I have Get Filename and once gotten you can Run it,
' Kill it or Cancel/Quit. I had to add GetLists which needs Direntry.h in QB64.exe Folder.
' A copy is provided at the end of this code. Dang need new file delimiter, some files have
' comma's in their name! Dang need wider screen!
' GUI Notes:
' Very simple buttons and textboxes for starters"
' Use white border for active control, black for inactive ones.
' Use Tab and Shift+Tab for shifting active control else Mouse Click, to cursor position in TextBox
' or item in list box.
' Main loop will decide active control ID is basically the Index order for controls same as you
' post them with NewControl conType, X, Y, W, H, Text
' btn conType is 1, press enter to cause click event if tab to btn
' Active control moves down to next when clicked or enter press.
' textBox conType = 2
' height needs to be at least 32 pixels high for cursor below letters in box
' N1 is cursor position
' N2 to track toggle for blinking cursor
' Enter keypress on textBox will shift Active conrol down the index by 1
' Hint: When change text, change cursor N1 to len(con(i).text) + 1
' ListBox conType = 3
' for LstBx need to Join$ (Function below) an array into a ~ delimited string for Text in NewControl
' N1 = page number we are on
' N2 = current location of the highlight bar on the page
' N3 = page width in chars
' N4 = page height + 2 lines (32 pixels) are left blank at top and bottom for mouse click navigation.
' N5 = Ubound of the list() base 1 ie last item number
' text = a splitable into array so need split N5 is (re)discovered in split when drawn
' Enter Keypress selects the highlited item in List bx and moves active control to next control in ID ie index
' Left click Blank Top Left side > Home
' Left Click Blank Top Right side > PgUp
' Left Click Blank Bottom Left side > End
' Left Click Blank Bottom Right side > PgDn
' Right Click Box to select highlited, active control moves to next in index
' note this wont activate or change highlite, only selects highlited item.
' Helper Sub Split and function Join$ added to manipulate arrays into strings (Join) or strings into arrays (Split).
' The Split sub is used in DrwLst to separate ~ delimited string into an array for List Box to display.
' Also split text when need to find selected item.
' You can scroll lists with Mouse wheel!
' label box conType = 4 labels are sizable with Height and fit between (centered) x and x + w
'
' This is added for this appl ===============================================================================
' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< see end of Subs abd Functions for copy
Declare CustomType Library ".\direntry"
Function load_dir& (s As String)
Function has_next_entry& ()
Sub close_dir ()
Sub get_next_entry (s As String, flags As Long, file_size As Long)
End Declare
'===========================================================================================================
'reset your colors here FC = ForeColor BC = Back Color All the RGB32() are right here in constans section!
Dim Shared As _Unsigned Long screenBC, BtnFC, BtnBC, TbFC, TbBC, LstFC, LstBC, LblFC
screenBC = _RGB32(160, 180, 160)
BtnFC = _RGB32(0, 0, 0)
BtnBC = _RGB32(250, 250, 250)
TbFC = _RGB32(180, 180, 255)
TbBC = _RGB32(0, 0, 128)
LstFC = _RGB32(255, 180, 180)
LstBC = _RGB32(190, 0, 0)
LblFC = _RGB32(0, 0, 68)
Type Control ' all are boxes with colors, 1 is active
As Long ConType, X, Y, W, H, N1, N2, N3, N4, N5 ' N1, N2 sometimes controls need extra numbers for special functions
' ID is actually index number same order as you enter NewControls
As String Text, Text2 ' dims are pixels Text2 is for future selected text from list box
' default wnd = 0, btn = 1, txtBx = 2, LstBx = 3
End Type
Dim Shared As Long Xmax, Ymax, NControls, ActiveControl, WindowClose ' new as long and WindowClose
ReDim Shared con(0) As Control
Dim As Long kh, mx, my, mb1, mb2, i, shift1, shift2, lc
'set your controls and labels ======================================================================== appl plug-in
Xmax = 1280: Ymax = 640 ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Window size shared throughout program
OpenWindow Xmax, Ymax, "Test Very Simple GUI-2022-06-15" ' <<<<<<<< set your window screen size and title
Dim Shared curPath$ ' track where we are in navigation see GetListStrings
Dim Shared As Long LblPath, LblCurPath, LblDirs, LblFils, LstD, LstF, LblFile, LblSelFile, BtnOK, BtnKill, BtnCancel
Dim fils$, dirs$
GetListStrings dirs$, fils$
LblPath = NewControl(4, 0, 10, _Width, 20, "Current Folder:")
LblCurPath = NewControl(4, 0, 35, _Width, 16, curPath$)
LblDirs = NewControl(4, 150, 60, 300, 20, "Sub Directorys:")
LblFils = NewControl(4, 530, 60, 600, 20, "Files:")
LstD = NewControl(3, 150, 85, 300, 432, dirs$)
LstF = NewControl(3, 530, 85, 600, 432, fils$)
LblFile = NewControl(4, 0, 520, _Width, 20, "Selected File:")
LblSelFile = NewControl(4, 0, 550, _Width, 16, "Selected File goes here")
BtnOK = NewControl(1, 20, 580, 400, 50, "OK Run it.")
BtnCancel = NewControl(1, 440, 580, 400, 50, "Quit")
BtnKill = NewControl(1, 860, 580, 400, 50, "Kill it!")
' ========================================================================================================================
Do
' mouse clicks and tabs will decide the active control
While _MouseInput
If con(ActiveControl).ConType = 3 Then
If _MouseWheel > 0 Then
LstKeyEvent ActiveControl, 20480
ElseIf _MouseWheel < 0 Then
LstKeyEvent ActiveControl, 18432
End If
End If
Wend
mx = _MouseX: my = _MouseY: mb1 = _MouseButton(1): mb2 = _MouseButton(2)
If mb1 Then ' find which control
For i = 1 To NControls
If mx >= con(i).X And mx <= con(i).X + con(i).W Then
If my >= con(i).Y And my <= con(i).Y + con(i).H Then
If i <> ActiveControl And con(i).ConType <> 4 Then
activateControl ActiveControl, 0
ActiveControl = i
activateControl ActiveControl, -1
End If
Exit For
End If
End If
Next
If con(ActiveControl).ConType = 1 Then
BtnClickEvent ActiveControl
shiftActiveControl 1
ElseIf con(ActiveControl).ConType = 2 Then ' move cursor to click point
If mx >= con(ActiveControl).X And mx <= con(ActiveControl).X + con(ActiveControl).W Then
If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + con(ActiveControl).H Then
con(ActiveControl).N1 = Int((mx - con(ActiveControl).X - 4) / 8) + 1
drwTB ActiveControl, -1
End If
End If
ElseIf con(ActiveControl).ConType = 3 Then
If my >= con(ActiveControl).Y And my <= con(ActiveControl).Y + 16 Then ' top empty
If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'home else pgUp
LstKeyEvent ActiveControl, 18176 ' home
ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
LstKeyEvent ActiveControl, 18688 ' pgup
End If
ElseIf my >= con(ActiveControl).Y + con(ActiveControl).H - 16 And my <= con(ActiveControl).Y + con(ActiveControl).H Then ' bottom empty pgdn
If mx < con(ActiveControl).X + .5 * con(ActiveControl).W Then 'end else pgDn
LstKeyEvent ActiveControl, 20224 ' end
ElseIf mx > con(ActiveControl).X + .5 * con(ActiveControl).W Then
LstKeyEvent ActiveControl, 20736 ' pgdn
End If
ElseIf my >= con(ActiveControl).Y + 16 And my < con(ActiveControl).Y + con(ActiveControl).H - 16 Then
con(ActiveControl).N2 = Int((my - con(ActiveControl).Y - 16) / 16) + 1
drwLst ActiveControl, -1
End If
End If
_Delay .2 ' user release key wait
End If
If mb2 Then ' use right clicking to select
If con(ActiveControl).ConType = 3 Then ' this does not make the lst active but if is can select the highlited
ReDim lst(1 To 1) As String
Split con(ActiveControl).Text, "~", lst()
con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
LstSelectEvent ActiveControl
shiftActiveControl 1
_Delay .2
End If
End If
kh = _KeyHit
shift1 = _KeyDown(100304)
shift2 = _KeyDown(100303)
If kh = 9 Then 'tab
If shift1 Or shift2 Then
shiftActiveControl -1
Else
shiftActiveControl 1
End If
ElseIf kh = 13 And con(ActiveControl).ConType = 1 Then ' enter on a btn
BtnClickEvent ActiveControl
shiftActiveControl 1
ElseIf kh = 13 And con(ActiveControl).ConType = 2 Then
shiftActiveControl 1
ElseIf kh = 13 And con(ActiveControl).ConType = 3 Then
ReDim lst(1 To 1) As String
Split con(ActiveControl).Text, "~", lst()
con(ActiveControl).Text2 = lst((con(ActiveControl).N1 - 1) * con(ActiveControl).N4 + con(ActiveControl).N2)
LstSelectEvent ActiveControl
shiftActiveControl 1
End If
If con(ActiveControl).ConType = 2 Then
TBKeyEvent ActiveControl, kh ' this handles keypress in active textbox
If lc Mod 10 = 9 Then con(ActiveControl).N2 = 1 - con(ActiveControl).N2 ' this is for blinking cursor
If con(ActiveControl).N2 Then
Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), &HFFFFFFFF, BF
Else
Line (con(ActiveControl).X + 4 + 8 * (con(ActiveControl).N1 - 1), con(ActiveControl).Y + (con(ActiveControl).H - 16) / 2 + 17)-Step(8, 3), TbBC, BF
End If
ElseIf con(ActiveControl).ConType = 3 Then
LstKeyEvent ActiveControl, kh
End If
_Display
lc = lc + 1
_Limit 60
Loop Until WindowClose
System
Sub shiftActiveControl (change As Long) ' change = 1 or -1
activateControl ActiveControl, 0 ' turn off last
Do
ActiveControl = ActiveControl + change
If ActiveControl > NControls Then ActiveControl = 1
If ActiveControl < 1 Then ActiveControl = NControls
Loop Until con(ActiveControl).ConType <> 4
activateControl ActiveControl, -1 ' turn on next
End Sub
Sub activateControl (i, activate)
Select Case con(i).ConType
Case 1: drwBtn i, activate
Case 2: drwTB i, activate
Case 3: drwLst i, activate
End Select
End Sub
Sub OpenWindow (WinWidth As Long, WinHeight As Long, title$)
Screen _NewImage(WinWidth, WinHeight, 32)
_ScreenMove 70, 20
_PrintMode _KeepBackground
_Title title$
Color &HFFFFFFFF, screenBC
Cls
End Sub
Function NewControl& (ConType As Long, X As Long, Y As Long, W As Long, H As Long, s$) ' dims are pixels
Dim As Long a
NControls = NControls + 1
ReDim _Preserve con(0 To NControls) As Control
con(NControls).ConType = ConType
con(NControls).X = X
con(NControls).Y = Y
con(NControls).W = W
con(NControls).H = H
con(NControls).Text = s$
ActiveControl = 1
If NControls = 1 Then a = 1 Else a = 0
Select Case ConType
Case 1: drwBtn NControls, a
Case 2: drwTB NControls, a: con(NControls).N1 = Len(s$) + 1: con(NControls).N2 = 0
' N1 is what letter position we are on or cursor for line, N2 is the toggle for cursor blinking
Case 3: con(NControls).N3 = Int((W - 16) / 8) ' page width - .5 charcter margin on each side 1 char scroll click bar
con(NControls).N4 = Int((H - 32) / 16) ' page height 2 empty lines for page up, page down clicking
con(NControls).N1 = 1 ' page number
con(NControls).N2 = 1 ' select highlite bar
con(NControls).Text2 = "" ' zero everything out for UDT's
drwLst NControls, a
Case 4: drwLbl NControls
End Select
NewControl& = NControls ' same as ID
End Function
Sub drwBtn (i As Long, active As Long) ' gray back, black text
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), BtnBC, BF
If active Then Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B Else _
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
Color BtnFC
_PrintString (con(i).X + (con(i).W - 8 * Len(con(i).Text)) / 2, (con(i).Y + (con(i).H - 16) / 2)), con(i).Text
End Sub
Sub drwTB (i As Long, active As Long) ' blue back, white text
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), TbBC, BF
If active Then
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
Else
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
End If
Color TbFC
_PrintString (con(i).X + 4, con(i).Y + (con(i).H - 16) / 2), con(i).Text
End Sub
Sub drwLst (i As Long, active As Long)
' new control will get numbers for constructing a screen
' N1 = page number we are on
' N2 = current location of the highlight bar on the page
' N3 = page width in chars
' N4 = page height + 2 lines are left blank at top and bottom
' N5 = Ubound of the list() base 1 ie last item number
Dim s$
Dim As Long j
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), LstBC, BF
If active Then
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFFFFFFFF, B
Else
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), &HFF000000, B
End If
ReDim lst(1 To 1) As String
Split con(i).Text, "~", lst()
con(i).N5 = UBound(lst)
For j = 1 To con(i).N4
s$ = Space$(con(i).N3)
If (con(i).N1 - 1) * con(i).N4 + j <= con(i).N5 Then
Mid$(s$, 1, con(i).N3) = lst((con(i).N1 - 1) * con(i).N4 + j)
End If
If j <> con(i).N2 Then
Color LstFC
Else
Line (con(i).X + 1, con(i).Y + 16 + (j - 1) * 16)-Step(con(i).W - 2, 16), LstFC, BF
Color LstBC
End If
_PrintString (con(i).X + 4, con(i).Y + 16 + (j - 1) * 16), s$
Next
End Sub
Sub drwLbl (i As Long)
Line (con(i).X, con(i).Y)-Step(con(i).W, con(i).H), screenBC, BF
Static beenHere, fontHandle&(6 To 64)
Dim As Long j
If beenHere = 0 Then
For j = 6 To 64
fontHandle&(j) = _LoadFont("ARLRDBD.ttf", j)
Next
beenHere = -1
End If
Dim As _Unsigned Long curFont
curFont = _Font
_Font fontHandle&(con(i).H)
Color LblFC, _RGB32(0, 0, 0, 0)
_PrintString (con(i).X + (con(i).W - _PrintWidth(con(i).Text)) / 2, con(i).Y), con(i).Text
_Font curFont
End Sub
Sub BtnClickEvent (i As Long) ' attach you button click code in here
Dim answer$, dirs$, fils$ ' <<<<<<<<<<<<<<<<<< dim for click code
Select Case i
' according to your appl needs ================================================ for your appl
Case BtnOK: Shell _DontWait con(LblSelFile).Text ' hey run it!
Case BtnKill
answer$ = inputBox$(con(LblSelFile).Text, "Confirm Kill, enter y or n", _Width \ 8 - 7)
If answer$ = "y" Then
Kill con(LblSelFile).Text
GetListStrings dirs$, fils$
con(LstD).Text = dirs$
con(LstF).Text = fils$
con(LblSelFile).Text = ""
drwLbl LblSelFile
drwLst LstD, 0
drwLst LstF, 0
End If
Case BtnCancel: WindowClose = -1 ' goodbye
' ========================================================================= end plug-in
End Select
End Sub
' this is standard for all Text Boxes
Sub TBKeyEvent (i As Long, ky As Long) ' for all text boxes
If ky = 19200 Then 'left arrow
If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwTB i, -1
ElseIf ky = 19712 Then ' right arrow
If con(i).N1 < Int((con(i).W - 16) / 8) Then con(i).N1 = con(i).N1 + 1: drwTB i, -1
ElseIf ky = 18176 Then 'home
con(i).N1 = 1: drwTB i, -1
ElseIf ky = 20224 Then ' end
If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then con(i).N1 = Len(con(i).Text) + 1: drwTB i, -1
ElseIf ky >= 32 And ky <= 128 Then
If Len(con(i).Text) + 1 <= Int((con(i).W - 16) / 8) Then
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Chr$(ky) + Mid$(con(i).Text, con(i).N1)
con(i).N1 = con(i).N1 + 1: drwTB i, -1
End If
ElseIf ky = 8 Then 'backspace
If con(i).N1 > 1 Then
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 2) + Mid$(con(i).Text, con(i).N1)
con(i).N1 = con(i).N1 - 1: drwTB i, -1
End If
ElseIf ky = 21248 Then 'delete
con(i).Text = Mid$(con(i).Text, 1, con(i).N1 - 1) + Mid$(con(i).Text, con(i).N1 + 1): drwTB i, -1
End If
End Sub
' this is standard for all List Boxes
Sub LstKeyEvent (i As Long, ky As Long) ' for all text boxes
If ky = 18432 Then 'up arrow
If con(i).N2 > 1 Then
con(i).N2 = con(i).N2 - 1: drwLst i, -1
Else
If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: con(i).N2 = con(i).N4: drwLst i, -1
End If
ElseIf ky = 20480 Then ' down arrow
If con(i).N2 < con(i).N4 And (con(i).N1 - 1) * con(i).N4 + con(i).N2 < con(i).N5 Then
con(i).N2 = con(i).N2 + 1: drwLst i, -1
Else
If con(i).N2 = con(i).N4 Then ' can we start another page
If con(i).N1 < con(i).N5 / con(i).N4 Then
con(i).N1 = con(i).N1 + 1: con(i).N2 = 1: drwLst i, -1
End If
End If
End If
ElseIf ky = 18176 Then 'home
con(i).N1 = 1: con(i).N2 = 1: drwLst i, -1
ElseIf ky = 20224 Then ' end
If con(i).N5 Mod con(i).N4 = 0 Then
con(i).N1 = Int(con(i).N5 / con(i).N4)
con(i).N2 = con(i).N4
Else
con(i).N1 = Int(con(i).N5 / con(i).N4) + 1
con(i).N2 = con(i).N5 Mod con(i).N4
End If
drwLst i, -1
ElseIf ky = 18688 Then 'pgUp
If con(i).N1 > 1 Then con(i).N1 = con(i).N1 - 1: drwLst i, -1
ElseIf ky = 20736 Then 'pgDn
If con(i).N1 * con(i).N4 < con(i).N5 Then
con(i).N1 = con(i).N1 + 1
If con(i).N1 > Int(con(i).N5 / con(i).N4) Then ' > last whole page check high bar
If con(i).N2 > con(i).N5 Mod con(i).N4 Then con(i).N2 = con(i).N5 Mod con(i).N4
End If
drwLst i, -1
End If
End If
End Sub
Sub LstSelectEvent (control As Long)
Dim fils$, dirs$
Select Case control
' =================================================================================== for your appl
Case LstD
ChDir con(LstD).Text2
curPath$ = _CWD$
con(LblCurPath).Text = curPath$
drwLbl LblCurPath
GetListStrings dirs$, fils$
con(LstD).Text = dirs$
con(LstF).Text = fils$
con(LblSelFile).Text = ""
drwLbl LblSelFile
drwLst LstD, 0
drwLst LstF, -1 'should be active
Case LstF
con(LblSelFile).Text = curPath$ + "/" + con(LstF).Text2
drwLbl LblSelFile
' ================================================================================= end plug-in
End Select
End Sub
' This is used and available for maniupating strings to arrays ie change delimiters to commas
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
dpos = InStr(curpos, SplitMeString, delim)
Do Until dpos = 0
loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
arrpos = arrpos + 1
If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
curpos = dpos + LD
dpos = InStr(curpos, SplitMeString, delim)
Loop
loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub
' Available if need to create a string from an array
Function Join$ (arr() As String, delimiter$) ' modified to avoid blank lines
Dim i As Long, b$
For i = LBound(arr) To UBound(arr)
If arr(i) <> "" Then
If b$ = "" Then b$ = arr(i) Else b$ = b$ + delimiter$ + arr(i)
End If
Next
Join$ = b$
End Function
' added to GUI - 2022-06-15 version ============================= Routines for this appl
' You can grab this box by title and drag it around screen for full viewing while answering prompt.
' Only one line allowed for prompt$
' boxWidth is 4 more than the allowed length of input, it needs to be longer than title$ and prompt$ also
' Utilities > Input Box > Input Box 1 tester v 2019-07-31
Function inputBox$ (prompt$, title$, boxWidth As Long) ' boxWidthin default 8x16 chars!!!
Dim ForeColor As _Unsigned Long, BackColor As _Unsigned Long
Dim sw As Long, sh As Long, curScrn As Long, backScrn As Long, ibx As Long 'some handles
'colors
ForeColor = &HFF000055 '< change as desired prompt text color, back color or type in area
BackColor = &HFF6080CC '< change as desired used fore color in type in area
'items to restore at exit
ScnState 0
'screen snapshot
sw = _Width: sh = _Height: curScrn = _Dest
backScrn = _NewImage(sw, sh, 32)
_PutImage , curScrn, backScrn
'moving box around on screen
Dim bxW As Long, bxH As Long
Dim mb As Long, mx As Long, my As Long, mi As Long, grabx As Long, graby As Long
Dim tlx As Long, tly As Long 'top left corner of message box
Dim lastx As Long, lasty As Long
Dim inp$, kh&
'draw message box
bxW = boxWidth * 8: bxH = 7 * 16
ibx = _NewImage(bxW, bxH, 32)
_Dest ibx
Color &HFF880000, &HFFFFFFFF
Locate 1, 1: Print Left$(Space$(Int((boxWidth - Len(title$) - 3)) / 2) + title$ + Space$(boxWidth), boxWidth)
Color &HFFFFFFFF, &HFFBB0000
Locate 1, boxWidth - 2: Print " X "
Color ForeColor, BackColor
Locate 2, 1: Print Space$(boxWidth);
Locate 3, 1: Print Left$(Space$((boxWidth - Len(prompt$)) / 2) + prompt$ + Space$(boxWidth), boxWidth);
Locate 4, 1: Print Space$(boxWidth);
Locate 5, 1: Print Space$(boxWidth);
Locate 6, 1: Print Space$(boxWidth);
inp$ = ""
GoSub finishBox
'convert to pixels the top left corner of box at moment
bxW = boxWidth * 8: bxH = 5 * 16
tlx = (sw - bxW) / 2: tly = (sh - bxH) / 2
lastx = tlx: lasty = tly
_KeyClear
'now allow user to move it around or just read it
While 1
Cls
_PutImage , backScrn
_PutImage (tlx, tly), ibx, curScrn
_Display
While _MouseInput: Wend
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
If mb Then
If mx >= tlx And mx <= tlx + bxW And my >= tly And my <= tly + 16 Then 'mouse down on title bar
If mx >= tlx + bxW - 24 Then Exit While
grabx = mx - tlx: graby = my - tly
Do While mb 'wait for release
mi = _MouseInput: mb = _MouseButton(1)
mx = _MouseX: my = _MouseY
If mx - grabx >= 0 And mx - grabx <= sw - bxW And my - graby >= 0 And my - graby <= sh - bxH Then
'attempt to speed up with less updates
If ((lastx - (mx - grabx)) ^ 2 + (lasty - (my - graby)) ^ 2) ^ .5 > 10 Then
tlx = mx - grabx: tly = my - graby
Cls
_PutImage , backScrn
_PutImage (tlx, tly), ibx, curScrn
lastx = tlx: lasty = tly
_Display
End If
End If
_Limit 400
Loop
End If
End If
kh& = _KeyHit
Select Case kh& 'whew not much for the main event!
Case 13: Exit While
Case 27: inp$ = "": Exit While
Case 32 To 128: If Len(inp$) < boxWidth - 4 Then inp$ = inp$ + Chr$(kh&): GoSub finishBox Else Beep
Case 8: If Len(inp$) Then inp$ = Left$(inp$, Len(inp$) - 1): GoSub finishBox Else Beep
End Select
_Limit 60
Wend
'put things back
ScnState 1 'need fg and bg colors set to cls
Cls '? is this needed YES!!
_PutImage , backScrn
_Display
_FreeImage backScrn
_FreeImage ibx
ScnState 1 'because we have to call _display, we have to call this again
inputBox$ = inp$
Exit Function
finishBox:
_Dest ibx
Color BackColor, ForeColor
Locate 5, 2: Print Left$(" " + inp$ + Space$(boxWidth - 2), boxWidth - 2)
_Dest curScrn
Return
End Function
' for saving and restoring screen settins
Sub ScnState (restoreTF As Long) 'Thanks Steve McNeill
Static defaultColor~&, backGroundColor~&
Static font&, dest&, source&, row&, col&, autodisplay&, mb&
If restoreTF Then
_Font font&
Color defaultColor~&, backGroundColor~&
_Dest dest&
_Source source&
Locate row&, col&
If autodisplay& Then _AutoDisplay Else _Display
_KeyClear
While _MouseInput: Wend 'clear mouse clicks
mb& = _MouseButton(1)
If mb& Then
Do
While _MouseInput: Wend
mb& = _MouseButton(1)
_Limit 100
Loop Until mb& = 0
End If
Else
font& = _Font: defaultColor~& = _DefaultColor: backGroundColor~& = _BackgroundColor
dest& = _Dest: source& = _Source
row& = CsrLin: col& = Pos(0): autodisplay& = _AutoDisplay
_KeyClear
End If
End Sub
Sub GetListStrings (dirOut$, fileOut$)
ReDim Folders$(1 To 1), Files$(1 To 1) ' setup to call GetLists
If curPath$ = "" Then curPath$ = _CWD$
GetLists curPath$, Folders$(), Files$()
dirOut$ = Join$(Folders$(), "~")
fileOut$ = Join$(Files$(), "~")
End Sub
Sub GetLists (SearchDirectory As String, DirList() As String, FileList() As String)
' Thanks SNcNeill ! for a cross platform method to get file and directory lists
'put this block in main code section of your program close to top
'' direntry.h needs to be in QB64 folder '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'DECLARE CUSTOMTYPE LIBRARY ".\direntry"
' FUNCTION load_dir& (s AS STRING)
' FUNCTION has_next_entry& ()
' SUB close_dir ()
' SUB get_next_entry (s AS STRING, flags AS LONG, file_size AS LONG)
'END DECLARE
Const IS_DIR = 1
Const IS_FILE = 2
Dim flags As Long, file_size As Long, DirCount As Integer, FileCount As Integer, length As Long
Dim nam$
ReDim _Preserve DirList(100), FileList(100)
DirCount = 0: FileCount = 0
If load_dir(SearchDirectory + Chr$(0)) Then
Do
length = has_next_entry
If length > -1 Then
nam$ = Space$(length)
get_next_entry nam$, flags, file_size
If (flags And IS_DIR) Then
DirCount = DirCount + 1
If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
DirList(DirCount) = nam$
ElseIf (flags And IS_FILE) Then
FileCount = FileCount + 1
If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
FileList(FileCount) = nam$
End If
End If
Loop Until length = -1
'close_dir 'move to after end if might correct the multi calls problem
Else
End If
close_dir 'this might correct the multi calls problem
ReDim _Preserve DirList(DirCount)
ReDim _Preserve FileList(FileCount)
End Sub
' Remove comments below and copy paste into text editor, save as direntry.h
' Save in your QB64.exe folder if you don't have it already
'============================================================= direntry.h copy but commented
'#include <dirent.h>
'#include <sys/stat.h>
'#include <unistd.h>
'const int IS_DIR_FLAG = 1, IS_FILE_FLAG = 2;
'DIR *pdir;
'struct dirent *next_entry;
'struct stat statbuf1;
'char current_dir[FILENAME_MAX];
'#ifdef QB64_WINDOWS
' #define GetCurrentDir _getcwd
'#else
' #define GetCurrentDir getcwd
'#endif
'int load_dir (char * path) {
' struct dirent *pent;
' struct stat statbuf1;
'//Open current directory
'pdir = opendir(path);
'if (!pdir) {
'return 0; //Didn't open
'}
'return -1;
'}
'int has_next_entry () {
' next_entry = readdir(pdir);
' if (next_entry == NULL) return -1;
' stat(next_entry->d_name, &statbuf1);
' return strlen(next_entry->d_name);
'}
'void get_next_entry (char * nam, int * flags, int * file_size) {
' strcpy(nam, next_entry->d_name);
' if (S_ISDIR(statbuf1.st_mode)) {
' *flags = IS_DIR_FLAG;
' } else {
' *flags = IS_FILE_FLAG;
' }
' *file_size = statbuf1.st_size;
' return ;
'}
'void close_dir () {
' closedir(pdir);
' pdir = NULL;
' return ;
'}
'int current_dir_length () {
' GetCurrentDir(current_dir, sizeof(current_dir));
' return strlen(current_dir);
'}
'void get_current_dir(char *dir) {
' memcpy(dir, current_dir, strlen(current_dir));
' return ;
'}
Here is a screenshot of GUI Get Filename running some code with a bug in it ;-))
Linux might not have a problem with this, I used the other slanted slash to Join the path to the filename, see selected file label.
Wait does Linux do Shell?
b = b + ...
Posts: 199
Threads: 15
Joined: Apr 2022
Reputation:
4
excellent bplus. the display font is very small on my 15 inch 1980x1080 screen...
Posts: 34
Threads: 1
Joined: Apr 2022
Reputation:
2
(06-16-2022, 10:09 PM)Coolman Wrote: hello, bplus has done a very good job in only a few days. the name chosen "Very Simple GUI" seems logical. it will be enough to create a very simple gui with some gadgets, font management, possibly dpi support to manage the enlargement according to the system...
for a more sophisticated gui, i suggest to use the raylib library which is cross-platform and very efficient. starting from zero would not be profitable because it would require a lot of time...
@Coolman
Yes, I think @bplus has done a tremendous job in just a few days and has stuck to the mantra of "Very Simple GUI". A simple GUI that produces a combination of boxes, buttons and listboxes is enough for many. If more is required then there are many solutions, but they are inevitably a bit (or a lot) more complicated. This topic arose from your original topic where you identified Lothar Schirm's SimpleGUI library for Freebasic. This library does exactly that. @bplus is endevouring to do something similar for QB64. Strength to his arm!
|
