{ File select menu unit. Something like a FileListBox unit. You can select a file from a listbox and change directory or disk if needed (and allowed by the programmer: see the Attribut propertie.) Remarks ------- The (Y1 - Y0) value must be greater than 15. This means that the number of columns of the file select window must be at least of 16 characters. The flTouche will be used in order to know which key the user has pressed (13 for Enter key, 59 for F1 key, and so on) The Escape key or F10 key will terminate the selection without any filename in return of the function ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» º º° º AVONTURE CHRISTOPHE º° º AVC SOFTWARE º° º BOULEVARD EDMOND MACHTENS 157/53 º° º B-1080 BRUXELLES º° º BELGIQUE º° º º° ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ° °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° This is one of my very best unit. Please send me a postcard if you find it usefull. Thanks in advance! ==> Hey, is there somebody in the United States of America? I have <== ==> received postcard from severall country but none from the States <== ==> Be the first! <== } Unit FileList; Interface Const FlTouche : Byte = 0; { Key that the user has pressed } FName : String = ''; { Selected filename } Type Str14 = String[14]; FileListP = Record X0, X1, Y0, Y1 : Byte; { Window coordinates } TAttr : Byte; { Color of the window } TBarre : Byte; { Color of the select bar } Masque : Str14; { Mask - *.*, *.BAT, ... } Attribut : Word; { File attribut: only files matching this } { attribut will be displayed } ChgRep : Boolean; { Do we must return to the original path? } End; { The only public function. } Function GetFName (Donnees : FileListP) : String; Implementation Uses Crt, Dos; Type TCadre = Array [1..8] of Char; Const Double : Tcadre = ('É','Í','»','º','º','È','Í','¼'); MaxFich = 1024; { Max number of displayed file } Var NbrFich : Byte; { File number per line } NbrF : Byte; { Working variable } NbrFRep : Word; { Number of file find in the directory } TabF : Array [1..MaxFich] of Str14; { The directory... } I, J : Byte; DosFich : SearchRec; Rep : Byte; Disque : Byte; MaxF : Byte; X_Barre : Byte; Y_Barre : Byte; wPos : Byte; TBack : Byte; Complet : Boolean; { Is there several screen? } RepAct : String; { This function will return True if the disk exist, false otherwise } Function Disque_Exist (Disq: Byte) : Boolean; Assembler; Asm Push Ds Cmp Disq, 2 { Test if this is a floppy drive } Jbe @@A_or_B Mov Ax, 4409h { Hard disk or network one? } Mov Bl, Disq Int 21h Jc @@False Mov Ax, 1 Jmp @@Fin @@A_or_B: Mov Ah, 44h Mov Al, 0Eh Mov Bl, Disq Int 21h Cmp Al, Disq Jnz @@False Mov Ax, 1 Jmp @@Fin @@False: Mov Ax, 1500h { Test if the disk is a CD } Mov Bx, 0000h Int 2Fh Xor Ax, Ax Cmp Bx, 0 Jz @@Fin Inc Cl Cmp Cl, [Disq] Jne @@Fin Mov Ax, 1 @@Fin: Pop Ds End; { Write a string at the specified screen coordinates and with the given color attribut } Procedure WriteStrXY (X, Y, TAttr, TBack : Word; Texte : String); Var Offset : Word; i : Byte; Attr : Word; Begin offset := Y * 160 + X Shl 1; Attr := ((TAttr+(TBack Shl 4)) shl 8); For i:= 1 to Length (Texte) do Begin MemW[$B800:Offset] := Attr or Ord(Texte[i]); Inc (Offset,2); End; End; { Return the full filename } Function TrueName (FName : String) : String; Var Temp : String; Regs : Registers; Begin FName := FName + #0; Regs.Ah := $60; Regs.Ds := Seg(FName); Regs.Si := Ofs(FName[1]); Regs.Es := Seg(Temp); Regs.Di := Ofs(Temp[1]); Intr ($21, Regs); DosError := Regs.Ax * ((Regs.Flags And FCarry) shr 7); Temp[0] := #255; Temp[0] := Chr (Pos(#0, Temp) - 1); If DosError <> 0 then Temp := ''; TrueName := Temp; end; { Read a character on the screen at the specified coordinates } Procedure ReadCar (X, Y : word;Var Attr : Byte; Var Carac : Char); var Car : ^char; Attribut : ^Byte; Begin New (car); Car := ptr ($B800,(Y*160 + X Shl 1)); Carac := car^; New (attribut); Attribut := ptr ($B800,(Y*160 + X Shl 1 + 1)); Attr := attribut^; End; { Draw a cadre } Procedure Cadre (ColD, LigD, ColF, LigF, Attr, Back : Byte; Cad : TCadre); Var X, Y, I, Longueur, Hauteur : Byte; sLine : String; Begin X := WhereX; Y := WhereY; Longueur := (ColF-ColD)-1; Hauteur := (LigF-LigD)-1; WriteStrXy (ColD, LigD, Attr, Back, Cad[1]); FillChar (sLine[1], Longueur, Cad[2]); sLine [0] := Chr(Longueur); WriteStrXy (ColD+1, LigD, Attr, Back, sLine); WriteStrXy (ColD+1+Longueur, LigD, Attr, Back, Cad[3]); For i:= 1 To Hauteur Do Begin WriteStrXy (ColD, LigD+I, Attr, Back, Cad[4]); FillChar (sLine[1], Longueur, ' '); sLine [0] := Chr(Longueur); WriteStrXy (ColD+1, LigD+I, Attr, Back, sLine); WriteStrXy (ColD+1+Longueur, LigD+I, Attr, Back, Cad[5]); End; WriteStrXy (ColD, LigF, Attr, Back, Cad[6]); FillChar (sLine[1], Longueur, Cad[7]); sLine [0] := Chr(Longueur); WriteStrXy (ColD+1, LigF, Attr, Back, sLine); WriteStrXy (ColD+1+Longueur, LigF, Attr, Back, Cad[8]); GotoXy (X, Y); End; { Fill the TabF array with the name of each file found in the directory } Procedure SearchCurrentDir (Masque : Str14; Attribut : Word); Begin FillChar (TabF, SizeOf (TabF), ' '); { Initialize the array } I := 1; Disque := 0; If Disque_Exist (1) then Begin TabF[I] := '[A:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (2) then Begin TabF[I] := '[B:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (3) then Begin TabF[I] := '[C:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (4) then Begin TabF[I] := '[D:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (5) then Begin TabF[I] := '[E:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (6) then Begin TabF[I] := '[F:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (7) then Begin TabF[I] := '[G:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (8) then Begin TabF[I] := '[H:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (9) then Begin TabF[I] := '[I:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (10) then Begin TabF[I] := '[J:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (11) then Begin TabF[I] := '[K:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (12) then Begin TabF[I] := '[L:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (13) then Begin TabF[I] := '[M:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (14) then Begin TabF[I] := '[N:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (15) then Begin TabF[I] := '[O:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (16) then Begin TabF[I] := '[P:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (17) then Begin TabF[I] := '[Q:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (18) then Begin TabF[I] := '[R:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (19) then Begin TabF[I] := '[S:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (20) then Begin TabF[I] := '[T:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (21) then Begin TabF[I] := '[U:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (22) then Begin TabF[I] := '[V:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (23) then Begin TabF[I] := '[W:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (24) then Begin TabF[I] := '[X:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (25) then Begin TabF[I] := '[Y:..]'; Inc (I); Inc (Disque); End; If Disque_Exist (26) then Begin TabF[I] := '[Z:..]'; Inc (I); Inc (Disque); End; { Test if we can show path name or only file? } If ((Attribut and 16) = 16) then Begin { We can show path name } Rep := 0; FindFirst ('*.*', 16, DosFich); FindNext (DosFich); While DosError = 0 do Begin If (DosFich.Attr and Directory = Directory) then Begin { We have found a directory } TabF[I] := '<'+DosFich.Name+'>'; Inc (I); Inc (Rep); End; FindNext (DosFich); End; End; { Clear the attribute bit of Directory only } Attribut := Attribut and not 16; { Test if we can show file name or not } If Not (Attribut = 0) then Begin { We can show file name } FindFirst (Masque, Attribut, DosFich); While DosError = 0 do Begin If Not (DosFich.Attr and Attribut = 0) then Begin TabF[I] := DosFich.Name; Inc (I); End; FindNext (DosFich); End; End; NbrFRep := I - 1; End; { Write the filename or the path name } Procedure Prompt (X , Y, TAttr : Byte; Option : Str14); Begin GotoXY (X,Y); WriteStrXy (X, Y, TAttr, 0, Option); End; { Give the possibility to the user to select a name. } Function MChoix (X0, Y0, X1, Y1, X, Y, TAttr, TBarre : Byte) : String; { Handle the select bar } Procedure SurBrillance (X, TBarre : Byte); Var Attribut : Word; Offset : Word; i : Byte; Lig : Str14; Attr : Byte; Chh : Char; Begin offset := Y * 160 + X * 2; Lig := ''; For I := 0 to 12 Do Begin ReadCar (X+I, Y, Attr, Chh); Lig := Lig + Chh; End; For i:= 1 to 13 do Begin MemW[$B800:Offset] := (TBarre shl 8) or Ord(Lig[I]); Inc (Offset,2); End; End; { Construct the screen with the bar and the file/path name } Procedure Affiche (X0, Y0 : Byte; Depart : Word); Begin GotoXy (0,2); NbrF := 0; wPos := Depart; X_Barre := X0+2; Y_Barre := Y0+1; For J := Depart to (Depart+(MaxF*NbrFich)-1) do Begin If Not (J > NbrFRep) then Prompt (X_Barre, Y_Barre, TAttr, TabF[J]+' ') Else Prompt (X_Barre, Y_Barre, TAttr, ' '); Inc (NbrF); If Not (NbrF < NbrFich) then Begin Inc (Y_Barre); X_Barre := X0 + 2; NbrF := 0; End Else Inc (X_Barre, 13); End; End; { Main of MChoix function } Var Ch : Char; Begin GotoXy (X, Y); wPos := 1; SurBrillance (X, TBarre); Repeat Ch := Readkey; If Ch = #0 then Ch := Readkey; SurBrillance (X, TAttr); Case Ch Of #72 : Begin {UpKey} If Complet then Begin If (wPos - NbrFich - 1 < NbrFRep) then Begin Dec (Y); Dec (wPos, NbrFich); End; End Else If ((Y-1 = Y0) and (Not (wPos - 1 < NbrFich))) then Begin wPos := wPos - (((X - X0) Div 13)); Affiche (X0, Y0, Abs(wPos-(NbrFich*MaxF))); X := X0 + 2; Y := Y0 + 1; End Else If Not (wPos - NbrFich - 1 < 0) then Begin Dec (Y); Dec (wPos, NbrFich); End Else If Not (wPos - 1 > NbrFRep) then Begin If (wPos - NbrFich - 1 < NbrFRep) then Begin Dec (Y); Dec (wPos, NbrFich); End; End; End; #80 : Begin {DownKey} If Complet then Begin If (wPos + NbrFich -1 < NbrFRep) then Begin Inc (Y); inc (wPos, NbrFich); End End Else If (wPos + NbrFich - 1 < NbrFich*MaxF) then Begin Inc (Y); inc (wPos, NbrFich); End Else If (Y+1 = Y1) then Begin wPos := wPos - (((X - X0) Div 13)); Affiche (X0, Y0, wPos+NbrFich); X := X0 + 2; Y := Y0 + 1; End Else If Not (wPos + 1 > NbrFRep) then Begin If (wPos + NbrFich - 1< NbrFRep) then Begin Inc (Y); inc (wPos, NbrFich); End; End; End; #77 : Begin {Right} If Complet then Begin If Not (wPos+1 > NbrFRep) then Begin If Not (X + 13 > (X0+(NbrFich-1)*(13)+2)) then Begin Inc (X, 13); Inc (wPos); End Else If Not (Y > Y0 + (NbrFRep Div NbrFich)) then Begin X := X0 + 2; Inc (Y); Inc (wPos); End; End End Else Begin If Not (wPos+1 > NbrFich*MaxF) then Begin If Not (X + 13 > (X0+(NbrFich-1)*(13)+2)) then Begin Inc (X, 13); Inc (wPos); End Else If Not (Y > Y0 + (NbrFich*MaxF Div NbrFich)) then Begin X := X0 + 2; Inc (Y); Inc (wPos); End; End Else If ((Y+1 = Y1) and ((((X - X0) Div 13 ) + 1) = NbrFich)) then Begin Affiche (X0, Y0, wPos+1); X := X0 + 2; Y := Y0 + 1; End Else If Not (wPos + 1 > NbrFRep) then Begin If Not (X + 13 > (X0+(NbrFich-1)*(13)+2)) then Begin Inc (X, 13); Inc (wPos); End Else If Not (Y > Y0 + (NbrFich*MaxF Div NbrFich)) then Begin X := X0 + 2; Inc (Y); Inc (wPos); End; End; End End; #75 : Begin {Left} If Complet then Begin If Not (X = X0+2) then Begin Dec (X, 13); Dec (wPos); End Else If Not (Y < Y0 + 2) then Begin X := X0+((NbrFich-1)*(13)+2); Dec (Y); Dec (wPos); End; End Else If ((Y-1 = Y0) and ((((X - X0) Div 13) = 0)) and Not (wPos = 1)) then Begin wPos := wPos - (((X - X0) Div 13)); Affiche (X0, Y0, Abs(wPos-(NbrFich*MaxF))); X := X0 + 2; Y := Y0 + 1; End Else If Not (X = X0+2) then Begin Dec (wPos); Dec (X, 13); End Else If Not (Y < Y0 + 2) then Begin X := X0+((NbrFich-1)*(13)+2); Dec (Y); Dec (wPos); End; End; End; GotoXy (X, Y); SurBrillance (X, TBarre); { Only Enter key, Escape key or Function key (F1-F10) can stopped the selection } Until (Ch in [#13, #27, #59..#68]); { FLTouche retains the value of the pressed key } FLTouche := Ord(Ch); { If the pressed key is not F10 or Escape then return the filename } If ((Ch = #27) or (Ch = #68)) then MChoix := '' Else MChoix := TabF[wPos]; End; { The only function public. } Function GetFName (Donnees : FileListP) : String; Var FinJ : Word; NomRep : String; Begin TBack := TextAttr; With Donnees Do Begin TextAttr := TAttr; { The window must be at least 17 columns great } If (X1 - X0 < 16) then X1 := X0 + 16; { Process the number of file per line } NbrFich := ((( X1 - X0) - 2) Div 13); Repeat { Show the current directory } SearchCurrentDir (Masque, Attribut); MaxF := Y1 - Y0 - 1; { Draw a cadre on the screen } Cadre (X0, Y0, X1, Y1, (TAttr And $F), (TAttr Shr 4), Double); X_Barre := X0 + 2; Y_Barre := Y0 + 1; NbrF := 0; If (NbrFRep > MaxF * NbrFich) then Begin FinJ := MaxF*NbrFich; Complet := False; End Else Begin FinJ := NbrFRep; Complet := True; End; For J := 1 to FinJ do Begin Prompt (X_Barre, Y_Barre, TAttr, TabF[J]); Inc (NbrF); If Not (NbrF < NbrFich) then Begin Inc (Y_Barre); X_Barre := X0 + 2; NbrF := 0; End Else Inc (X_Barre, 13); End; { Give the possibility to the user to select a file/path name or another disk } FName := MChoix (X0, Y0, X1, Y1, X0+2, Y0+1, TAttr, TBarre); gotoxy (0,0); If Not ((FLTouche = 27) or (FLTouche = 68)) then Begin If Not (wPos > Disque + Rep) then Begin { The user has pressed the Enter key on a disk specification or on a path name } FName := ''; FLTouche := 0; End; If Not (wPos > Disque) then Begin { Change the active disk } NomRep := Copy (TabF[wPos], 2, 2); {$I-} ChDir (NomRep); {$I+} End Else If Not (wPos > Disque+Rep) then Begin { Change the current path } NomRep := Copy (TabF[wPos], 2, Length(TabF[wPos]) - 2); {$I-} ChDir (NomRep); {$I+} End; End Else ChDir (RepAct); Until Not ((FLTouche = 0) and (FName = '')); { Return the selected file name } If Not (FName = '') then GetFName := TrueName (FName) Else GetFName := FName; If ChgRep then ChDir (RepAct); End; TextAttr := TBack; End; Begin RepAct := TrueName (ParamStr(0)); { Save the current path } For J := Length (RepAct) Downto 1 do If RepAct[J] = '\' then Begin I := J; J := 1; End; RepAct := Copy (RepAct, 1, I-1); End. { ----------------------------- cut here -------------------------------- } { Example of the file select menu unit ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» º º° º AVONTURE CHRISTOPHE º° º AVC SOFTWARE º° º BOULEVARD EDMOND MACHTENS 157/53 º° º B-1080 BRUXELLES º° º BELGIQUE º° º º° ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ° °°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°°° } { Include the FileList unit } Uses Crt, Filelist; { What you must do: declare a variable based on the FileListP type and initialized it in your code } Var FFilelist : FileListP; NomF : String; { Stored the full name of the selected file } Begin ClrScr; { If you set the Attribut propertie to "AnyFile - VolumeId - Directoy" then the user can't change directory. So he must select a file from the current directory with no possibility to go to other directory or disk! For a list of value, see the SearchRec function in the DOS unit: values used by my unit are the same. Remember that the (Y1 - Y0) value must be greater than 15. If no, the unit will automatically set the Y1 value to (15 - Y0) + Y1. The Masque propertie is the DOS match pattern: works exactly like the SearchRec function. The TAttr value represent the color -0 to 255- of the window. Exactly like the Attr CRT variable. The TBarre value represent the color -0 to 255- of the main bar: the bar with it you can select a file, directory or drive. Exactly like the Attr CRT variable. You the user has select a file (and perhaps changed drive and/or directory), the ChgRep value specifies to your program if the unit must go back to the original path after the selection or not. The original path is the current path just before the GetFName function is called. } With FFileList Do Begin X0 := 6; { Size } X1 := 78; { of } Y0 := 3; { the } Y1 := 17; { window } TAttr := 30; { window color attribut } TBarre := 57; { bar color attribut } Masque := '*.*'; { File Mask } Attribut := $3F-$08; { AnyFile - VolumeId } ChgRep := True; { Return to original path } End; { Call the filename selector } NomF := GetFName (FFileList); { Here a file has been selected and his full name if stored in NomF. } ClrScr; { And show the selected file name. A file is select only the user press on the Enter key under the filename. If the user has pressed the Escape Key or a function key (from F1 to F10), then the result of the GetFName function is emtpy. So, in this example, the NomF variable is equal to "" and the flTouche is set to the ASCII value of the Key: 13 if Enter, 27 if Escape, 59 if F1, 60 if F2, ... The flTouche variable is declared in the unit so don't declared it again } Writeln ('Selected file : ',NomF,' ... Key pressed (ASCII value) ',flTouche); End.