How to use Treeview control

[billhsln]

I have tried to compile TreevCopy, the Tree View Drag demo written by Sapero.  I get lots of errors.  I have looked for a copy of 'controlpk.incc', which I do not find on my system.  I do find a 'controlpak.incc', which says it is version 1.3.  It would be nice if I could get the program to compile correctly, but what I really would need is a simpler program that basically shows how Treeview's work.  I want to create a program to scan thru the subdirectories of your hard drive and return number of files and total file size per directory.  I just don't understand how treeview works.

Thanks,
Bill

[LarryMc]

Treeviews are controls used to display information.
It is totally up to the user to determine what is to be displayed and to fill the treeview in.

In windows explorer a treeview is used to display the computers folders.

In my Snippett Manager I used a treeview to display entries in a database and one to display results of a search (both of which had nothing to do with directories.

I want to create a program to scan thru the subdirectories of your hard drive and return number of files and total file size per directory.  I just don't understand how treeview works.

based upon that statement you need to be looking at the file and dir commands in IWB.
This will give you a place to start:

Code Select Expand

DEF count:INT

OPENCONSOLE
'recursively print all directories
count = printdir("c:\\")
PRINT count,"Files"
PRINT "Press Any Key"
DO:UNTIL INKEY$ <> ""
CLOSECONSOLE
END


SUB printdir(path:STRING),INT
DEF count:INT
DEF dir,attrib:INT
DEF filename:STRING
DEF fullname:STRING
count = 0
dir = FINDOPEN(path + "*.*")
IF(dir)
DO
filename = FINDNEXT(dir,attrib)
IF len(filename)
IF attrib & @FILE_DIRECTORY
IF(filename <> ".") & (filename <> "..")
PRINT path + "[" + filename + "]"
fullname = path + filename + "\\"
count = count + printdir(fullname)
ENDIF
ELSE
                count = count + 1
PRINT path + filename
ENDIF
ENDIF
'the exit case is when there are no more entries
'in the current directory
UNTIL filename = ""
FINDCLOSE dir
ENDIF
RETURN count
ENDSUB

This is a treedemo that you can easily see how entries are added to a treeview.

Code Select Expand

' IBasic Pro Treeview/Tab Control demo
' -= ZD =-
def win,tvwin,TabOneWin,TabTwoWin:WINDOW
def run:INT
def l,t,w,h,x,y:INT
def CurrentTab:INT
TYPE RECTSTRUCT
   def l:INT
   def t:INT
   def w:INT
   DEF h:INT
endtype
DEF tabRECT:RECTSTRUCT
type Tab_Control
   def mask:int
   def reserved1:int
   def reserved2:int
   def pszText:pointer
   def cchTextMax:int
   def iImage:int
   def lParam:int
endtype
def TabSTRUCT:Tab_Control
def TabHwnd:int  :' <<<< Note: Try putting this before the previous DEF statement ... the tab windows don't show up (?????)
CONST TV_FIRST = 0x1100
CONST TVS_CHECKBOXES = 0x100
CONST TVM_SETBKCOLOR = (TV_FIRST + 29)
CONST TVM_SETLINECOLOR = (TV_FIRST + 40)
CONST TVM_SETTEXTCOLOR = (TV_FIRST + 30)
CONST TCM_FIRST = 0x1300
CONST TCM_INSERTITEMA = (TCM_FIRST + 7)
CONST TCM_SETITEMA = (TCM_FIRST + 6)
CONST TCM_ADJUSTRECT = (TCM_FIRST + 40)
CONST TCS_BOTTOM = 0x2
CONST TCN_FIRST = -550
CONST TCN_SELCHANGE = (TCN_FIRST - 1)
OPENWINDOW win,0,0,600,400,@MINBOX|@MAXBOX|@SIZE,0,"Treeview / Tab Control Demo",&winproc
GOSUB SetupWindow
run=1
waituntil run=0
closewindow win
end
SUB winproc
   SELECT  @CLASS
      CASE @IDCLOSEWINDOW
         run=0
      CASE @IDCREATE
         CENTERWINDOW win
     
      CASE @IDMENUPICK     
         IF @MENUNUM=1 then run=0
      CASE @IDSIZE
         GETCLIENTSIZE win,l,t,w,x
         GETSIZE tvwin,l,t,w,h
         SETSIZE tvwin,-25,-25,w,x-25
         GETCLIENTSIZE win,l,t,w,h
         GETCLIENTSIZE tvwin,l,t,w,x
         SETSIZE tvwin,l+22,t+22,w-22,h,1
         getsize tvwin,l,t,w,h
         getclientsize win,l,t,x,h
         SETSIZE win,w-25, t, x-w+25, h,1
         GETSIZE win,l,t,w,h,1
         TabRECT.l=l : TabRECT.t=t : TabRECT.w=w : TabRECT.h=h
          SENDMESSAGE ( TabHwnd, TCM_ADJUSTRECT, 0, TabRECT )
         setsize TabOneWin, 5, 5, TabRECT.w-10, TabRECT.h-15
         setsize TabTwoWin, 5, 5, TabRECT.w-10, TabRECT.h-15
         GETclientSIZE TabOneWin,l,t,w,h
         setsize TabOneWin, 0, 0, w,h,1
         setsize TabTwoWin, 0, 0, w,h,1
         if CurrentTab=0
            Showwindow TabOneWin,@SWRESTORE
            Showwindow TabTwoWin,@SWHIDE
         else
            Showwindow TabOneWin,@SWHIDE
            Showwindow TabTwoWin,@SWRESTORE
         endif
     
         CASE @IDCONTROL
            IF @CONTROLID = 1
               if @NOTIFYCODE = TCN_SELCHANGE
                  if CurrentTab=0
                     CurrentTab=1
                     Showwindow TabOneWin,@SWHIDE
                     Showwindow TabTwoWin,@SWRESTORE
                  else
                     CurrentTab=0
                     Showwindow TabOneWin,@SWRESTORE
                     Showwindow TabTwoWin,@SWHIDE
                  endif
               endif
            ENDIF
   ENDSELECT
RETURN
ENDSUB
SUB tvwinproc
   SELECT  @CLASS
      CASE @IDSIZE
         GETCLIENTSIZE win,l,t,x,h
         GETSIZE tvwin,l,t,w,h
         if w<=149
            GETCLIENTSIZE win,l,t,w,h
            w=150
            SETSIZE tvwin,-25,-25,w,h+50
            GOTO JumpPoint
         endif
         if w>x/2
            GETCLIENTSIZE win,l,t,w,h
            w=x/2
            SETSIZE tvwin,-25,-25,w,h+50
            GOTO JumpPoint
         endif
         GETCLIENTSIZE win,l,t,x,h
         setsize tvwin,-25,-25,w,h+50
         LABEL JumpPoint
         GETCLIENTSIZE win,l,t,w,h
         GETCLIENTSIZE tvwin,l,t,w,x
         SETSIZE tvwin,l+22,t+22,w-22,h,1
         getsize tvwin,l,t,w,h
         getclientsize win,l,t,x,h
         SETSIZE win,w-25, t, x-w+25, h,1
         GETSIZE win,l,t,w,h,1
         TabRECT.l=l : TabRECT.t=t : TabRECT.w=w : TabRECT.h=h
          SENDMESSAGE ( TabHwnd, TCM_ADJUSTRECT, 0, TabRECT )
         setsize TabOneWin, 5, 5, TabRECT.w-10, TabRECT.h-15
         setsize TabTwoWin, 5, 5, TabRECT.w-10, TabRECT.h-15
         GETclientSIZE TabOneWin,l,t,w,h
         setsize TabOneWin, 0, 0, w,h,1
         setsize TabTwoWin, 0, 0, w,h,1
         if CurrentTab=0
            Showwindow TabOneWin,@SWRESTORE
            Showwindow TabTwoWin,@SWHIDE
         else
            Showwindow TabOneWin,@SWHIDE
            Showwindow TabTwoWin,@SWRESTORE
         endif
   ENDSELECT
RETURN
ENDSUB
SUB SetupWindow
   BEGINMENU win
      MENUTITLE "&File"
         MENUITEM "Quit",0,1
   ENDMENU
   setwindowcolor win,0
   GETCLIENTSIZE win,l,t,w,h
   OPENWINDOW tvwin,-25,-25,150,h+50,@NOCAPTION|@SIZE,win,"tvwin",&tvwinproc
   GETCLIENTSIZE win,l,t,w,h
   GETCLIENTSIZE tvwin,l,t,w,x
   CONTROL tvwin,@TREEVIEW,"Libraries",l+22,t+22,w-22,h,@TVSTRACKSELECT| @TVSHASLINES|@TVSLINESATROOT|@TVSHASBUTTONS|@TVSFULLROWSELECT,1
   sendmessage TVwin,TVM_SETBKCOLOR,0,rgb(255,255,225),1
   sendmessage TVwin,TVM_SETLINECOLOR,0,rgb(0,0,0),1
   sendmessage TVwin,TVM_SETTEXTCOLOR,0,rgb(0,0,0),1
   def handle,handle2,handle3:INT
   handle2 = tvInsertItem(tvwin , 1, "Root Group 1", 0)
      handle = tvInsertItem(tvwin , 1, "Sub Group 1-1", handle2)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-1A", handle)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-1B", handle)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-1C", handle)
      handle = tvInsertItem(tvwin , 1, "Sub Group 1-2", handle2)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-2A", handle)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-2B", handle)
      handle = tvInsertItem(tvwin , 1, "Sub Group 1-3", handle2)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-3A", handle)
      handle = tvInsertItem(tvwin , 1, "Sub Group 1-4", handle2)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-4A", handle)
      handle = tvInsertItem(tvwin , 1, "Sub Group 1-5", handle2)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 1-5A", handle)
   handle2 = tvInsertItem(tvwin , 1, "Root Group 2", 0)
      handle = tvInsertItem(tvwin , 1, "Sub Group 2-1", handle2)   
         handle3 = tvInsertItem(tvwin , 1, "Single Item 2-1A", handle)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 2-1B", handle)
      handle = tvInsertItem(tvwin , 1, "Sub Group 2-2", handle2)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 2-2A", handle)
         handle3 = tvInsertItem(tvwin , 1, "Single Item 2-2B", handle)
   getsize tvwin,l,t,w,h
   getclientsize win,l,t,x,h
   TabHwnd=CONTROLEX win, "SysTabControl32", "name", w-25, t, x-w+25, h, @BORDER|TCS_BOTTOM, 0 , 1
    TabSTRUCT.mask = 1
    TabSTRUCT.pszText = " First Tab "
    TabSTRUCT.cchTextMax = len(" First Tab ")
      TabSTRUCT.iImage = -1
   SendMessage(TabHwnd, TCM_INSERTITEMA, 0, TabSTRUCT)
    TabSTRUCT.pszText = " Second Tab "
    TabSTRUCT.cchTextMax = len(" Second Tab ")
   SendMessage(TabHwnd, TCM_INSERTITEMA, 1, TabSTRUCT)
   GETSIZE win,l,t,w,h,1
   TabRECT.l=l : TabRECT.t=t : TabRECT.w=w : TabRECT.h=h
    SENDMESSAGE ( TabHwnd, TCM_ADJUSTRECT, 0, TabRECT )
   openwindow TabOneWin, 5, 5, TabRECT.w-10, TabRECT.h-15, @NOCAPTION,TabHwnd,"Tab One",&TabOneWinProc
   openwindow TabTwoWin, 5, 5, TabRECT.w-10, TabRECT.h-15, @NOCAPTION,TabHwnd,"Tab Two",&TabTwoWinProc
   GETclientsize TabOneWin,l,t,w,h
   CONTROL TabOneWin ,@EDIT, "First Tab", 0,0,w, h,@CTEDITMULTI|@VSCROLL,1
   CONTROL TabTwoWin ,@EDIT, "Second Tab", 0,0,w, h,@CTEDITMULTI|@VSCROLL,1
