06-16-2022, 05:28 AM
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.
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 + ...