'=================================================================================
' Telephone (or address) search utility, which works with small partial matching
' and selection of records during typing in
'
'=================================================================================
'
' This application uses some code from Don Schullian, Lance Edmonds and others
' Special thanks to Lance Edmonds for the helping hand
'
' Henk Broekhuizen, feel free to use, no rights reserved
' located at the powerbasic forums at:
' http://
'
' This is a stripped version of one of the first projects I tried to put together
' and is used on a network with 1000+ Windows NT machines
' The idea was to combine 13 telephone directory lists into one program and with
' the possibility to search on parts of names and to minimize the required input
'
' I have tried to strip as much as code from it to take the network stuff out and
' share the remains with you. This version is capable on running on a stand alone
' machine (what I tried to prevent with the original)
' The app also checks at start-up time what version number is in the file
' TEL_MB.versie to see if a newer version is available.
'
' Anyone interested in the full size network version with auto-update,
' please email me for the code at pbforums@henkhenk.com
'
'
'=================================================================================
#COMPILE EXE "telephone.exe"
#DIM ALL
#INCLUDE "win32api.inc"

$versie = "1.0a"
$titel = "Telephone version " + $versie

$app="Telephone.exe" '
$Datafilepath=""
$testfile="telephone.txt" '< if this file is not present the program terminates
%AantalDataBestanden=2 'only use 2 here, but use as much you like, names are downwards


'------------------------------------------------------------------------------


GLOBAL hDlgMain AS LONG
GLOBAL hDlgResultaat AS LONG
GLOBAL hDlgOpties AS LONG
GLOBAL hDlgBoodschap AS LONG
GLOBAL hDlgOnlineTest AS LONG
GLOBAL hFont AS LONG
GLOBAL keuze AS STRING
GLOBAL vorigekeuze AS STRING
GLOBAL Txt() AS STRING
GLOBAL Toon() AS STRING
GLOBAL TxtAantal AS LONG
GLOBAL pad AS STRING 'dialoog verwijderd
GLOBAL HoofdMenu AS LONG
GLOBAL KeepOnTop AS LONG
GLOBAL KeepOnTopOud AS LONG
GLOBAL Grootte AS LONG
GLOBAL GrootteOud AS LONG
GLOBAL Update AS STRING 'wanneer is voor het laatst de data ingelezen?
GLOBAL TheEnd AS LONG 'TheEnd 1 maken als moet worden gestopt
GLOBAL Restart AS LONG 'verplicht 1 maken als opnieuw gestart moet worden
GLOBAL XScreenSize AS LONG
GLOBAL YScreenSize AS LONG
GLOBAL Toolbar AS LONG 'toolbar is normaal, een andere normale bar kiesbaar
GLOBAL ToolBarOud AS LONG
GLOBAL MenuX AS LONG
GLOBAL MenuY AS LONG
GLOBAL SaveMenuX AS LONG 'positie menu indien die opgeslagen moet worden
GLOBAL SaveMenuY AS LONG 'idem
GLOBAL SaveLocatie AS LONG '
GLOBAL SaveLocatieOud AS LONG



%IDSB =700
%IDRW =701
%IDSW =702
%IDSP =703
%IDLOG=704
%IDEB =705
%IDCZM=706
%IDWCS = 707
%IDSchepen = 708
%IDtelno = 709
%IDlijst = 710
%IDOpties = 711
%OptieMini = 712
%IDAantal = 713
%IDBron = 714
%OptieOnTop = 715
%OptieToolbar = 716
%OptieGrootte = 717
%OptieSaveLocatie=718
%IDAfsluiten = 719
' %IDHelp = 721
%StatusOnlineTest= 722


%MaxAantal=10000 'maximum number of names (records)
%MaxToon= 200 'maximum to show in display

%functie=32
%afdeling=65
%telno=74
%kamer=90
$separator="=="
$separator2="========================================================================================"
'------------------------------------------------------------------------------

FUNCTION fProgPath () AS STRING
'get the program's path
DIM zFileName AS LOCAL ASCIIZ * 260
DIM P AS LOCAL LONG