RETURN
ENDSUB
SUB TabOneWinProc
return
endsub
SUB TabTwoWinProc
return
endsub

And the controlpak.incc is the correct one. What I typed was a typo back then.

LarryMc

[billhsln]

Thank you, Larry.  That gives me some where to start from.  I just had no clue how the Treeview works.  Your example will give me an excellent starting point.  I already have code that will search thru subdirectories and pick a starting directory, just had no idea how to the Treeview.

Thanks,
Bill

[WayneA]

Another example, it might help. To use just open a source file with class methods. It populates a tree view with the acquired information.

Code Select Expand

/* Usage notes for Class View...
When you load a file, it will be scanned to populate the Class TreeView and Class Header RichEdit controls.
At anypoint you can populate these controls manually by clicking Scan (or Alt+S) and Get Header (or Alt+H).
When saving you can either save the source file with the header or just the header. The way this is determined
is by the extention you choose when saving. If you save the file (for example) as "CEmailer.inc" only the header
will be saved. If you save the file with any extension other then .inc, such as "CEmailer.eba" then the source
will be saved with that name and the header would be saved with the .inc extension. In our example case that
would be "CEmailer.inc"
If you save a file without an explicit extension .inc will be assumed, since this editor is useless without its header
generation I assume you wouldn't load a file only to modify the source in most instances.

When generating the class header, Class View will do its best to generate all properties but theres a decent chance
some will be skipped. Basically, any properies assigned values in the constructor and named with a leading "m_" will
be detected, all others will not. I'm confident that the type detection will be correct 80% of the time. I expect to
be proven wrong on that though.

For classes developed with this tool in mind I expect everything will workout everytime. For others the header will
definitely need tweaking.

This app has been a little over developed. It began as just a test, if this is useful to others I'll write a better
version from scratch. This will get (is already?) unwieldy and difficult to maintain if its further developed.
*/
$Include "windows.inc"
$Define NM_FIRST 0
$Define NM_CLICK NM_FIRST-2
AutoDefine "Off"
Dim wndMain As Window
Dim sFile As String
OpenWindow wndMain,0,0,450,350,@MinBox|@MaxBox|@Size,0,"Class View",&wndMainProc
'EnableTabs wndMain,True
AttachMainMenu(wndMain)
SetWindowColor wndMain,_GetSysColor(15)
WaitUntil IsWindowClosed wndMain
End

