Here is the GUI system (a slightly earlier version than in the game as I it had to be tied in with other things, but it is a good working example).
This may be useful for anyone who wants a nice simple GUI (labels, text boxes, list boxes etc), with a really easy event system that is all written in DB Pro. This is helpful if you need a GUI in fullscreen mode.
Anyway here it is:
MainProg:
Sync On
Sync Rate 60
Disable EscapeKey
Gosub WinInit
`Menu bar
winId = CreateWin("menuBar", 1, 1, Screen Width() - 2, 22)
CreateWinControl("mnuFile", winId, ctrlTypes.Label, 0, 0, 0, "File")
CreateWinControl("mnuEdit", winId, ctrlTypes.Label, 50, 0, 0, "Edit")
`Panel
winId = CreateWin("panel", 10, 60, 400, 200)
ctrlId = CreateWinControl("MyTextBox", winId, ctrlTypes.TextBox, 10, 10, 370, "Hello World")
ctrl(ctrlId).maxLength = 100 `Set maximum characters for text box
ctrlId = CreateWinControl("MyListBox", winId, ctrlTypes.ListBox, 10, 50, 200, "Apples\Oranges\Pears\Strawberries\Raspberries\Bananas\Grapes\Cherries")
ctrl(ctrlId).height = 90
ctrlId = CreateWinControl("MySelection", winId, ctrlTypes.TextBox, 10, 150, 100, "")
exitProg As Boolean
Make Object Box 1, 1, 1, 1
Repeat
myEvent$ = WinDraw() `Draw all controls. Any event that occured is logged in myEvent$
Select myEvent$
Case "menuBar.mnuFile.Click"
`Create the file menu when File is clicked on the menu bar
winId = CreateWin("fileMenu", 1, 1, 50, 40)
ctrlId = CreateWinControl("mnuFile2", winId, ctrlTypes.Label, 0, 0, 0, "File")
ctrl(ctrlId).enabled = false
CreateWinControl("mnuExit", winId, ctrlTypes.Label, 0, 18, 0, "Exit")
win(winId).mouseOut = 20 `Remove when the mouse is outside bounds for 20 cycles
EndCase
Case "fileMenu.mnuExit.Click"
exitProg = 1
EndCase
Case "menuBar.mnuEdit.Click"
`Create the edit menu
winId = CreateWin("editMenu", 51, 1, 50, 80)
ctrlId = CreateWinControl("mnuEdit_2", winId, ctrlTypes.Label, 0, 0, 0, "Edit")
ctrl(ctrlId).enabled = false
win(winId).mouseOut = 20
EndCase
Case "panel.MyListBox.Changed"
`Set the MySelection textbox text to the list box selection when changed
SetWinControlValue("panel", "MySelection", GetWinControlValue("panel", "MyListBox"))
EndCase
EndSelect
Rotate Object 1, Object Angle X(1) + 0.5, Object Angle Y(1) + 0.2, Object Angle Z(1) + 0.1
Sync
Until exitProg
End
Type ControlTypes
Label As Integer
TextBox As Integer
ListBox As Integer
EndType
Type WinKeysType
lastKey As Integer
lastInkey$ As String
counter As Integer
shift As Boolean
Delay As Integer
Left As Integer
Right As Integer
Up As Integer
Down As Integer
LeftSel As Integer
RightSel As Integer
HomeSel As Integer
EndKeySel As Integer
Home As Integer
EndKey As Integer
LeftShift As Integer
RightShift As Integer
BackSpace As Integer
Delete As Integer
Tab As Integer
Enter As Integer
NumEnter As Integer
Escape As Integer
PageUp As Integer
PageDown As Integer
EndType
Type WinMouseType
x As Integer
y As Integer
z As Integer
click As Integer
clickCounter As Integer
EndType
Type WinFocusType
id As Integer
cursor As Integer
selStart As Integer
selLength As Integer
selAction As Integer
leftPos As Integer
rightPos As Integer
blinkCounter As Integer
mouseOver As Integer
mouseOverLast As Integer
validate As Boolean
undoValue As String
EndType
Type WinObj
name As String
x As Integer
y As Integer
width As Integer
height As Integer
margin As Integer
mouseOut As Integer
mouseOutCtr As Integer
drawOrder As Integer
EndType
Type WinControl
name As String
owner As Integer
x As Integer
y As Integer
width As Integer
height As Integer
value As String
enabled As Boolean
ctrlType As Integer
listIndex As Integer
listTop As Integer
maxLength As Integer
validate As Boolean
EndType
Type WinColors
Background As Integer
Border As Integer
Label As Integer
LabelSel As Integer
TextBox As Integer
TextBoxText As Integer
Highlight As Integer
HighlightText As Integer
Selected As Integer
SelectedText As Integer
EndType
WinInit:
`Set up global variables
Global ctrlTypes As ControlTypes
ctrlTypes.Label = 0
ctrlTypes.TextBox = 1
ctrlTypes.ListBox = 2
Global winKeys As WinKeysType
winKeys.Delay = 8
winKeys.Left = 203
winKeys.Right = 205
winKeys.Up = 200
winKeys.Down = 208
winKeys.LeftSel = 10
winKeys.RightSel = 11
winKeys.HomeSel = 12
winKeys.EndKeySel = 13
winKeys.Home = 199
winKeys.EndKey = 207
winKeys.LeftShift = 42
winKeys.RightShift = 54
winKeys.BackSpace = 14
winKeys.Delete = 211
winKeys.Tab = 15
winKeys.Enter = 28
winKeys.NumEnter = 156
winKeys.Escape = 1
winKeys.PageUp = 201
winKeys.PageDown = 209
Global winColor As WinColors
winColor.Background = RGB(50, 50, 50)
winColor.Border = RGB(150, 150, 150)
winColor.Label = RGB(255, 255, 100)
winColor.LabelSel = RGB(0, 255, 255)
winColor.TextBox = RGB(255, 255, 255)
winColor.TextBoxText = 0
winColor.Highlight = RGB(0, 0, 128)
winColor.HighlightText = RGB(255, 255, 255)
winColor.Selected = RGB(75, 75, 75)
winColor.SelectedText = RGB(255, 255, 100)
Global Dim win(0) As WinObj
Global Dim ctrl(0) As WinControl
Global winFocus As WinFocusType
Global winMouse As WinMouseType
Return
Function WinDraw()
ctr As Integer
i As Integer
j As Integer
mx As Integer
my As Integer
mz As Integer
mClick As Integer
event$ As String
maxDraw As Integer
allowKey As Boolean
curKey As Integer
mx = MouseX()
my = MouseY()
mz = MouseZ()
mClick = MouseClick()
If mClick = 1 And winMouse.click = 1
If winMouse.clickCounter < 15
Inc winMouse.clickCounter
mClick = -1
Else
winMouse.clickCounter = 0
EndIf
Else
winMouse.clickCounter = 0
EndIf
ctr = WinCount()
For i = ctr To 1 Step - 1
If win(i).drawOrder > maxDraw Then maxDraw = win(i).drawOrder
If win(i).mouseOut > 0
If mx < win(i).x Or mx > (win(i).x + win(i).width) Or my < win(i).y Or my > (win(i).y + win(i).height)
Inc win(i).mouseOutCtr
If win(i).mouseOutCtr > win(i).mouseOut
DeleteWin(i)
EndIf
Else
win(i).mouseOutCtr = 0
EndIf
EndIf
Next i
ctr = WinCount()
winFocus.mouseOverLast = winFocus.mouseOver
winFocus.mouseOver = 0
`Keyboard handling
If winFocus.id > 0
If KeyState(winKeys.LeftShift) = 1 Or KeyState(winKeys.RightShift) = 1
winKeys.shift = 1
Else
winKeys.shift = 0
EndIf
If KeyState(winKeys.BackSpace) = 1 Then curKey = winKeys.BackSpace
If KeyState(winKeys.Delete) = 1 Then curKey = winKeys.Delete
If KeyState(winKeys.Escape) = 1 Then curKey = winKeys.Escape
If KeyState(winKeys.Enter) = 1 Or KeyState(winKeys.NumEnter) = 1 Then curKey = winKeys.Enter
If winKeys.shift
If LeftKey() = 1 Then curKey = winKeys.LeftSel
If RightKey() = 1 Then curKey = winKeys.RightSel
If KeyState(winKeys.Home) = 1 Then curKey = winKeys.HomeSel
If KeyState(winKeys.EndKey) = 1 Then curKey = winKeys.EndKeySel
Else
If LeftKey() = 1 Then curKey = winKeys.Left
If RightKey() = 1 Then curKey = winKeys.Right
If KeyState(winKeys.Home) = 1 Then curKey = winKeys.Home
If KeyState(winKeys.EndKey) = 1 Then curKey = winKeys.EndKey
EndIf
If KeyState(winKeys.Up) = 1 Then curKey = winKeys.Up
If KeyState(winKeys.Down) = 1 Then curKey = winKeys.Down
If KeyState(winKeys.PageUp) = 1 Then curKey = winKeys.PageUp
If KeyState(winKeys.PageDown) = 1 Then curKey = winKeys.PageDown
If winKeys.lastKey <> curKey
winKeys.lastKey = curKey
allowKey = (winKeys.lastKey > 0)
winKeys.counter = 0
Else
Inc winKeys.counter
If winKeys.counter > winKeys.Delay
winKeys.counter = 0
allowKey = (winKeys.lastKey > 0)
EndIf
EndIf
Else
allowKey = 0
EndIf
For j = maxDraw To 0 Step -1
For i = 1 To ctr
If win(i).drawOrder = j
event$ = WinDrawSingle(i, event$, mx, my, mz, mClick, allowKey)
EndIf
Next i
Next j
EndFunction event$
Function WinDrawSingle(winId As Integer, event$ As String, mx As Integer, my As Integer, mz As Integer, mClick As Integer, allowKey As Boolean)
ctrlCount As Integer
i As Integer
j As Integer
ctrlCount = WinControlCount()
x As Integer
y As Integer
w As Integer
h As Integer
tmp$ As String
tmp As Integer
selCheck As Boolean
listCount As Integer
lineHeight As Integer
totalHeight As Integer
lineHeight = Text Height("H")
If lineHeight = 0 Then lineHeight = 1
Ink winColor.Border, 0
Box win(winId).x - 1, win(winId).y - 1, win(winId).x + win(winId).width + 1, win(winId).y + win(winId).height + 1
Ink winColor.Background, 0
Box win(winId).x, win(winId).y, win(winId).x + win(winId).width, win(winId).y + win(winId).height
For i = 1 To ctrlCount
If ctrl(i).owner = winId
x = win(winId).x + win(winId).margin + ctrl(i).x
y = win(winId).y + win(winId).margin + ctrl(i).y
If ctrl(i).ctrlType = ctrlTypes.Label
w = Text Width(ctrl(i).value)
h = Text Height(ctrl(i).value)
Ink winColor.Label, 0
If ctrl(i).enabled
If mx >= x And mx <= (x + w) And my >= y And my <= (y + h)
If winFocus.mouseOverLast = i
If WinControlValidateRequired()
event$ = WinControlValidateEvent()
Else
Ink winColor.LabelSel, 0
If mClick = 1
event$ = win(winId).name + "." + ctrl(i).name + ".Click"
winFocus.id = 0
EndIf
EndIf
EndIf
EndIf
EndIf
If ctrl(i).value <> "-"
Text x, y, ctrl(i).value
Else
Ink winColor.Border, 0
Line win(winId).x, y + (h / 2), win(winId).x + win(winId).width, y + (h / 2)
EndIf
EndIf
If ctrl(i).ctrlType = ctrlTypes.ListBox
w = ctrl(i).width
h = ctrl(i).height
Ink winColor.Border, 0
Box x - 1, y - 1, x + w + 1, y + h + 1
Ink winColor.Background, 0
Box x, y, x + w, y + h
`Scroll Bar
Ink winColor.Border, 0
Box x + w + 1, y - 1, x + w + 16, y + h + 1
Ink winColor.Background, 0
Box x + w + 2, y + 16, x + w + 14, y + h - 16
listCount = CountItems(ctrl(i).value, "\")
If ctrl(i).listTop <= 0 Then ctrl(i).listTop = 1
totalHeight = 0
j = ctrl(i).listTop
While j <= listCount And totalHeight < ctrl(i).height
tmp$ = GetItem(j, ctrl(i).value, "\")
tmp$ = WinControlText(i, 1, tmp$)
If j <> ctrl(i).listIndex
Ink winColor.Label, 0
Else
If winFocus.id = i
Ink winColor.Highlight, 0
Else
Ink winColor.Selected, 0
EndIf
Box x, y + totalHeight, x + w, y + totalHeight + lineHeight
If winFocus.id = i
Ink winColor.HighlightText, 0
Else
Ink winColor.SelectedText, 0
EndIf
EndIf
Text x, y + totalHeight, tmp$
If mx >= x And mx <= (x + w + 16) And my >= y And my <= (y + h)
If mClick = 1 And ctrl(i).enabled
If WinControlValidateRequired()
event$ = WinControlValidateEvent()
Else
If mx >= x And mx <= (x + w) And my >= y And my <= (y + h)
If my >= (y + totalHeight) And my <= (y + totalHeight + lineHeight)
winFocus.id = i
If j <> ctrl(i).listIndex
ctrl(i).listIndex = j
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
Else
event$ = win(winId).name + "." + ctrl(i).name + ".Click"
EndIf
EndIf
Else
winFocus.id = i
event$ = win(winId).name + "." + ctrl(i).name + ".Click"
EndIf
EndIf
EndIf
EndIf
Inc j
Inc totalHeight, lineHeight
EndWhile
If winFocus.id = i
If mClick = 1
If mx >= (x + w) And mx <= (x + w + 16)
If my >= y And my <= (y + 16)
If ctrl(i).listTop > 1 Then Dec ctrl(i).listTop
EndIf
If my >= ((y + h) - 16) And my <= (y + h)
If ctrl(i).listTop < listCount Then Inc ctrl(i).listTop
EndIf
EndIf
Else
If mz <> winMouse.z
If mz > winMouse.z
If ctrl(i).listTop > 1 Then Dec ctrl(i).listTop
Else
If ctrl(i).listTop < listCount Then Inc ctrl(i).listTop
EndIf
Else
If allowKey
If winKeys.lastKey = winKeys.Up
If ctrl(i).listIndex > 1
Dec ctrl(i).listIndex
ListIndexEnsureVisible(i)
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
EndIf
EndIf
If winKeys.lastKey = winKeys.Down
If ctrl(i).listIndex > 0 And ctrl(i).listIndex < listCount
Inc ctrl(i).listIndex
ListIndexEnsureVisible(i)
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
EndIf
EndIf
If winKeys.lastKey = winKeys.Home
If listCount > 0
ctrl(i).listIndex = 1
ListIndexEnsureVisible(i)
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
EndIf
EndIf
If winKeys.lastKey = winKeys.EndKey
If listCount > 0
ctrl(i).listIndex = listCount
ListIndexEnsureVisible(i)
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
EndIf
EndIf
If winKeys.lastKey = winKeys.PageUp
If listCount > 0 And ctrl(i).listIndex > 1
Dec ctrl(i).listIndex, GetListBoxLineCount(i)
If ctrl(i).listIndex < 1 Then ctrl(i).listIndex = 1
ListIndexEnsureVisible(i)
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
EndIf
EndIf
If winKeys.lastKey = winKeys.PageDown
If listCount > 0 And ctrl(i).listIndex < listCount
Inc ctrl(i).listIndex, GetListBoxLineCount(i)
If ctrl(i).listIndex > listCount Then ctrl(i).listIndex = listCount
ListIndexEnsureVisible(i)
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
EndIf
If ctrl(i).ctrlType = ctrlTypes.TextBox
w = ctrl(i).width
h = 20
Ink winColor.TextBox, 0
Box x - 1, y - 1, x + w + 1, y + h + 1
Ink winColor.TextBoxText, 0
If winFocus.id = i
Inc winFocus.blinkCounter
selCheck = 0
If allowKey
If winFocus.selStart = 0 Or winFocus.selAction = 0
If winKeys.LastKey = winKeys.LeftSel
WinControlResetSel()
winFocus.selStart = winFocus.cursor + 1
winFocus.selLength = 0
winFocus.selAction = 1
EndIf
If winKeys.LastKey = winKeys.RightSel
WinControlResetSel()
winFocus.selStart = winFocus.cursor + 1
winFocus.selLength = 0
winFocus.selAction = 2
EndIf
EndIf
If winKeys.lastKey = winKeys.Left
Dec winFocus.cursor
WinControlResetSel()
EndIf
If winKeys.lastKey = winKeys.Right
Inc winFocus.cursor
WinControlResetSel()
EndIf
If winKeys.lastKey = winKeys.LeftSel
Dec winFocus.cursor
If winFocus.selAction = 1
Dec winFocus.selStart
Inc winFocus.selLength
Else
Dec winFocus.selLength
EndIf
selCheck = 1
EndIf
If winKeys.lastKey = winKeys.RightSel
Inc winFocus.cursor
If winFocus.selAction = 2
Inc winFocus.selLength
Else
Dec winFocus.selLength
Inc winFocus.selStart
EndIf
selCheck = 1
EndIf
If winKeys.lastKey = winKeys.Home
winFocus.cursor = 0
winFocus.leftPos = 1
WinControlResetSel()
EndIf
If winKeys.lastKey = winKeys.EndKey
winFocus.cursor = Len(ctrl(i).value)
winFocus.leftPos = WinControlStartIndex(i)
WinControlResetSel()
EndIf
If winKeys.lastKey = winKeys.HomeSel
If (winFocus.selStart > 0 And winFocus.selLength > 0)
winFocus.selLength = winFocus.selStart + (winFocus.selLength - 1)
Else
winFocus.selLength = winFocus.cursor
EndIf
winFocus.cursor = 0
winFocus.selStart = 1
winFocus.LeftPos = 1
selCheck = 1
winFocus.selAction = 1
EndIf
If winKeys.lastKey = winKeys.EndKeySel
If (winFocus.selStart = 0 And winFocus.selLength = 0)
winFocus.selStart = winFocus.cursor + 1
EndIf
winFocus.selLength = Len(ctrl(i).value) - (winFocus.selStart - 1)
winFocus.cursor = Len(ctrl(i).value)
winFocus.LeftPos = WinControlStartIndex(i)
selCheck = 1
winFocus.selAction = 2
EndIf
If winKeys.lastKey = winKeys.Delete Or winKeys.lastKey = winKeys.BackSpace
If winFocus.selStart > 0 And winFocus.SelLength > 0
WinControlInsertText(i, "")
Else
If winKeys.lastKey = winKeys.Delete
`Delete
winFocus.selStart = winFocus.cursor + 1
winFocus.selLength = 1
WinControlInsertText(i, "")
Else
`Backspace
winFocus.selStart = winFocus.cursor
winFocus.selLength = 1
If winFocus.cursor > 0 And winFocus.cursor < Len(ctrl(i).value) Then tmp = 1 Else tmp = 0
WinControlInsertText(i, "")
If tmp Then Dec winFocus.cursor
EndIf
EndIf
EndIf
WinControlCheckCursor(i, selCheck)
If winKeys.lastKey = winKeys.Enter
`Enter
If WinControlValidateRequired()
event$ = WinControlValidateEvent()
Else
WinControlValidated()
event$ = win(winId).name + "." + ctrl(i).name + ".Changed"
EndIf
EndIf
If winKeys.lastKey = winKeys.Escape
If winFocus.validate Then ctrl(i).value = winFocus.undoValue
WinControlValidated()
EndIf
Else
`Not allowed a key, so check for Inkey$()
tmp$ = Inkey$()
If Asc(tmp$) < 32 Then tmp$ = ""
If ctrl(i).maxLength > 0
If winFocus.selLength = 0
If Len(ctrl(i).value) >= ctrl(i).maxLength Then tmp$ = ""
EndIf
EndIf
If tmp$ <> ""
If tmp$<> winKeys.lastInkey$
winKeys.lastInkey$ = tmp$
WinControlInsertText(i, tmp$)
WinControlCheckCursor(i, 1)
EndIf
Else
winKeys.lastInkey$ = ""
EndIf
EndIf
WinControlDrawFocusText(i)
Else
Text x, y, WinControlText(i, 1, ctrl(i).value)
If mx >= x And mx <= (x + w) And my >= y And my <= (y + h)
If mClick = 1 And ctrl(i).enabled And winFocus.mouseOverLast = i
If WinControlValidateRequired()
event$ = WinControlValidateEvent()
Else
WinControlResetSel()
winFocus.id = i
winFocus.validate = 0
winFocus.selStart = 1
winFocus.selLength = Len(ctrl(i).value)
winFocus.cursor = Len(ctrl(i).value)
winFocus.leftPos = WinControlStartIndex(i)
winFocus.rightPos = Len(ctrl(i).value)
winFocus.undoValue = ctrl(i).value
WinControlCheckCursor(i, 1)
WinControlDrawFocusText(i)
event$ = win(winId).name + "." + ctrl(i).name + ".Click"
EndIf
EndIf
EndIf
EndIf
EndIf
If mx >= x And mx <= (x + w) And my >= y And my <= (y + h)
winFocus.mouseOver = i
EndIf
EndIf
Next i
winMouse.x = mx
winMouse.y = my
winMouse.z = mz
If mClick >= 0 Then winMouse.click = mClick
EndFunction event$
Function WinControlValidated()
WinControlResetSel()
winFocus.id = 0
winFocus.validate = 0
winFocus.undoValue = ""
winMouse.click = 0
winMouse.clickCounter = 0
EndFunction
Function WinControlValidateRequired()
Local rv As Boolean
rv = 0
If winFocus.validate
If winFocus.id > 0
If ctrl(winFocus.id).validate Then rv = 1
EndIf
EndIf
EndFunction rv
Function WinControlValidateEvent()
Local rv$ As String
If winFocus.id > 0
rv$ = win(ctrl(winFocus.id).owner).name + "." + ctrl(winFocus.id).name + ".Validate"
Else
winFocus.validate = 0
EndIf
EndFunction rv$
Function WinControlCheckCursor(id As Integer, selCheck As Boolean)
Local tmp$ As String
If winFocus.cursor < 0 Then winFocus.cursor = 0
If winFocus.cursor > Len(ctrl(id).value) Then winFocus.cursor = Len(ctrl(id).value)
If winFocus.cursor < (winFocus.leftPos - 1) Then winFocus.leftPos = winFocus.cursor
tmp$ = WinControlText(id, winFocus.leftPos, ctrl(id).value)
winFocus.rightPos = winFocus.leftPos + Len(tmp$)
If winFocus.cursor >= winFocus.rightPos
Inc winFocus.leftPos
EndIf
If selCheck
If winFocus.selLength <= 0
WinControlResetSel()
Else
If winFocus.selStart < 1 Then winFocus.selStart = 1
If (winFocus.selStart + (winFocus.selLength - 1)) > Len(ctrl(id).value) Then winFocus.selLength = Len(ctrl(id).value) - (winFocus.selStart - 1)
EndIf
EndIf
EndFunction
Function WinControlInsertText(id As Integer, i$ As String)
i As Integer
ok As Boolean
v$ As String
oldLen As Integer
newLen As Integer
oldLen = Len(ctrl(id).value)
winFocus.validate = 1
If winFocus.cursor = 0 Then v$ = i$
For i = 1 To oldLen
ok = 1
If i >= winFocus.selStart And i < (winFocus.selStart + winFocus.selLength) Then ok = 0
If ok Then v$ = v$ + Mid$(ctrl(id).value, i)
If i = winFocus.cursor And i$ <> "" Then v$ = v$ + i$
Next i
ctrl(id).value = v$
If ctrl(id).maxLength > 0
If Len(ctrl(id).value) > ctrl(id).maxLength
ctrl(id).value = Left$(ctrl(id).value, ctrl(id).maxLength)
EndIf
EndIf
newLen = Len(v$)
If newLen < oldLen And winFocus.cursor > winFocus.selStart
Dec winFocus.cursor, oldLen - newLen
Else
If i$ <> "" Then Inc winFocus.cursor
EndIf
WinControlCheckCursor(id, 0)
WinControlResetSel()
EndFunction
Function WinCount()
rv As Integer
rv = Array Count(win())
EndFunction rv
Function WinControlCount()
rv As Integer
rv = Array Count(ctrl())
EndFunction rv
Function WinControlText(id As Integer, start As Integer, txt As String)
maxLength As Integer
rv As String
ok As Boolean
i As Integer
If start <= 0 Then start = 1
maxLength = Len(txt)
If Text Width(txt) >= ctrl(id).width
i = start
While Not ok
If Text Width(rv + Mid$(txt, i)) < ctrl(id).width
rv = rv + Mid$(txt, i)
Inc i
If i > maxLength Then ok = 1
Else
ok = 1
EndIf
EndWhile
Else
rv = txt
EndIf
EndFunction rv
Function WinControlStartIndex(id As Integer)
maxLength As Integer
rv As Integer
value As String
i As Integer
ok As Boolean
maxLength = Len(ctrl(id).value)
If Text Width(ctrl(id).value) < ctrl(id).width Or maxLength <= 1
rv = 0
Else
rv = winFocus.cursor + 1
While Not ok
value = mid$(ctrl(id).value, rv - 1) + value
If Text Width(value) < ctrl(id).width
Dec rv
If rv < 1
rv = 1
ok = 1
EndIf
Else
ok = 1
EndIf
EndWhile
EndIf
EndFunction rv
Function WinControlDrawFocusText(id As Integer)
i As Integer
ch As String
tw As Integer
start As Integer
x As Integer
y As Integer
left As Integer
value As String
maxLength As Integer
start = winFocus.leftPos
left = win(ctrl(id).owner).x + win(ctrl(id).owner).margin + ctrl(id).x
y = win(ctrl(id).owner).y + win(ctrl(id).owner).margin + ctrl(id).y
value = ctrl(id).value
maxLength = Len(value)
For i = start - 1 To winFocus.rightPos
If i >= start
ch = Mid$(value, i)
tw = Text Width(ch)
If (x + tw) < ctrl(id).width
If (i < winFocus.selStart) Or (i > (winFocus.selStart + (winFocus.selLength - 1)))
Ink winColor.TextBoxText, 0
Text left + x, y, ch
Inc x, tw
Else
Ink winColor.Highlight, 0
Box left + x, y, left + x + tw, y + 20
Ink winColor.HighlightText, 0
Text left + x, y, ch
Inc x, tw
EndIf
EndIf
EndIf
If i = winFocus.cursor
If winFocus.blinkCounter < 20
Ink 0, 0
Line left + x, y, left + x, y + 20
Else
If winFocus.blinkCounter >= 40 Then winFocus.blinkCounter = 0
EndIf
EndIf
Next i
EndFunction
Function WinControlResetSel()
winFocus.selStart = 0
winFocus.selLength = 0
winFocus.selAction = 0
EndFunction
Function CreateWin(name As String, x As Integer, y As Integer, width As Integer, height As Integer)
newWin As WinObj
rv As Integer
newWin.name = name
newWin.x = x
newWin.y = y
newWin.width = width
newWin.height = height
newWin.margin = 4
newWin.drawOrder = 0
newWin.mouseOut = 0
newWin.mouseOutCtr = 0
Array Insert At Bottom win()
win() = newWin
rv = WinCount()
EndFunction rv
Function CreateWinControl(name As String, owner As Integer, ctrlType As Integer, x As Integer, y As Integer, width As Integer, value As String)
newControl As WinControl
rv As Integer
newControl.name = name
newControl.owner = owner
newControl.ctrlType = ctrlType
newControl.x = x
newControl.y = y
newControl.width = width
newControl.height = 12
newControl.value = value
newControl.enabled = 1
newControl.listIndex = 0
newControl.listTop = 0
newControl.maxLength = 0
newControl.validate = 0
Array Insert At Bottom ctrl()
ctrl() = newControl
rv = WinControlCount()
EndFunction rv
Function GetWinIndex(name As String)
i As Integer
rv As Integer
ctr As Integer
ctr = WinCount()
While i < ctr And rv = 0
Inc i
If win(i).name = name Then rv = i
EndWhile
EndFunction rv
Function GetWinControlIndex(winName As String, name As String)
i As Integer
rv As Integer
ctr As Integer
ctr = WinControlCount()
winId = GetWinIndex(winName)
While i < ctr And rv = 0
Inc i
If ctrl(i).name = name And ctrl(i).owner = winId Then rv = i
EndWhile
EndFunction rv
Function SetWinControlValue(winName As String, name As String, value As String)
i As Integer
i = GetWinControlIndex(winName, name)
If i > 0 Then ctrl(i).value = value
If ctrl(i).maxLength > 0
If Len(ctrl(i).value) > ctrl(i).maxLength
ctrl(i).value = Left$(ctrl(i).value, ctrl(i).maxLength)
EndIf
EndIf
EndFunction
Function GetWinControlValue(winName As String, name As String)
i As Integer
rv As String
i = GetWinControlIndex(winName, name)
If i > 0
If ctrl(i).ctrlType <> ctrlTypes.ListBox
rv = ctrl(i).value
Else
rv = GetItem(ctrl(i).listIndex, ctrl(i).value, "\")
EndIf
EndIf
EndFunction rv
Function DeleteWin(winId As Integer)
i As Integer
ctr As Integer
ctr = WinControlCount()
For i = ctr To 1 Step - 1
If ctrl(i).owner > winId
Dec ctrl(i).owner
Else
If ctrl(i).owner = winId Then DeleteWinControl(i)
EndIf
Next i
Array Delete Element win(), winId
EndFunction
Function DeleteWinControl(id As Integer)
Array Delete Element ctrl(), id
If winFocus.id > 0 Then WinControlValidated()
EndFunction
Function CountItems(anyStr As String, delim As String)
rv As Integer
i As Integer
rv = 1
For i = 1 To Len(anyStr)
If Mid$(anyStr, i) = delim Then Inc rv
Next i
EndFunction rv
Function GetItem(index As Integer, anyStr As String, delim As String)
rv As String
cur As Integer
cur = 1
i As Integer
i = 1
While cur <= index And i <= Len(anyStr)
If Mid$(anyStr, i) = delim
Inc cur
Else
If cur = index Then rv = rv + Mid$(anyStr, i)
EndIf
Inc i
EndWhile
EndFunction rv
Function ListIndexEnsureVisible(listBoxIndex As Integer)
listCount As Integer
totalLines As Integer
curTop As Integer
curIndex As Integer
listCount = CountItems(ctrl(listBoxIndex).value, "\")
If ctrl(listBoxIndex).listTop <= 0 Then ctrl(listBoxIndex).listTop = 1
totalLines = GetListBoxLineCount(listBoxIndex)
curTop = ctrl(listBoxIndex).listTop
curIndex = ctrl(listBoxIndex).listIndex
If curIndex > 0
If curIndex < curTop
curTop = curIndex
Else
If curIndex > (curTop + totalLines)
curTop = curIndex - totalLines
If curTop <= 0 Then curTop = 1
EndIf
EndIf
EndIf
ctrl(listBoxIndex).listTop = curTop
EndFunction
Function GetListBoxLineCount(listBoxIndex As Integer)
totalLines As Integer
curHeight As Integer
lineHeight As Integer
lineHeight = Text Height("H")
If lineHeight = 0 Then lineHeight = 1
While curHeight < ctrl(listBoxIndex).height
Inc curHeight, lineHeight
If curHeight < ctrl(listBoxIndex).height Then Inc totalLines
EndWhile
EndFunction totalLines