inspired by some questions about Multi-Column-Combobox implementation I figured out this piece of code.
The comments in the code explains a little about the functionality
In addition to the windows standard version, the example also shows three exemplary extensions.
The solution is based on the subclassing and ownerdrawing functionality, which, however, requires a newer Comctl32.dll.
Already available with PB6.12
I dont want forget to say thanks to breeze4me for the stuff araound COMBOBOXINFO.
Have fun.
Code: Select all
;/=====================================================================================================================
;|
;| File : AdvancedComboBox.pbi
;|
;| Purpose : Extended Features based on the Windows Standard ComboBox with OwnerDrawing and Subclassing.
;|
;| License : MIT
;|
;| Thanks to breeze4me for the stuff araound COMBOBOXINFO.
;|
;| Copyright by Axolotl - All rights reserved.
;|
;\---------------------------------------------------------------------------------------------------------------------
CompilerIf #PB_Compiler_IsMainFile
EnableExplicit
; DebugLevel 9 ; show all debug messages ?
Enumeration EWindow 1
#WND_Main
EndEnumeration
Enumeration EGadget 1
#GDT_strInfo
#GDT_strValues
#GDT_strZipCodes
#GDT_strSingleColumn
#GDT_strStandard
#GDT_strResult
;
#GDT_cbbValues
#GDT_cbbZipCodes ; of Florida ... why not!
#GDT_cbbSingleColumn ; single column, but owner drawn
#GDT_cbbStandard ; standard combobox, no owner drawn
EndEnumeration
#MainCaption$ = "Advanced ComboBox by Axolotl ..."
CompilerEndIf
; Windows Only Note
;
CompilerIf #PB_Compiler_OS <> #PB_OS_Windows
CompilerError "Only Windows is supported, sorry."
CompilerEndIf
; --- Advanced Combobox Helper Constants and Structures ---------------------------------------------------------------
#CB_GETCOMBOBOXINFO = 356
Structure COMBOBOXINFO Align #PB_Structure_AlignC
cbSize.l
rcItem.RECT
rcButton.RECT
stateButton.l
hwndCombo.i
hwndItem.i
hwndList.i
EndStructure
; --- AdvancedComboBoxData .. new user defined Structure -------------------------------------------------------------
;
Structure TAdvancedComboBoxData
Separator$ ; i.e. #LF$, |, etc.
Style.i ; store some flags for the appearance
DeviderColor.i ;
AlternateLineColor.i ; == $FFF8F0 ; AliceBlue <-- my fav color.
ListWndWidth.i ; for the listbox of the combobox
Array Columns.i(0) ; width of the columns (kind of)
EditBoxMask.i ; binary values .. displays columns in edit box if bit is set !!!
; tbc.
EndStructure
; ---------------------------------------------------------------------------------------------------------------------
EnumerationBinary EAdvCbbStyle
#AdvCbbStyle_AlternateBkColors ;
#AdvCbbStyle_VerticalDivider ;
#AdvCbbStyle_FocusRect ;
; #AdvCbbStyle_
EndEnumeration ; EAdvComboBox
;/---------------------------------------------------------------------------------------------------------------------
;|
;| Subclassing -- recommended by M$ for future implementations
;|
;| INFO: Using the PureBasic Syntax (Windows API procedures using trailing underscore)
;|
;|
;\---
Import "Comctl32.lib" ;{ <<< from (latest) Comctl32.dll >>>
; use the PureBasic Syntax (Windows API procedures using trailing underscore)
;
CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
SetWindowSubclass_(hWnd, *fnSubclass, uIdSubclass, dwRefData) As "SetWindowSubclass"
GetWindowSubclass_(hWnd, *fnSubclass, uIdSubclass, *dwRefData) As "GetWindowSubclass"
RemoveWindowSubclass_(hWnd, *fnSubclass, uIdSubclass) As "RemoveWindowSubclass"
DefSubclassProc_(hWnd, uMsg, wParam, lParam) As "DefSubclassProc"
CompilerElse
SetWindowSubclass_(hWnd, *fnSubclass, uIdSubclass, dwRefData) As "_SetWindowSubclass@16"
GetWindowSubclass_(hWnd, *fnSubclass, uIdSubclass, *dwRefData) As "_GetWindowSubclass@16"
RemoveWindowSubclass_(hWnd, *fnSubclass, uIdSubclass) As "_RemoveWindowSubclass@12"
DefSubclassProc_(hWnd, uMsg, wParam, lParam) As "_DefSubclassProc@16"
CompilerEndIf
EndImport ;} <<< "Comctl32.lib" ; from (latest) Comctl32.dll >>>
;/---------------------------------------------------------------------------------------------------------------------
;|
;| AdvancedComboBoxGadget()
;|
;| extends the standard ComboBoxGadget() with some nice features.
;| 1. Greater width of the Listbox
;| 2. Alternate background color of lines
;| 3. Show ellipse char, if text does not fit in the listbox width
;| 4. columns in listbox (can be visible or not in editbox)
;| 5. tbc.
;|
;|
;| Parameter:
;|
;| Gadget .. Number of the Gadget or #PB_Any (as standard)
;| X, Y, W, H .. Pos and size of the Gadgt (as standard)
;| ListWndWidth .. Width of the listbox window
;| Sep$ .. Separates Columns e.g. #LF$
;| ColumnPos$ .. Start Position of each Column e.g. "60,120,120,"
;| EditBoxMask .. binary value e.g. $01 = Column 0, $02 = Column 1, etc. or $03 = Column 0 and Column 1
;|
;| Return Value:
;|
;| Number or Handle of Gadget on success else ZERO (as standard)
;|
;\---
Procedure AdvancedComboBoxPerformSubclass(hWnd, uMsg, wParam, lParam, uIdSubclass, dwRefData)
Protected result, hBrush, hPen, oldPen, *lpdis.DRAWITEMSTRUCT
Protected text$, t$, sep$, tlen, nn, dtFlags
Protected cbinfo.COMBOBOXINFO, rt.RECT ; resize the list of the combobox
Protected *aCbbD.TAdvancedComboBoxData
Select uMsg
Case #WM_NCDESTROY : Debug "WM_NCDESTROY"
RemoveWindowSubclass_(hWnd, @AdvancedComboBoxPerformSubclass(), uIdSubclass)
*aCbbD = dwRefData
If *aCbbD
FreeStructure(*aCbbD) : Debug " Free Structure " + *aCbbD
EndIf
Case #WM_DRAWITEM
*lpdis = lParam
; control type is combobox and Subclass ID is correct (== Gadget)
;
If *lpdis\CtlType = #ODT_COMBOBOX And wParam = uIdSubclass
; Change the listbox size of the combobox
;
If IsGadget(WParam) And GadgetType(WParam) = #PB_GadgetType_ComboBox
cbinfo\cbSize = SizeOf(COMBOBOXINFO)
SendMessage_(GadgetID(WParam), #CB_GETCOMBOBOXINFO, 0, @cbinfo)
; special settings stored in structure and forwarded by dwRefData (pointer)
;
*aCbbD = dwRefData
; set the new listbox window width
;
If cbinfo\hwndList
GetWindowRect_(cbinfo\hwndList, rt)
MoveWindow_(cbinfo\hwndList, rt\left, rt\top, DesktopScaledX(*aCbbD\ListWndWidth), rt\bottom - rt\top, 0)
EndIf
EndIf ; IsGadget() ...
SetBkMode_(*lpdis\hDC, #TRANSPARENT) ; Text is rendered transparent
If *lpdis\ItemState & #ODS_FOCUS
hBrush = GetSysColorBrush_(#COLOR_HIGHLIGHT) ; returns a cached brush instead of allocating a new one
FillRect_(*lpdis\hDC, *lpdis\rcItem, hBrush)
SetTextColor_(*lpdis\hDC, GetSysColor_(#COLOR_HIGHLIGHTTEXT)) ; windows default
If *aCbbD\Style & #AdvCbbStyle_FocusRect ; ?
DrawFocusRect_(*lpdis\hDC, *lpdis\rcItem)
EndIf
Else ; *lpdis\ItemState & #ODS_FOCUS
; Fill the background color differently for odd and even lines, but not in edit box
;
If *aCbbD\Style & #AdvCbbStyle_AlternateBkColors And *lpdis\itemState & #ODS_COMBOBOXEDIT = 0
If *lpdis\itemID & 1 ; % 2 ; .. even or odd ??
hBrush = GetSysColorBrush_(#COLOR_WINDOW) ; this is borrowed from system, destroying is not needed.
FillRect_(*lpdis\hDC, *lpdis\rcItem, hBrush)
Else
hBrush = CreateSolidBrush_(*aCbbD\AlternateLineColor)
FillRect_(*lpdis\hDC, *lpdis\rcItem, hBrush)
DeleteObject_(hBrush) ; here we need to destroy the created brush
EndIf
Else ; only standard background
hBrush = GetSysColorBrush_(#COLOR_WINDOW) ; this is borrowed from system, destroying is not needed.
FillRect_(*lpdis\hDC, *lpdis\rcItem, hBrush)
EndIf
SetTextColor_(*lpdis\hDC, GetSysColor_(#COLOR_WINDOWTEXT)) ; windows system setting
EndIf ; *lpdis\ItemState & #ODS_FOCUS
If *lpdis\itemID <> -1
tlen = SendMessage_(*lpdis\hwndItem, #CB_GETLBTEXTLEN, *lpdis\itemID, 0) ; lParam .. not used
If tlen > 0
text$ = Space(tlen)
If SendMessage_(*lpdis\hwndItem, #CB_GETLBTEXT, *lpdis\itemID, @text$) = #CB_ERR
Debug "ERROR: Invalid Index."
EndIf
EndIf
dtFlags = #DT_LEFT | #DT_VCENTER | #DT_END_ELLIPSIS ; set drawtext_() flags
If text$
; special behavior on Combobox Edit Field, else is Combobox Listbox window .....
;
If *lpdis\itemState & #ODS_COMBOBOXEDIT
t$ = ""
For nn = 0 To ArraySize(*aCbbD\Columns()) - 1
If *aCbbD\EditBoxMask & (1 << nn) ; <-- show this Column text ???
t$ + StringField(text$, nn + 1, *aCbbD\Separator$) + " "
EndIf
Next nn
t$ = RTrim(t$) ; remove trailing spaces
If t$
*lpdis\rcItem\left + 4 ; little left margin
DrawText_(*lpdis\hdc, t$, Len(t$), *lpdis\rcItem, dtFlags)
EndIf
Else ; *lpdis\itemState & #ODS_COMBOBOXEDIT
; Combobox Listbox draw Column 0
;
t$ = StringField(text$, 1, *aCbbD\Separator$)
If t$
*lpdis\rcItem\left + 4 ; little left margin
DrawText_(*lpdis\hdc, t$, Len(t$), *lpdis\rcItem, dtFlags)
EndIf
; Combobox Listbox draw Column 1 to Column N
;
For nn = 0 To ArraySize(*aCbbD\Columns()) - 1
t$ = StringField(text$, nn + 2, *aCbbD\Separator$)
If t$
*lpdis\rcItem\left + DesktopScaledX(*aCbbD\Columns(nn))
; Draw a vertical divider for the column.
;
If *aCbbD\Style & #AdvCbbStyle_VerticalDivider
hPen = CreatePen_(#PS_SOLID, 1, *aCbbD\DeviderColor)
If hPen
oldPen = SelectObject_(*lpdis\hdc, hPen)
MoveToEx_(*lpdis\hdc, *lpdis\rcItem\left - 4, *lpdis\rcItem\top, 0)
LineTo_(*lpdis\hdc, *lpdis\rcItem\left - 4, *lpdis\rcItem\bottom)
SelectObject_(*lpdis\hdc, oldPen)
DeleteObject_(hPen)
EndIf ; hPen
EndIf ; *aCbbD\Style & #AdvCbbStyle_VerticalDivider
DrawText_(*lpdis\hdc, t$, Len(t$), *lpdis\rcItem, dtFlags)
EndIf ; t$
Next nn
EndIf ; *lpdis\itemState & #ODS_COMBOBOXEDIT
EndIf ; text$
EndIf
EndIf ; .... control type is combobox
; ProcedureReturn result
EndSelect
ProcedureReturn DefSubclassProc_(hWnd, uMsg, wParam, lParam)
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure AdvancedComboBoxGadget(Gadget, X, Y, W, H, ListWndWidth, Sep$, ColumnPos$, EditBoxMask=$01); Style=0, Color=#PB_Default)
Protected result, index, columns, def, hwnd, t$
Protected *aCbbD.TAdvancedComboBoxData
result = ComboBoxGadget(Gadget, X, Y, W, H, #CBS_HASSTRINGS | #CBS_OWNERDRAWFIXED)
If result
If Gadget = #PB_Any ; deal with dynamic gadget numbers
Gadget = result
EndIf
SendMessage_(GadgetID(Gadget), #CB_SETITEMHEIGHT, 0, DesktopScaledY(GadgetHeight(Gadget) - 2))
*aCbbD = AllocateStructure(TAdvancedComboBoxData) ; make config data structure
If *aCbbD
*aCbbD\Separator$ = Sep$
*aCbbD\ListWndWidth = ListWndWidth
If EditBoxMask
*aCbbD\EditBoxMask = EditBoxMask
Else
*aCbbD\EditBoxMask = $0001 ; default -> column 0 is shown in edit box
EndIf
columns = CountString(ColumnPos$, ",") ; how many columns do we create ?
If Right(ColumnPos$, 1) <> "," : columns + 1 : EndIf ; don't forget the last item
If columns
def = ListWndWidth / columns ; divide total width into columns
Else
; one column only
columns = 1
def = ListWndWidth ; column is the entire width
EndIf
Dim *aCbbD\Columns(columns) ; create the array of columns position
For index = 0 To columns
t$ = StringField(ColumnPos$, index + 1, ",")
If t$
*aCbbD\Columns(index) = Val(t$)
Else
*aCbbD\Columns(index) = def ; not enough values in the string
EndIf
Next index
; Vertical Devider is only this color
;
*aCbbD\DeviderColor = $BBBBBB ; default color (kind of grey)
hwnd = GetAncestor_(GadgetID(Gadget), #GA_ROOTOWNER) ;
Debug "# "+#PB_Compiler_Procedure+"() Pointer == " + *aCbbD, 9
SetWindowSubclass_(hwnd, @AdvancedComboBoxPerformSubclass(), Gadget, *aCbbD)
EndIf ; *aCbbD
EndIf ; result
ProcedureReturn result
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure SetAdvancedComboBoxGadgetStyle(Gadget, Style, Color=#PB_Default)
Protected *aCbbD.TAdvancedComboBoxData, hwnd
If IsGadget(Gadget) ; Gadget with this number is a valid and correctly initialized gadget
hwnd = GetAncestor_(GadgetID(Gadget), #GA_ROOTOWNER)
If GetWindowSubclass_(hwnd, @AdvancedComboBoxPerformSubclass(), Gadget, @*aCbbD) And *aCbbD
Debug "# "+#PB_Compiler_Procedure+"() Pointer == " + *aCbbD, 9
*aCbbD\Style | Style ; add style
If Style & #AdvCbbStyle_AlternateBkColors
If Color = #PB_Default
*aCbbD\AlternateLineColor = $FFF8F0 ; AliceBlue <-- my fav color.
Else
*aCbbD\AlternateLineColor = Color
EndIf
EndIf
; If style & #AdvCbbStyle_VerticalDivider
; If Color = #PB_Default
; *aCbbD\DeviderColor = $BBBBBB ; default color (kind of grey)
; Else
; *aCbbD\DeviderColor = Color
; EndIf
; EndIf
ProcedureReturn #True
EndIf ; GetWindowSubclass_() And *aCbbD
EndIf ; IsGadget()
ProcedureReturn #False
EndProcedure
;----------------------------------------------------------------------------------------------------------------------
; ■ Test Application
; ---------------------------------------------------------------------------------------------------------------------
CompilerIf #PB_Compiler_IsMainFile ;-{ [..] Test Application
Procedure OpenMainWindow(WndW=496, WndH=104)
Protected wFlags
wFlags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_Invisible ; | #PB_Window_SizeGadget
If OpenWindow(#WND_Main, 0, 0, WndW, WndH, #MainCaption$, wFlags)
; Helper String Gadgets
;
StringGadget(#GDT_strStandard, 8, 8, 104, 20, "Standard", #PB_String_ReadOnly)
StringGadget(#GDT_strValues, 128, 8, 80, 20, "Values", #PB_String_ReadOnly)
StringGadget(#GDT_strZipCodes, 232, 8, 128, 20, "Zip Codes", #PB_String_ReadOnly)
StringGadget(#GDT_strSingleColumn, 384, 8, 104, 20, "Single Column", #PB_String_ReadOnly)
StringGadget(#PB_Any, 8, 64, 96, 20, "Selection ==>", #PB_String_ReadOnly)
StringGadget(#GDT_strResult, 104, 64, 384, 20, "", #PB_String_ReadOnly)
; 1. Standard Combobox, nothing advanced
;
ComboBoxGadget(#GDT_cbbStandard, 8, 32, 104, 21)
; 2. Advanced Combobox, owner drawn
;
AdvancedComboBoxGadget(#GDT_cbbValues, 128, 32, 80, 21, 200, #LF$, "60")
SetAdvancedComboBoxGadgetStyle(#GDT_cbbValues, #AdvCbbStyle_VerticalDivider)
; 3. Advanced Combobox, owner drawn
;
AdvancedComboBoxGadget(#GDT_cbbZipCodes, 232, 32, 128, 21, 400, #LF$, "60,120,120", 3)
SetAdvancedComboBoxGadgetStyle(#GDT_cbbZipCodes, #AdvCbbStyle_AlternateBkColors, $FFFFF0) ; Azure
SetAdvancedComboBoxGadgetStyle(#GDT_cbbZipCodes, #AdvCbbStyle_VerticalDivider)
; 4. Advanced Combobox, no columns
;
AdvancedComboBoxGadget(#GDT_cbbSingleColumn, 384, 32, 104, 21, 176, "", "") ; single column, but owner drawn
; SetAdvancedComboBoxGadgetStyle(#GDT_cbbSingleColumn, #AdvCbbStyle_AlternateBkColors)
SetAdvancedComboBoxGadgetStyle(#GDT_cbbSingleColumn, #AdvCbbStyle_AlternateBkColors, $CDFAFF) ; Lemonchiffon
; HideWindow(#WND_Main, 0) ; show window now (after all the hard work is done.
ProcedureReturn #True ; successfully created
EndIf
ProcedureReturn #False ; something went wrong (failure)
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure Main()
Protected index, text$
If OpenMainWindow()
; fill some sample data ....
;
If IsGadget(#GDT_cbbValues)
; AddGadgetItem(#GDT_cbbValues, -1, "STK none" + #LF$ + " ")
AddGadgetItem(#GDT_cbbValues, -1, "STK 001" + #LF$ + "PINEAPPLE")
AddGadgetItem(#GDT_cbbValues, -1, "STK 002" + #LF$ + "BANANA")
AddGadgetItem(#GDT_cbbValues, -1, "STK 003" + #LF$ + "DRAGON FRUIT")
AddGadgetItem(#GDT_cbbValues, -1, "STK 004" + #LF$ + "STAR FRUIT")
AddGadgetItem(#GDT_cbbValues, -1, "STK 005" + #LF$ + "MANGO")
AddGadgetItem(#GDT_cbbValues, -1, "STK 006" + #LF$ + "RAMBUTAN")
AddGadgetItem(#GDT_cbbValues, -1, "STK 007" + #LF$ + "WATERMELON")
AddGadgetItem(#GDT_cbbValues, -1, "STK 008" + #LF$ + "POMEGRANATE")
AddGadgetItem(#GDT_cbbValues, -1, "STK 009" + #LF$ + "LYCHEE")
AddGadgetItem(#GDT_cbbValues, -1, "STK 010" + #LF$ + "MANGOSTEEN")
AddGadgetItem(#GDT_cbbValues, -1, "STK 011" + #LF$ + "TAMARIND")
AddGadgetItem(#GDT_cbbValues, -1, "STK 012" + #LF$ + "PASSION FRUIT")
AddGadgetItem(#GDT_cbbValues, -1, "STK 013" + #LF$ + "PAPAYA")
EndIf
; Copied from https://www.zip-codes.com/state/fl.asp
; ZIP Code LF City LF County LF Type
;
If IsGadget(#GDT_cbbZipCodes)
AddGadgetItem(#GDT_cbbZipCodes, -1, "32003" + #LF$ + "Fleming Island" + #LF$ + "Clay" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32004" + #LF$ + "Ponte Vedra Beach" + #LF$ + "Saint Johns" + #LF$ + "P.O. Box")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32006" + #LF$ + "Fleming Island" + #LF$ + "Clay" + #LF$ + "P.O. Box")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32007" + #LF$ + "Bostwick" + #LF$ + "Putnam" + #LF$ + "P.O. Box")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32008" + #LF$ + "Branford" + #LF$ + "Suwannee" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32009" + #LF$ + "Bryceville" + #LF$ + "Nassau" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32011" + #LF$ + "Callahan" + #LF$ + "Nassau" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32013" + #LF$ + "Day" + #LF$ + "Lafayette" + #LF$ + "P.O. Box")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32024" + #LF$ + "Lake City" + #LF$ + "Columbia" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32025" + #LF$ + "Lake City" + #LF$ + "Columbia" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32030" + #LF$ + "Doctors Inlet" + #LF$ + "Clay" + #LF$ + "P.O. Box")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32033" + #LF$ + "Elkton" + #LF$ + "Saint Johns" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32034" + #LF$ + "Fernandina Beach" + #LF$ + "Nassau" + #LF$ + "Standard")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32035" + #LF$ + "Fernandina Beach" + #LF$ + "Nassau" + #LF$ + "P.O. Box")
AddGadgetItem(#GDT_cbbZipCodes, -1, "32038" + #LF$ + "Fort White" + #LF$ + "Columbia" + #LF$ + "Standard")
EndIf
; HINT: Text is longer than the width of the gadget, to display the different appearance ....
;
For index = 0 To 80
If IsGadget(#GDT_cbbSingleColumn)
AddGadgetItem(#GDT_cbbSingleColumn, -1, RSet(Str(index), 4) + ". Text with no columns" + StringField(":, but sometimes very long texts.", 1+Random(1), ":"))
EndIf
If IsGadget(#GDT_cbbStandard)
AddGadgetItem(#GDT_cbbStandard, -1, RSet(Str(index), 4) + ". Text with no columns ")
EndIf
Next index
HideWindow(#WND_Main, 0) ; show window now (after all the hard work is done.
; main loop
;
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break ; bye
Case #PB_Event_Gadget
Select EventGadget()
Case #GDT_cbbValues
text$ = GetGadgetText(#GDT_cbbValues)
SetGadgetText(#GDT_strResult, StringField(text$, 1, #LF$))
Case #GDT_cbbZipCodes
text$ = GetGadgetText(#GDT_cbbZipCodes)
SetGadgetText(#GDT_strResult, StringField(text$, 1, #LF$) + " " + StringField(text$, 2, #LF$))
Case #GDT_cbbSingleColumn
text$ = GetGadgetText(#GDT_cbbSingleColumn)
SetGadgetText(#GDT_strResult, text$)
Case #GDT_cbbStandard
text$ = GetGadgetText(#GDT_cbbStandard)
SetGadgetText(#GDT_strResult, text$)
EndSelect
EndSelect
ForEver
EndIf
ProcedureReturn 0
EndProcedure
End Main()
CompilerEndIf ;} End of Test Application