Sub wndMainProc
Dim l,t,w,h As Int
Dim i As Int
Select @Message
Case @IDCreate
CenterWindow wndMain
GetClientSize wndMain,l,t,w,h
Control wndMain,@RichEdit,"",0,0,w-w/3,h-30,@CTEditMulti|@CTEditAutoH|@CTEditAutoV|@CTEditReturn|@Border|@HScroll|@VScroll|@TabStop,1
Control wndMain,@TreeView,"",w-w/3,0,w/3,(h-30)/2,@TVSHasButtons|@TVSHasLines|@TVSLinesAtRoot|@Border|@TabStop,2
Control wndMain,@RichEdit,"",w-w/3,(h-30)/2,w/3,(h-30)/2,@CTEditMulti|@CTEditAutoH|@CTEditAutoV|@CTEditReturn|@CTEditRO|@Border|@HScroll|@VScroll|@TabStop,3
Control wndMain,@Button,"&Scan",3,h-25,90,20,@TabStop,4
Control wndMain,@Button,"Get &Header",w-93,h-25,90,20,@TabStop,5
For i=1 to 5
SetFont wndMain,"Courier New",10,400,0,i
Next i
Case @IDSize
GetClientSize wndMain,l,t,w,h
SetSize wndMain,0,0,w-w/3,h-30,1
SetSize wndMain,w-w/3,0,w/3,(h-30)/2,2
SetSize wndMain,w-w/3,(h-30)/2,w/3,(h-30)/2,3
SetSize wndMain,3,h-25,40,20,4
SetSize wndMain,w-93,h-25,90,20,5
Case @IDMenuPick
Select @MenuNum
Case 101 'File->New
sFile=""
SetCaption wndMain,"Class View"
SetControlText wndMain,1,""
tvDeleteAllItems(wndMain,2)
SetControlText wndMain,3,""
Case 102 'File->Open
sFile=FileRequest("Open EBasic source file...",wndMain,True,"EBasic files (*.eba)|*.eba|All files (*.*)|*.*||")
If sFile<>"" Then
File Open
If OpenFile(Open,sFile,"R")=0 Then
ControlCMD(wndMain,1,@RTLoad,Open,False)
CloseFile Open
SetCaption wndMain,"Class View - "+ReturnName(sFile)
tvListClassMethods(GetControlText(wndMain,1),wndMain,2)
GenClassHeader(GetControlText(wndMain,1),wndMain,3)
EndIf
EndIf
Case 103 'File->Save
Case& 104 'File->Save As...
sFile=FileRequest("Save EBasic file...",wndMain,False,"EBasic header (*.inc)|*.inc|EBasic files (*.eba)|*.eba|All files (*.*)|*.*||","inc")
If sFile<>"" Then
Int IncOnly=(Right$(sFile,3)="inc" Or Right$(sFile,4)="inc\"")
File Save
If OpenFile(Save,sFile,"W")=0 Then
ControlCMD(wndMain,IIf(IncOnly,3,1),@RTSave,Save,False)
CloseFile Save
If !IncOnly Then
If OpenFile(Save,RemoveExt(sFile)+".inc","W")=0 Then
ControlCMD(wndMain,3,@RTSave,Save,False)
CloseFile Save
EndIf
EndIf
SetCaption wndMain,"Class View - "+ReturnName(sFile)
EndIf
EndIf
Case 999 'File->Exit
CloseWindow wndMain
EndSelect
Case @IDControl
If @ControlID=4 And @NotifyCode=0 Then
tvListClassMethods(GetControlText(wndMain,1),wndMain,2)
ElseIf @ControlID=5 And @NotifyCode=0
GenClassHeader(GetControlText(wndMain,1),wndMain,3)
ElseIf @ControlID=2 And @NotifyCode=NM_CLICK Then
'This only sorta works right now.
Int hnd=tvGetSelectedItem(wndMain,2)
If hnd Then
Int pos=ControlCMD(wndMain,1,@RTCharFromLine,tvGetItemData(wndMain,2,hnd))
ControlCMD wndMain,1,@RTSetSelection,pos,pos
SetFocus wndMain,1
EndIf
EndIf
Case @IDCloseWindow
CloseWindow wndMain
EndSelect
EndSub

