OK now with List Boxes and labels:
Code: (Select All)
Option _Explicit
_Title "GUI - add LstBox 2022-06" 'b+ 2022-06-13, add ListBoxes and Labels 6-14 & 15
' 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!
'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 ID, 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
Label 70, 150, 64, "b+ Very Simple GUI"
NewControl 1, 220, 10, 100, 32, "Button 1" ' i = 1
NewControl 1, 220, 60, 100, 32, "Clear" ' i = 2
NewControl 2, 10, 230, 200, 32, "Textbox 1" ' i = 3
NewControl 2, 220, 230, 200, 32, "Textbox 2" ' i = 4
NewControl 2, 430, 230, 100, 32, "Tb 3" ' i = 5
NewControl 2, 540, 230, 200, 32, "Test pqg 4" ' i = 6
Label 10, 270, 32, "Day"
NewControl 3, 10, 300, 200, 130, "Monday,Tuesday,Wednesday,Thursday,Friday,Saturday,Sunday" ' i = 7
Label 220, 270, 32, "Month"
NewControl 3, 220, 300, 200, 130, "January,February,March,April,May,June,July,August,September,October,November,December" ' i = 8
Label 430, 270, 32, "Date"
NewControl 3, 430, 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" ' i = 9
NewControl 1, 540, 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 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
'move active control down index
activateControl ActiveControl, 0
ActiveControl = ActiveControl + 1
If ActiveControl > NControls Then ActiveControl = 1
activateControl ActiveControl, -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)
_PrintString (500, 40), "Text2 is set to: " + con(ActiveControl).Text2
'move active control down index ' this is moving 2 times
activateControl ActiveControl, 0
ActiveControl = ActiveControl + 1
If ActiveControl > NControls Then ActiveControl = 1
activateControl ActiveControl, -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
activateControl ActiveControl, 0
ActiveControl = ActiveControl - 1
If ActiveControl = 0 Then ActiveControl = NControls
activateControl ActiveControl, -1
Else
activateControl ActiveControl, 0
ActiveControl = ActiveControl + 1
If ActiveControl > NControls Then ActiveControl = 1
activateControl ActiveControl, -1
End If
ElseIf kh = 13 And con(ActiveControl).ConType = 1 Then ' enter on a btn
BtnClickEvent ActiveControl
activateControl ActiveControl, 0
ActiveControl = ActiveControl + 1
If ActiveControl > NControls Then ActiveControl = 1
activateControl ActiveControl, -1
ElseIf kh = 13 And con(ActiveControl).ConType = 2 Then '
activateControl ActiveControl, 0
ActiveControl = ActiveControl + 1
If ActiveControl > NControls Then ActiveControl = 1
activateControl ActiveControl, -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)
_PrintString (500, 40), "Text2 is set to: " + con(ActiveControl).Text2
activateControl ActiveControl, 0
ActiveControl = ActiveControl + 1
If ActiveControl > NControls Then ActiveControl = 1
activateControl ActiveControl, -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 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
Sub 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
End Select
End Sub
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 BtnClickEvent (i As Long) ' attach you button click code in here
Select Case i
' according to your appl needs ================================================
Case 1: Color &HFFFFFF00: _PrintString (500, 20), "You pushed my button!"
Case 2: Line (500, 20)-Step(300, 40), screenBC, BF
Case 10
con(3).Text = con(7).Text2: con(4).Text = con(8).Text2
con(5).Text = con(9).Text2: con(6).Text = con(7).Text2 + ", " + con(8).Text2 + " " + con(9).Text2
' Hint: change cursor N1 when change Text
con(3).N1 = Len(con(3).Text) + 1
con(4).N1 = Len(con(4).Text) + 1
con(5).N1 = Len(con(5).Text) + 1
con(6).N1 = Len(con(6).Text) + 1
drwTB 3, 0: drwTB 4, 0: drwTB 5, 0: drwTB 6, 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 Label (x, y, textHeight, txt$) ' one color
Static beenHere, fontHandle&(6 To 64)
Dim i As Long
If beenHere = 0 Then
For i = 6 To 64
'fontHandle&(i) = _LoadFont("arial.ttf", i )
fontHandle&(i) = _LoadFont("ARLRDBD.ttf", i)
Next
beenHere = -1
End If
Dim As _Unsigned Long fg, bg, curFont
curFont = _Font
_Font fontHandle&(textHeight)
fg = _DefaultColor
bg = _BackgroundColor
Color LblFC, _RGB32(0, 0, 0, 0)
_PrintString (x, y), txt$
Color fg, bg
_Font curFont
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 + ...