IF GetModuleFileName(0,zFileName,260) <> 0 THEN
P = INSTR(-1,zFileName, ANY ":\")
FUNCTION = LEFT$(zFileName,P)
END IF
END FUNCTION

'---------------------------------------------------------------------------
FUNCTION fProgPathName () AS STRING
'get the program's path and name
DIM zFileName AS LOCAL ASCIIZ * 260
DIM P AS LOCAL LONG

IF GetModuleFileName(0,zFileName,260) <> 0 THEN
FUNCTION = zFileName
END IF
END FUNCTION

'---------------------------------------------------------------------------

FUNCTION fProgName() AS STRING
'get the program's name
DIM zFileName AS LOCAL ASCIIZ * 260
DIM P AS LOCAL LONG

IF GetModuleFileName(0,zFileName,260) <> 0 THEN
P = INSTR(-1,zFileName, ANY ":\")
FUNCTION = MID$(zFileName,P+1)
END IF
END FUNCTION

'---------------------------------------------------------------------------



'read the phone files from the network (or other place)
FUNCTION ReadInNewDataFiles() AS LONG
LOCAL r AS LONG
LOCAL bestand AS STRING
LOCAL regel AS STRING
LOCAL aantal AS LONG
LOCAL boodschap AS STRING
LOCAL uregel AS STRING
LOCAL Naam AS STRING
LOCAL versie AS STRING
LOCAL Resultaat AS LONG
LOCAL Fout AS STRING

ERRCLEAR
OPEN pad+"TEL_MB.versie" FOR INPUT AS #1
IF ERR=0 THEN
'only in case of succes
'make a auto-update scheme to update user's versions whenever a version lower than recommended is used.
' update.exe simply copies the new version from source location to the used location and restarts the program
' 54321 is used to keep a user from doing stuff himself . . .
INPUT #1,versie
CLOSE #1
versie=UCASE$(versie)
IF ERR=0 THEN
IF versie>UCASE$($versie) THEN
Resultaat = MSGBOX ("message about obsolete program version ...."+$CR+$CR, _
%MB_OKCANCEL OR %MB_ICONEXCLAMATION,"Telefoonprogramma TEL_MB.EXE Version check")
'msgbox(str$(Resultaat))
IF Resultaat = 1 THEN 'OK copiëeren
'start shell voor copiëren en beeindig programma'
Resultaat = SHELL (pad+"update.exe 54321 "+fProgPath+"="+fProgName)
TheEnd=1
Restart=1
FUNCTION=0
EXIT FUNCTION
END IF
END IF
END IF
END IF

'==============================

Update=DATE$
'record the date of last read-in of phonenumbers. If someone continues to use the
'program for days and days, he will get the latest info as soon a new day starts and he
'uses the program again

DIM Txt(1:%maxaantal+10)
aantal=0
FOR r=1 TO %AantalDataBestanden+1 'aantal datafiles
DIALOG DOEVENTS
regel=READ$(r)
IF INSTR(regel,":\")=0 THEN
'no drive letter, so the standard directory added to it
bestand=pad+LEFT$(regel,13)
Naam=MID$(regel,14)
ELSE
'place with a drive indication, so use that location
bestand=regel
Naam=" Own file "+bestand+" "
END IF
INCR aantal
IF aantal>=%maxaantal THEN
Txt(aantal)=LEFT$($separator+" maximum number of records reached "+$separator2,100)
EXIT FOR
END IF
'
'take the name of the file we used as a sort of header in the output
ERRCLEAR
OPEN bestand FOR INPUT AS #1
IF ERR<>0 THEN
IF aantal>%maxaantal THEN EXIT FOR
'maak in de koptekst per bedrijfsdeel een melding
Fout="(file could not be accessed)"
IF ERR=52 THEN Fout="(file not found)"
IF ERR=53 THEN Fout="(file not present)"
IF ERR=70 THEN Fout="(no access to network drive)"
INCR aantal
Txt(aantal)=LEFT$($separator+Naam+Fout+$separator2,100)
ELSE
Txt(aantal)=LEFT$($separator+Naam+" "+$separator2,100)
WHILE NOT EOF(1) AND aantal<%maxaantal
LINE INPUT #1,regel
INCR aantal
IF aantal/10 = INT(aantal/10) THEN DIALOG DOEVENTS
IF aantal>%maxaantal THEN
Txt(aantal)=LEFT$($separator+" maximaal aantal records bereikt "+$separator2,100)
EXIT FOR
END IF
Txt(aantal)=regel
WEND
END IF
'close in al cases
CLOSE #1
'next data file
NEXT r

DECR aantal 'counted one to many
REDIM PRESERVE Txt(1:aantal) 'resize the array to avoid empty entries in the listbox
TxtAantal=aantal
FUNCTION=1

'only 2 are used here, but make AantalBestanden the number of files you have and add the names here
'------Filename Name to show
DATA "telephone.txt Division 1"
DATA "telephon2.txt Division 2"
' DATA "telephon3.txt Division 3" < if you need more different files
' DATA "telephon4.txt Division 4"
' DATA "telephon5.txt Division 5"
' DATA "telephon6.txt Division 6"
' DATA "c:\temp\tmp.tmp" 'files starting with a drive: letter are regarded as privat files, the others are shared files for multiple persons to use
END FUNCTION
'------------------------------------------------------------------------------

'make a font for the results dialog
FUNCTION MakeFont(BYVAL myFONT AS STRING, BYVAL PointSize AS LONG) AS LONG
LOCAL hDC AS LONG
LOCAL CyPixels AS LONG
hDC = GetDC(%HWND_DESKTOP)
CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY)
ReleaseDC %HWND_DESKTOP, hDC
PointSize = (PointSize * CyPixels) \ 72
FUNCTION = CreateFont(0 - PointSize, 0, 0, 0, %FW_NORMAL, 0, 0, 0, _
%ANSI_CHARSET, %OUT_TT_PRECIS, %CLIP_DEFAULT_PRECIS, _
%DEFAULT_QUALITY, %FF_DONTCARE, BYCOPY MyFONT)
END FUNCTION

'---------------------------------------------------------------------------------
'format a line so it is nicely organized with colomn type
' insert spaces to set nice colomns
FUNCTION formatregel(regel AS STRING) AS STRING
LOCAL resultaat AS STRING
LOCAL tekst AS STRING
LOCAL pos AS LONG

resultaat=regel

tekst=regel

'*******************************************

pos=INSTR(tekst,",")
IF pos>0 THEN
resultaat=LEFT$(tekst,pos-1)
tekst=MID$(tekst,pos+1)
IF LEN(resultaat)<%functie THEN resultaat=resultaat+SPACE$(%functie-LEN(resultaat))
END IF

pos=INSTR(tekst,",")
IF pos>0 THEN
'neem deel tot de komma over en voeg achter de eerdere tekst, voorzien van spaties
resultaat=resultaat+LEFT$(tekst,pos-1)
'restant zonder komma in tekst
tekst=MID$(tekst,pos+1)
'indien te kort aanvullen met spaties
IF LEN(resultaat)<%afdeling THEN resultaat=resultaat+SPACE$(%afdeling-LEN(resultaat))
END IF

pos=INSTR(tekst,",")
IF pos>0 THEN
'neem deel tot de komma over en voeg achter de eerdere tekst, voorzien van spaties
resultaat=resultaat+LEFT$(tekst,pos-1)
'restant zonder komma in tekst
tekst=MID$(tekst,pos+1)
IF LEN(resultaat)<%telno THEN resultaat=resultaat+SPACE$(%telno-LEN(resultaat))
END IF


pos=INSTR(tekst,",")
IF pos>0 THEN
'neem deel tot de komma over en voeg achter de eerdere tekst, voorzien van spaties
'er komt dus nog een komma en eventueel kamernummer
resultaat=resultaat+LEFT$(tekst,pos-1)
'restant zonder komma in tekst
tekst=MID$(tekst,pos+1)
IF LEN(resultaat)<%kamer THEN resultaat=resultaat+SPACE$(%kamer-LEN(resultaat))
resultaat=resultaat+tekst
ELSE
'geen optionele komma en optionele kamer
resultaat=resultaat+tekst
END IF
FUNCTION=resultaat
END FUNCTION


FUNCTION WelkeErr(fout AS LONG) AS STRING
LOCAL tekst AS STRING

SELECT CASE fout
CASE 5
tekst="5 Illegal function call - This is a catch-all error related to passing an inappropriate argument to some statement or function."
tekst=tekst+"A few of the 101 things that can cause it follow: * Trying to perform invalid mathematical operations, such as taking the "
tekst=tekst+"square root of a negative number. * A record number is too large (or negative) in a GET or PUT. "
tekst=tekst+"* Attempting to use the WIDTH statement on a sequential file."
CASE 7
tekst="7 Out of memory - Many different situations can cause this message, including dimensioning too large an array."
CASE 9
tekst="9 Subscript / Pointer out of range - You attempted to use a subscript smaller than the minimum or larger than the maximum value established when the array was dimensioned. Attempting to use a null pointer will also cause this error."
CASE 24
tekst="24 Device Time-Out – The specified time-out value for a UDP or TCP communications operation has expired."
CASE 51
tekst="51 Internal error - A malfunction occurred within the PowerBASIC run-time system. Contact the PowerBASIC Technical Support group with information about your program."
CASE 52
tekst="52 Bad file name or number - The file number you gave in a file statement doesn't match one given in an OPEN statement, or the file number may be out of the range of valid file numbers."
CASE 53
tekst="53 File not found - The file name specified could not be found on the indicated drive."
CASE 54
tekst="54 Bad file mode - You attempted a PUT or a GET (or PUT$ or GET$) on a sequential file."
CASE 55
tekst="55 File is already open - You attempted to open a file that was already open, or you tried to delete an open file."
CASE 57
tekst="57 Device I/O error - A hardware problem occurred when trying to carry out some command."
CASE 58
tekst="58 File already exists - The new name argument specified in your NAME statement already exists."
CASE 61
tekst="61 Disk full - There isn't enough free space on the indicated or default disk to carry out a file operation. Create some more free disk space and retry your program."
CASE 62
tekst="62 Input past end - You tried to read more data from a file than it had to read. Use the EOF (end of file) function to avoid this problem. Trying to read from a sequential file opened for output or append can also cause this error."
CASE 63
tekst="63 Bad record number - A negative number or a number larger than 2,147,483,647 was specified as the record argument to a random file PUT or GET statement."
CASE 64
tekst="64 Bad file name - The file name specified in a KILL, or NAME statement contains invalid characters."
CASE 67
tekst="67 Too many files - This error can be caused either by trying to create too many files in a drive's root directory, or by an invalid file name that affects the performance of the Create File system call."
CASE 68
tekst="68 Device unavailable - You tried to OPEN a device file on a machine without that device; for example, OPENing COM1 on a system without a serial adapter or modem."
CASE 70
tekst="70 Permission denied - You tried to write to a write-protected disk. This error can also be generated as a result of network permission errors."
CASE 71
tekst="71 Disk not ready - The door of a floppy disk drive is open, or there is no disk in the indicated drive."
CASE 72
tekst="72 Disk media error - The controller board of a floppy or hard disk indicates a hard media error in one or more sectors."
CASE 74
tekst="74 Rename across disks - You can't rename a file across disk drives."
CASE 75
tekst="75 Path/file access error - During a command capable of specifying a path name (OPEN, NAME, or MKDIR, for example), you used a path inappropriately; trying to OPEN a subdirectory or to delete a directory in-use, for example."
CASE 76
tekst="76 Path not found - The path you specified during a CHDIR, MKDIR, OPEN, etc., can't be found."
CASE ELSE
tekst="Fout "+FORMAT$(fout)+" is niet verder gespecificeerd. "
END SELECT
tekst=tekst+$CR+$LF+" "
tekst=tekst+$CR+$LF+" "
FUNCTION=tekst
END FUNCTION


SUB ReadSettingsFromFile 'all GLOBAL
LOCAL Tekst AS STRING
OPEN "telshell.ini" FOR INPUT AS #1
IF ERR=0 THEN
INPUT #1,tekst: HoofdMenu = VAL(tekst)
INPUT #1,tekst: KeepOnTop = VAL(tekst)
INPUT #1,tekst: Toolbar = VAL(tekst)
INPUT #1,tekst: Grootte = VAL(tekst)
INPUT #1,tekst: SaveLocatie = VAL(tekst)
INPUT #1,tekst: IF tekst<>"" THEN SaveMenuX = VAL(tekst)
INPUT #1,tekst: IF tekst<>"" THEN SaveMenuY = VAL(tekst)
END IF
CLOSE #1
IF Grootte<>0 THEN KeepOnTop=8 'force keep-on-top to prevent cover-up with larger resolutions, like bij 1024x768
END SUB




SUB SchrijfInstellingen
DIALOG GET LOC hDlgMain TO SaveMenuX, SaveMenuY 'save if needed
OPEN "telshell.ini" FOR OUTPUT AS #1
PRINT #1, Hoofdmenu
PRINT #1, KeepOnTop
PRINT #1, Toolbar
PRINT #1, Grootte
PRINT #1, SaveLocatie
PRINT #1, SaveMenuX
PRINT #1, SaveMenuY
CLOSE #1
END SUB



CALLBACK FUNCTION CancelButton() AS LONG
DIALOG END hDlgMain, 0
TheEnd=1
Restart=0
FUNCTION = 1
END FUNCTION


CALLBACK FUNCTION Help() AS LONG
'FUNCTION ShellExecute LIB "SHELL32.DLL" ALIAS "ShellExecuteA" (BYVAL hwnd AS LONG, lpOperation AS ASCIIZ, lpFile AS ASCIIZ, lpParameters AS ASCIIZ, lpDirectory AS ASCIIZ, BYVAL nShowCmd AS LONG) AS LONG
LOCAL Nullz AS ASCIIZ*255
Nullz=""
ShellExecute %HWND_Desktop,"Open", pad+"Help_TEL_MB.htm", Nullz,Nullz,1
'call a HTML file with this name to explain all ^^^^^^ not supplied here
END FUNCTION

'------------------------------------------------------------------------------


CALLBACK FUNCTION MiniMenu() AS LONG
DIALOG DOEVENTS
IF CBCTLMSG=%BN_CLICKED THEN IF HoofdMenu=0 THEN HoofdMenu=1 ELSE HoofdMenu=0
END FUNCTION

CALLBACK FUNCTION MenuToolbar() AS LONG
DIALOG DOEVENTS
IF CBCTLMSG=%BN_CLICKED THEN IF Toolbar=0 THEN Toolbar=1 ELSE Toolbar=0
END FUNCTION


CALLBACK FUNCTION ZichtBaar() AS LONG
DIALOG DOEVENTS
IF CBCTLMSG=%BN_CLICKED THEN IF KeepOnTop=0 THEN KeepOnTop=%WS_EX_TOPMOST ELSE KeepOnTop=0
END FUNCTION

CALLBACK FUNCTION OptieGrootte() AS LONG
DIALOG DOEVENTS
IF CBCTLMSG=%BN_CLICKED THEN IF Grootte=0 THEN Grootte=1 ELSE Grootte=0
END FUNCTION


CALLBACK FUNCTION OptieSaveLocatie() AS LONG
DIALOG DOEVENTS
IF CBCTLMSG=%BN_CLICKED THEN IF SaveLocatie=0 THEN SaveLocatie=1 ELSE SaveLocatie=0
END FUNCTION


CALLBACK FUNCTION CancelOptieMenu() AS LONG
DIALOG END hDlgOpties, 0
'reset the variables to original values (we pressed CANCEL you know)
KeepOnTop=KeepOnTopOud
ToolBar =ToolBarOud
Grootte = GrootteOud
SaveLocatie = SaveLocatieOud
Restart = 1 'restart dialog
FUNCTION = 1
END FUNCTION

CALLBACK FUNCTION OKOptieMenu() AS LONG
LOCAL Tekst AS STRING
DIALOG END hDlgOpties, 0
SchrijfInstellingen
'end the dialog, but do not set TheEnd to 1, so the program is run again
DIALOG END hDlgMain,0
Restart = 1 'restart the dialog sequences
FUNCTION = 1
END FUNCTION

CALLBACK FUNCTION Opties() AS LONG
ToolbarOud = Toolbar
KeepOnTopOud = KeepOnTop
GrootteOud = Grootte
SaveLocatieOud = SaveLocatie
DIALOG NEW 0, "Options",,, 150, 120,%WS_SYSMENU, %WS_EX_TOPMOST TO hDlgOpties
CONTROL ADD CHECKBOX , hDlgOpties, %OptieToolbar, "Toolbar (no MINIMIZE button)", 3, 3, 140, 16 CALL MenuToolBar
CONTROL ADD CHECKBOX , hDlgOpties, %OptieOnTop, "Always visible (Keep on Top)", 3, 23, 150, 16 CALL ZichtBaar
CONTROL ADD CHECKBOX , hDlgOpties, %OptieGrootte,"1024x768 screensize", 3, 43, 150, 16 CALL OptieGrootte
CONTROL ADD CHECKBOX , hDlgOpties, %OptieSaveLocatie,"Store location search dialog", 3, 63, 150, 16 CALL OptieSaveLocatie
CONTROL ADD BUTTON, hDlgOpties, %IDCANCEL, "&Cancel", 75, 80, 50, 14, 0 CALL CancelOptieMenu
CONTROL ADD BUTTON, hDlgOpties, %IDOK, "&Store", 15, 80, 50, 14, 0 CALL OKOptieMenu
CONTROL SET CHECK hDlgOpties, %OptieToolbar,1-Toolbar
CONTROL SET CHECK hDlgOpties, %OptieOnTop ,KeepOnTop
CONTROL SET CHECK hDlgOpties, %OptieGrootte,Grootte
CONTROL SET CHECK hDlgOpties, %OptieSaveLocatie,1-SaveLocatie
DIALOG SHOW MODAL hDlgOpties
END FUNCTION


'--------------------------------------------------------------------------------

CALLBACK FUNCTION DlgProc() AS LONG
LOCAL regel AS STRING
LOCAL aantal AS LONG
LOCAL aantalmatches AS LONG 'aantal overeenkomende records
LOCAL ukeuze AS STRING 'uppercase versie van de keuze
LOCAL uregel AS STRING 'uppercase versie van de regel
LOCAL r AS LONG
LOCAL boodschap AS STRING 'te vertonen tekst
LOCAL vertoon AS LONG 'vertoon het current record straks

'Purpose Return the wMsg parameter of a message within a callback function.
'Syntax wMsg = CBMSG
'When Windows sends a message to your callback, the lParam value contains different
' values depending on the wMsg command sent.

IF CBMSG = %WM_USER + 999& THEN
'at every key put main dialog to the front
SetForegroundWindow CBHNDL
BringWindowtoTop CBHNDL
FUNCTION = 1
EXIT FUNCTION

ELSEIF CBMSG = %WM_DESTROY THEN
'only after pressing the X or STOP button
'get the current position for storing if neccesary
DIALOG GET LOC hDlgMain TO SaveMenuX, SaveMenuY 'indien nodig opslaan in ini file
DIALOG END hDlgResultaat, 0
EXIT FUNCTION

ELSEIF CBMSG= %WM_GETMINMAXINFO OR CBMSG = %WM_ERASEBKGND THEN
IF CBMSG <> %WM_ERASEBKGND THEN
'hide
DIALOG SHOW STATE hDlgResultaat, %SW_HIDE
'the next ones were not noticeable . . . .so remmed out
'dialog post CBHNDL, %WM_PAINT, 0, 0
'DIALOG SEND hDlgResultaat, %WM_SETREDRAW, 1, 0 'sta hertekenen in ieder geval toe
'InvalidateRect hDlgResultaat, BYVAL 0&, 0& 'wijs hele deel aan voor opnieuw tekenen
ELSE
'show the dialog as soon there is something entered
IF LEN(keuze)<>0 THEN
DIALOG SHOW STATE hDlgResultaat, %SW_SHOWNA 'vertoon maar niet actief
'DIALOG SEND hDlgResultaat, %WM_SETREDRAW, 1, 0 'sta hertekenen in ieder geval toe
'InvalidateRect hDlgResultaat, BYVAL 0&, 0& 'wijs hele deel aan voor opnieuw tekenen
END IF
END IF

ELSEIF CBMSG <> %WM_COMMAND AND CBCTLMSG <> %EN_UPDATE THEN
'quit unless a command or the dialog entry field has been updated
EXIT FUNCTION
END IF


IF Update<>DATE$ THEN
'data was from a earlier day, so reread the info to prevent back-log
Update=DATE$
DIALOG NEW 0, "Rereading of file data on this new day...",,,250,50, %WS_SYSMENU, 0 TO hDlgBoodschap
DIALOG SHOW MODELESS hDlgBoodschap
SLEEP(100)
DIALOG DOEVENTS
r=ReadInNewDataFiles 'r is dummy
TheEnd=1
Restart=1 'restart the program to take new settings into account
DIALOG END hDlgBoodschap,0
EXIT FUNCTION

DIALOG END hDlgBoodschap,0
DIALOG DOEVENTS

'DIALOG POST CBHNDL, %WM_USER + 999&, 0, 0 '<<<<<<<<<<<<<<<<<<< >6.1 <<<<<<<<<<<<<<<<<<
CONTROL SET FOCUS hDlgMain, %IDtelno
END IF

'dimensioneer de Toon array (maak rest leeg)
REDIM Toon(1:%MaxToon)
'lees de courante invoer in
CONTROL GET TEXT hDlgMain, %IDtelno TO keuze
aantal=0
IF keuze<>vorigekeuze THEN
DIALOG DOEVENTS
vorigekeuze=keuze
aantal=1
aantalmatches=0
'dimensioneer de Toon array (maak rest leeg)
DIM Toon(1:%MaxToon)
ukeuze=UCASE$(keuze)
FOR r=1 TO TxtAantal 'alle records langslopen
regel=Txt(r)
uregel=UCASE$(regel)

'een bestandsheader? dan vertonen, maar NIET formateren qua layout
IF LEFT$(uregel,LEN($separator))=$separator THEN
Toon(aantal)=regel
INCR aantal
'niet meetellen
IF aantal>=%MaxToon THEN
Toon(aantal-1)="Maximum of "+STR$(%MaxToon)+ "are shown...."
EXIT FOR 'maximaal te vertonen bereikt
END IF
ELSE
'selectie in keuze komt voor in het record? vertonen en WEL formatteren
IF (INSTR(uregel,ukeuze)<>0) THEN
Toon(aantal)=" "+formatregel(regel)
INCR aantal
INCR aantalmatches
IF aantal>=%MaxToon THEN
Toon(aantal-1)="!!!! Maximum of "+STR$(%MaxToon)+ " reached for displaying.... !!!!"
EXIT FOR 'maximaal te vertonen bereikt
END IF
END IF
END IF
NEXT r
DECR aantal


IF aantal<=0 THEN aantal=1: Toon(1)="No matches found..."
REDIM PRESERVE Toon(1:aantal)

IF ISFALSE LEN(keuze) THEN
'keuze is leeg, dus window verbergen (en niet aftuigen zoals eerder)
DIALOG SHOW STATE hDlgResultaat, %SW_HIDE
ELSE
'vertoon het window als keuze>0 is
DIALOG SHOW STATE hDlgResultaat, %SW_SHOWNA
' Recreate the control... simply resetting the content and refilling it
' would probably produce less flicker, but to overcome it, we set the redraw
' flag to false and then force the window to be redrawn. Messy but it works!
DIALOG SEND hDlgResultaat, %WM_SETREDRAW, 0, 0
CONTROL KILL hDlgResultaat, %IDlijst

CONTROL ADD LISTBOX, hDlgResultaat, %IDlijst, Toon(), 5, 5, MenuX-10, MenuY-20 , %WS_BORDER OR %LBS_WANTKEYBOARDINPUT OR %WS_VSCROLL OR %WS_GROUP OR %WS_TABSTOP OR %LBS_NOINTEGRALHEIGHT OR %LBS_USETABSTOPS OR %LBS_DISABLENOSCROLL
CONTROL SEND hDlgResultaat, %IDlijst, %WM_SETFONT, hFont, 1 'Lance

'vertoon hoeveel totaal, hoeveel gevonden en waar de data staat, update van de labels
CONTROL SET TEXT hDlgResultaat,%IDaantal,"Total number: "+STR$(TxtAantal)+" "+"Number found: "+STR$(aantalmatches)+" "
CONTROL SET TEXT hDlgResultaat,%IDbron,"Used source: "+pad

'laat het Window opnieuw opbouwen
DIALOG SEND hDlgResultaat, %WM_SETREDRAW, 1, 0
InvalidateRect hDlgResultaat, BYVAL 0&, 0&
END IF

DIALOG DOEVENTS
FUNCTION = 1
END IF 'end of part executed only if keuze<>vorigekeuze

END FUNCTION


'-------------------------------------------------------------------------------
FUNCTION TestOnline AS LONG
DIALOG NEW 0, "Testing for presence on-line file(s)",,,250,100, %WS_SYSMENU, 0 TO hDlgOnlineTest
CONTROL ADD LABEL ,hDlgOnlineTest, %StatusOnlineTest,"initialize . . . ", 5,5,240,95
DIALOG SHOW MODELESS hDlgOnlineTest
DIALOG DOEVENTS

DIALOG GET LOC hDlgOnlineTest TO XScreenSize, YScreenSize
XScreenSize=2*XScreenSize+250 ' ^^^^
YScreenSize=2*YScreenSize+ 50

DIALOG DOEVENTS

ERRCLEAR
CONTROL SET TEXT hDlgOnlineTest, %StatusOnlineTest,"Search: " & $Datafilepath+$testfile
DIALOG DOEVENTS
OPEN $Datafilepath+$testfile FOR INPUT AS #1
IF ERR<>0 THEN
MSGBOX "No access to the data sources. ",,"WAARSCHUWING ! ! ! !"
FUNCTION=0
TheEnd=1
EXIT FUNCTION 'no way Gosé
END IF
pad=$Datafilepath
CLOSE #1
DIALOG END hDlgOnlineTest, 0
DIALOG DOEVENTS
FUNCTION=1
END FUNCTION
'------------------------------------------------------------------------------


FUNCTION PBMAIN () AS LONG
LOCAL Style AS LONG
LOCAL ExStyle AS LONG

%xbutton=35
%aantalbuttons=7
%xmenu=%aantalbuttons*%xbutton+6
%xbuttongrootte=32
%ybuttongrootte=12
LOCAL tekst AS STRING
LOCAL Resultaat AS LONG

TheEnd=0
Restart=0
DIM Txt(%maxaantal) 'maximaal aantal regels
HoofdMenu=1
KeepOnTop=%WS_EX_TOPMOST 'begin met on top blijven
'0 normaal 1 voor mini 2 voor uitgebreid

'----------------------------


Resultaat=TestOnline
' IF Resultaat=0 OR TheEnd=1 THEN MSGBOX..........

Resultaat=ReadInNewDataFiles
' IF Resultaat=0 OR TheEnd=1 THEN MSGBOX..........

hFont = MakeFont("Courier New",9) 'relies on a fixed font to have the colomns in line
Hoofdmenu=1
KeepOnTop=8
Toolbar =0
Grootte =0 'initieel 640x480

'------------------
WHILE TheEnd=0
Restart=0 'used to make a restart possible. Defaultly this is set to NO: no restart
ReadSettingsFromFile
IF Toolbar=0 THEN
'toolbar, so special tyles
Style = %WS_BORDER
ExStyle = KeepOnTop OR %WS_EX_TOOLWINDOW
ELSE
'no toolbar, so use the normal styles
Style = %WS_MINIMIZEBOX OR %WS_SYSMENU OR %WS_CAPTION
ExStyle = KeepOnTop
END IF

IF SaveLocatie= 1 THEN
SaveMenuX = XScreenSize/2-77
SaveMenuY = 0
END IF


'main menu (small bar)
DIALOG NEW 0,$titel,SaveMenuX,SaveMenuY, 116+(toolbar*25), 12+(1-toolbar)*12 ,Style, ExStyle TO hDlgMain
CONTROL ADD TEXTBOX,hDlgMain, %IDtelno, "", 1,1, 55 , 10, %ES_AUTOHSCROLL OR %WS_TABSTOP, %WS_EX_CLIENTEDGE
CONTROL ADD BUTTON, hDlgMain, %IDOpties,"&Options", 58,1, 30, 10, %BS_DEFPUSHBUTTON CALL Opties 'OR %WS_TABSTOP
IF Toolbar=0 THEN
CONTROL ADD BUTTON, hDlgMain, %IDHelp, "?", 91, 1, 10, 10, 0 CALL Help
CONTROL ADD BUTTON, hDlgMain, %IDAfsluiten, "X", 103, 1, 10, 10, 0 CALL CancelButton
ELSE
CONTROL ADD BUTTON, hDlgMain, %IDHelp, "Help", 91, 1, 20, 10, 0 CALL Help
CONTROL ADD BUTTON, hDlgMain, %IDAfsluiten, "Stop", 116, 1, 20, 10, 0 CALL CancelButton
END IF


IF Grootte=1 THEN
MenuX=650: MenuY=420
ELSE
MenuX=500: MenuY=310
END IF

'results dialog, initially hidden
DIALOG NEW 0, "Found: ",,, MenuX, MenuY TO hDlgResultaat
CONTROL ADD LISTBOX, hDlgResultaat, %IDlijst, Toon(), 5, 5, MenuX-10, MenuY-20 , %WS_BORDER OR %LBS_WANTKEYBOARDINPUT OR %WS_VSCROLL OR %WS_GROUP OR %WS_TABSTOP OR %LBS_NOINTEGRALHEIGHT OR %LBS_DISABLENOSCROLL OR %LBS_USETABSTOPS
CONTROL ADD LABEL,hDlgResultaat,%IDaantal,"Total number: "+STR$(TxtAantal)+" "+"Total found: ",5,MenuY-13,160,10
CONTROL ADD LABEL,hDlgResultaat,%IDbron,"Used source: "+pad,170,MenuY-13,320,10,%SS_RIGHT
DIALOG SHOW MODELESS hDlgResultaat
DIALOG DOEVENTS
DIALOG SHOW STATE hDlgResultaat, %SW_HIDE
DIALOG DOEVENTS
DIALOG SHOW STATE hDlgResultaat, %SW_HIDE

DIM Toon(%MaxToon)

DIALOG SHOW MODAL hDlgMain CALL DlgProc

IF SaveLocatie THEN
SchrijfInstellingen
END IF
DIALOG END hDlgMain,0
DIALOG DOEVENTS
IF Restart=0 THEN EXIT LOOP 'Only if Restart=1 then restart the whole thing
WEND
'echt afsluiten
DeleteObject hFont '<--- thanx to Lance, teached me to clean up afterwards
END FUNCTION