Sub IIf(cond As Int,IfTrue As Int,IfFalse As Int),Int
Dim ret As Int
_asm
cmp dword [ebp+8],0
je .false
mov dword eax,[ebp+12]
mov dword [ebp+16],eax
.false:
mov dword eax,[ebp+16]
mov dword [ebp-4],eax
_endasm
Return ret
EndSub

Sub AttachMainMenu(win As Window)
BeginMenu win
MenuTitle "&File"
MenuItem "&New\tCtrl+N",0,101
Separator
MenuItem "&Open\tCtrl+O",0,102
MenuItem "&Save\tCtrl+S",0,103
MenuItem "Save As...",0,104
Separator
MenuItem "E&xit\tAlt+F4",0,999
EndMenu
AddAccelerator win,@FControl|@FVirtKey,Asc("N"),101
AddAccelerator win,@FControl|@FVirtKey,Asc("O"),102
AddAccelerator win,@FControl|@FVirtKey,Asc("S"),103
EndSub

Sub ReturnName(Path As String),String
Dim last,late,i As Int
Dim rString As String
late=0
Do
last=late
late=InStr(Path,"\\",last+1)
Until late=0
rString=Mid$(Path,last+1)
For i=Len(rString)-1 to 0 Step -1
If rString[i]="."
rString[i]=0
i=0
EndIf
Next i
Return rString
EndSub

Sub RemoveExt(Path As String),String
Dim last,late As Int
late=0
Do
last=late
late=InStr(Path,".",last+1)
Until late=0
Return Left$(Path,last-1)
EndSub

Sub Trim$(str As String),String
Return LTrim$(RTrim$(str))
EndSub

Sub tvListClassMethods(source As String,parent As Window,cid As Int),Int
Dim lines,i,hnd As Int
Dim strs,dict As Pointer
Dim className,methodName As String
SetType strs,String
If InStr(source,"\n") Then
strs=Split(source,"\n",lines)
dict=DictCreate
If strs And dict Then
tvDeleteAllItems(parent,cid)
For i=0 to lines-1
If InStr(*strs[i,0],"::") Then
*strs[i,0]=LTrim$(*strs[i,0])
If UCase$(Left$(*strs[i,0],3))="SUB" Then
className=Trim$(NthField(Mid$(*strs[i,0],4),"::",1))
methodName=Trim$(NthField(*strs[i,0],"::",2))
If DictLookUp(dict,className)="" Then
'Ensure theres a heading for this classname
hnd=tvInsertItem parent,cid,className,null
DictAdd(dict,className,Str$(hnd))
'Store in the main class entry, the first found method's line
tvSetItemData parent,cid,hnd,i
EndIf
hnd=tvInsertItem parent,cid,methodName,Val(DictLookUp(dict,className))
'Store in the method's entry its line position in the string
tvSetItemData parent,cid,hnd,i
EndIf
EndIf
Next i
DictFree dict
Delete strs
Return 1
EndIf
EndIf
Return 0
EndSub

Sub GenClassHeader(source As String,parent As Window,cid As Int),Int
Dim strs,props=0 As Pointer
Dim lines,i As Int
Dim className="",methodName="",currentClass="" As String
SetType strs,String
SetControlText parent,cid,""
If InStr(source,"\n") Then
strs=Split(source,"\n",lines)
If strs Then
For i=0 to lines-1
If InStr(*strs[i,0],"::") Then
*strs[i,0]=LTrim$(*strs[i,0])
If UCase$(Left$(*strs[i,0],3))="SUB" Then
className=Trim$(NthField(Mid$(*strs[i,0],4),"::",1))
methodName=Trim$(NthField(*strs[i,0],"::",2))
If className<>currentClass Then
If currentClass<>"" Then
ListProperties(parent,cid,props)
DictFree props
props=0
REAppend(parent,cid,"EndClass\n\n")
EndIf
currentClass=className
REAppend(parent,cid,"Class "+currentClass+"\n")
EndIf
REAppend(parent,cid,"\tDeclare "+methodName+"\n")
If className=Left$(methodName,Len(className)) And props=0 Then
props=GrabProperties(strs,i,lines)
EndIf
EndIf
EndIf
Next i
If currentClass<>"" Then
ListProperties(parent,cid,props)
DictFree props
props=0
REAppend(parent,cid,"EndClass")
EndIf
If props Then DictFree(props)
If strs Then Delete(strs)
String keywords[8],types[14]
types="char","string","uint","int","uint64","int64","float","double","word","sword","schar","pointer","window","dialog"
keywords="sub","endsub","class","endclass","dim","as","declare","opt"
REHilight(parent,cid,types,14,0x0000FF)
REHilight(parent,cid,keywords,8,0xFF0000,False)
Return 1
EndIf
EndIf
Return 0
EndSub

Sub ListProperties(parent As Window,cid As Int,props As Pointer)
Dim pos As Int
Dim assoc As Pointer
pos=DictGetStartAssoc(props)
While pos
assoc=DictGetNextAssoc(props,pos)
REAppend(parent,cid,"\tDim "+DictGetKey(assoc)+" As "+DictGetValue(assoc)+"\n")
Wend
EndSub

Sub GrabProperties(array As Pointer,firstLine As Int,count As Int),UInt
Dim i=firstLine+1,eq,qt,dc As Int
Dim props As Pointer
Dim typ As String
SetType array,String
props=DictCreate
If props Then
*array[i,0]=LTrim$(*array[i,0])
While UCase$(Left$(*array[i,0],6))<>"ENDSUB" And i<count
*array[i,0]=LTrim$(*array[i,0])
eq=InStr(*array[i,0],"=")
If eq Then
If Left$(*array[i,0],2)="m_" Then
qt=InStr(*array[i,0],"\"",eq)
dc=InStr(*array[i,0],".",eq)
typ="UInt"
If qt And ((dc And dc>qt) Or dc=0) And InStr(*array[i,0],"\"",qt+1) Then
typ="String"
ElseIf dc And (qt>dc Or qt=0) Then
typ="Double"
EndIf
DictAdd(props,RTrim$(Left$(*array[i,0],eq-1)),typ)
EndIf
EndIf
i++
Wend
Return props
EndIf
Return null
EndSub

Sub Split(source As String,delimiter As String,count As Int ByRef),UInt
Dim delpos=0,nexpos,dellen=Len(delimiter),i=0 As Int
Dim array As Pointer
count=FieldCount(source,delimiter)
array=New(String,count)
nexpos=InStr(source,delimiter)
If array Then
While nexpos
If i=0 Then delpos=1-dellen
*<String>array[i,0]=Left$(Mid$(source,delpos+dellen,nexpos-delpos-dellen),254)
delpos=nexpos
nexpos=InStr(source,delimiter,delpos+dellen)
i++
Wend
*<String>array[i,0]=Mid$(source,delpos+dellen)
EndIf
Return array
EndSub

Sub NthField(source As String,delimiter As String,fieldnumber As Int),String
Dim delpos,nexpos,dellen=Len(delimiter),count As Int
count=1
delpos=0
nexpos=InStr(source,delimiter)
While nexpos
If count=fieldnumber Then
If count=1 Then delpos=1-dellen
Return Mid$(source,delpos+dellen,nexpos-delpos-dellen)
Else
delpos=nexpos
nexpos=InStr(source,delimiter,delpos+1)
count++
EndIf
Wend
Return Mid$(source,delpos+dellen)
EndSub

Sub FieldCount(source As String,delimiter As String),Int
Dim delpos,nexpos,count As Int
count=0
delpos=0
nexpos=InStr(source,delimiter)
While nexpos
delpos=nexpos
nexpos=InStr(source,delimiter,delpos+1)
count++
Wend
Return count+1
EndSub

Sub REAppend(win As Window,cid As Int,text As String)
Dim l=ControlCMD(win,cid,@RTGetTextLength) As Int
ControlCMD win,cid,@RTSetSelection,l,l
ControlCMD win,cid,@RTReplaceSel,text
EndSub

Sub REHilight(win As Window,cid As Int,words[] As String,wordCount As Int,col As Int,Opt clr=True As Int)
Dim oStart,oEnd As UInt
Dim i,n=0 As Int
ControlCMD win,cid,@RTGetSelection,oStart,oEnd
If clr Then
ControlCMD win,cid,@RTSetSelection,0,-1
ControlCMD win,cid,@RTSetSelColor,0 'black
ControlCMD win,cid,@RTSetSelFont,"Courier New",10,0,0
EndIf
For i=0 to wordCount-1
n=ControlCMD(win,cid,@RTFindText,words[i],n,True)
While n>=0
ControlCMD win,cid,@RTSetSelection,n,n+Len(words[i])
ControlCMD win,cid,@RTSetSelColor,col
n=ControlCMD(win,cid,@RTFindText,words[i],n+1,True)
Wend
n=0
Next i
ControlCMD win,cid,@RTSetSelection,oStart,oEnd
ControlCMD win,cid,@RTSetSelColor,0 'black
ControlCMD win,cid,@RTSetSelFont,"Courier New",10,0,0
EndSub