home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / bpos2tv.zip / STDDLG.PAS < prev    next >
Pascal/Delphi Source File  |  1994-04-02  |  37KB  |  1,450 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Turbo Pascal Version 7.0                        }
  5. {       Turbo Vision Unit                               }
  6. {                                                       }
  7. {       Copyright (c) 1992 Borland International        }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit StdDlg;
  12.  
  13. {$O+,F+,V-,X+,I-,S-}
  14.  
  15. interface
  16.  
  17. uses Objects, Drivers, Views, Dialogs, Dos;
  18.  
  19. const
  20.  
  21. { Commands }
  22.  
  23.   cmFileOpen    = 800;   { Returned from TFileDialog when Open pressed }
  24.   cmFileReplace = 801;   { Returned from TFileDialog when Replace pressed }
  25.   cmFileClear   = 802;   { Returned from TFileDialog when Clear pressed }
  26.   cmFileInit    = 803;   { Used by TFileDialog internally }
  27.   cmChDir       = 804;   { Used by TChDirDialog internally }
  28.   cmRevert      = 805;   { Used by TChDirDialog internally }
  29.  
  30. { Messages }
  31.  
  32.   cmFileFocused = 806;    { A new file was focused in the TFileList }
  33.   cmFileDoubleClicked     { A file was selected in the TFileList }
  34.                 = 807;
  35.  
  36. type
  37.  
  38.   { TSearchRec }
  39.  
  40.   {  Record used to store directory information by TFileDialog }
  41.  
  42.   TSearchRec = record
  43.     Attr: Byte;
  44.     Time: Longint;
  45.     Size: Longint;
  46.     Name: string[80];
  47.   end;
  48.  
  49. type
  50.  
  51.   { TFileInputLine is a special input line that is used by      }
  52.   { TFileDialog that will update its contents in response to a  }
  53.   { cmFileFocused command from a TFileList.                     }
  54.  
  55.   PFileInputLine = ^TFileInputLine;
  56.   TFileInputLine = object(TInputLine)
  57.     constructor Init(var Bounds: TRect; AMaxLen: Integer);
  58.     procedure HandleEvent(var Event: TEvent); virtual;
  59.   end;
  60.  
  61.   { TFileCollection is a collection of TSearchRec's.            }
  62.  
  63.   PFileCollection = ^TFileCollection;
  64.   TFileCollection = object(TSortedCollection)
  65.     function Compare(Key1, Key2: Pointer): Integer; virtual;
  66.     procedure FreeItem(Item: Pointer); virtual;
  67.     function GetItem(var S: TStream): Pointer; virtual;
  68.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  69.   end;
  70.  
  71.   { TSortedListBox is a TListBox that assumes it has a          }
  72.   { TStoredCollection instead of just a TCollection.  It will   }
  73.   { perform an incremental search on the contents.              }
  74.  
  75.   PSortedListBox = ^TSortedListBox;
  76.   TSortedListBox = object(TListBox)
  77.     SearchPos: Word;
  78.     ShiftState: Byte;
  79.     constructor Init(var Bounds: TRect; ANumCols: Word;
  80.       AScrollBar: PScrollBar);
  81.     procedure HandleEvent(var Event: TEvent); virtual;
  82.     function GetKey(var S: String): Pointer; virtual;
  83.     procedure NewList(AList: PCollection); virtual;
  84.   end;
  85.  
  86.   { TFileList is a TSortedList box that assumes it contains     }
  87.   { a TFileCollection as its collection.  It also communicates  }
  88.   { through broadcast messages to TFileInput and TInfoPane      }
  89.   { what file is currently selected.                            }
  90.  
  91.   PFileList = ^TFileList;
  92.   TFileList = object(TSortedListBox)
  93.     constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
  94.     destructor Done; virtual;
  95.     function DataSize: Word; virtual;
  96.     procedure FocusItem(Item: Integer); virtual;
  97.     procedure GetData(var Rec); virtual;
  98.     function GetText(Item: Integer; MaxLen: Integer): String; virtual;
  99.     function GetKey(var S: String): Pointer; virtual;
  100.     procedure HandleEvent(var Event: TEvent); virtual;
  101.     procedure ReadDirectory(AWildCard: PathStr);
  102.     procedure SetData(var Rec); virtual;
  103.   end;
  104.  
  105.   { TFileInfoPane is a TView that displays the information      }
  106.   { about the currently selected file in the TFileList          }
  107.   { of a TFileDialog.                                           }
  108.  
  109.   PFileInfoPane = ^TFileInfoPane;
  110.   TFileInfoPane = object(TView)
  111.     S: TSearchRec;
  112.     constructor Init(var Bounds: TRect);
  113.     procedure Draw; virtual;
  114.     function GetPalette: PPalette; virtual;
  115.     procedure HandleEvent(var Event: TEvent); virtual;
  116.   end;
  117.  
  118.   { TFileDialog is a standard file name input dialog            }
  119.  
  120.   TWildStr = PathStr;
  121.  
  122. const
  123.   fdOkButton      = $0001;      { Put an OK button in the dialog }
  124.   fdOpenButton    = $0002;      { Put an Open button in the dialog }
  125.   fdReplaceButton = $0004;      { Put a Replace button in the dialog }
  126.   fdClearButton   = $0008;      { Put a Clear button in the dialog }
  127.   fdHelpButton    = $0010;      { Put a Help button in the dialog }
  128.   fdNoLoadDir     = $0100;      { Do not load the current directory }
  129.                                 { contents into the dialog at Init. }
  130.                                 { This means you intend to change the }
  131.                                 { WildCard by using SetData or store }
  132.                                 { the dialog on a stream. }
  133.  
  134. type
  135.  
  136.   PFileDialog = ^TFileDialog;
  137.   TFileDialog = object(TDialog)
  138.     FileName: PFileInputLine;
  139.     FileList: PFileList;
  140.     WildCard: TWildStr;
  141.     Directory: PString;
  142.     constructor Init(AWildCard: TWildStr; const ATitle,
  143.       InputName: String; AOptions: Word; HistoryId: Byte);
  144.     constructor Load(var S: TStream);
  145.     destructor Done; virtual;
  146.     procedure GetData(var Rec); virtual;
  147.     procedure GetFileName(var S: PathStr);
  148.     procedure HandleEvent(var Event: TEvent); virtual;
  149.     procedure SetData(var Rec); virtual;
  150.     procedure Store(var S: TStream);
  151.     function Valid(Command: Word): Boolean; virtual;
  152.   private
  153.     procedure ReadDirectory;
  154.   end;
  155.  
  156.   { TDirEntry }
  157.  
  158.   PDirEntry = ^TDirEntry;
  159.   TDirEntry = record
  160.     DisplayText: PString;
  161.     Directory: PString;
  162.   end;
  163.  
  164.   { TDirCollection is a collection of TDirEntry's used by       }
  165.   { TDirListBox.                                                }
  166.  
  167.   PDirCollection = ^TDirCollection;
  168.   TDirCollection = object(TCollection)
  169.     function GetItem(var S: TStream): Pointer; virtual;
  170.     procedure FreeItem(Item: Pointer); virtual;
  171.     procedure PutItem(var S: TStream; Item: Pointer); virtual;
  172.   end;
  173.  
  174.   { TDirListBox displays a tree of directories for use in the }
  175.   { TChDirDialog.                                               }
  176.  
  177.   PDirListBox = ^TDirListBox;
  178.   TDirListBox = object(TListBox)
  179.     Dir: DirStr;
  180.     Cur: Word;
  181.     constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
  182.     destructor Done; virtual;
  183.     function GetText(Item: Integer; MaxLen: Integer): String; virtual;
  184.     procedure HandleEvent(var Event: TEvent); virtual;
  185.     function IsSelected(Item: Integer): Boolean; virtual;
  186.     procedure NewDirectory(var ADir: DirStr);
  187.     procedure SetState(AState: Word; Enable: Boolean); virtual;
  188.   end;
  189.  
  190.   { TChDirDialog is a standard change directory dialog.         }
  191.  
  192. const
  193.   cdNormal     = $0000; { Option to use dialog immediately }
  194.   cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
  195.   cdHelpButton = $0002; { Put a help button in the dialog }
  196.  
  197. type
  198.  
  199.   PChDirDialog = ^TChDirDialog;
  200.   TChDirDialog = object(TDialog)
  201.     DirInput: PInputLine;
  202.     DirList: PDirListBox;
  203.     OkButton: PButton;
  204.     ChDirButton: PButton;
  205.     constructor Init(AOptions: Word; HistoryId: Word);
  206.     constructor Load(var S: TStream);
  207.     function DataSize: Word; virtual;
  208.     procedure GetData(var Rec); virtual;
  209.     procedure HandleEvent(var Event: TEvent); virtual;
  210.     procedure SetData(var Rec); virtual;
  211.     procedure Store(var S: TStream);
  212.     function Valid(Command: Word): Boolean; virtual;
  213.   private
  214.     procedure SetUpDialog;
  215.   end;
  216.  
  217. const
  218.  
  219.   CInfoPane = #30;
  220.  
  221.   { TStream registration records }
  222.  
  223. const
  224.   RFileInputLine: TStreamRec = (
  225.      ObjType: 60;
  226.      VmtLink: Ofs(TypeOf(TFileInputLine)^);
  227.      Load:    @TFileInputLine.Load;
  228.      Store:   @TFileInputLine.Store
  229.   );
  230.  
  231. const
  232.   RFileCollection: TStreamRec = (
  233.      ObjType: 61;
  234.      VmtLink: Ofs(TypeOf(TFileCollection)^);
  235.      Load:    @TFileCollection.Load;
  236.      Store:   @TFileCollection.Store
  237.   );
  238.  
  239. const
  240.   RFileList: TStreamRec = (
  241.      ObjType: 62;
  242.      VmtLink: Ofs(TypeOf(TFileList)^);
  243.      Load:    @TFileList.Load;
  244.      Store:   @TFileList.Store
  245.   );
  246.  
  247. const
  248.   RFileInfoPane: TStreamRec = (
  249.      ObjType: 63;
  250.      VmtLink: Ofs(TypeOf(TFileInfoPane)^);
  251.      Load:    @TFileInfoPane.Load;
  252.      Store:   @TFileInfoPane.Store
  253.   );
  254.  
  255. const
  256.   RFileDialog: TStreamRec = (
  257.      ObjType: 64;
  258.      VmtLink: Ofs(TypeOf(TFileDialog)^);
  259.      Load:    @TFileDialog.Load;
  260.      Store:   @TFileDialog.Store
  261.   );
  262.  
  263. const
  264.   RDirCollection: TStreamRec = (
  265.      ObjType: 65;
  266.      VmtLink: Ofs(TypeOf(TDirCollection)^);
  267.      Load:    @TDirCollection.Load;
  268.      Store:   @TDirCollection.Store
  269.   );
  270.  
  271. const
  272.   RDirListBox: TStreamRec = (
  273.      ObjType: 66;
  274.      VmtLink: Ofs(TypeOf(TDirListBox)^);
  275.      Load:    @TDirListBox.Load;
  276.      Store:   @TDirListBox.Store
  277.   );
  278.  
  279. const
  280.   RChDirDialog: TStreamRec = (
  281.      ObjType: 67;
  282.      VmtLink: Ofs(TypeOf(TChDirDialog)^);
  283.      Load:    @TChDirDialog.Load;
  284.      Store:   @TChDirDialog.Store
  285.   );
  286.  
  287. const
  288.   RSortedListBox: TStreamRec = (
  289.      ObjType: 68;
  290.      VmtLink: Ofs(TypeOf(TSortedListBox)^);
  291.      Load:    @TSortedListBox.Load;
  292.      Store:   @TSortedListBox.Store
  293.   );
  294.  
  295. procedure RegisterStdDlg;
  296.  
  297. implementation
  298.  
  299. uses App, Memory, HistList, MsgBox, BSEDos;
  300.  
  301. function DriveValid(Drive: Char): Boolean; near;
  302. var
  303.   Disk : word;
  304.   Mask : longint;
  305. begin
  306.   DosQCurDisk(@Disk, @Mask);
  307.   DriveValid := Mask and (longint(1) shl (ord(upcase(Drive))-ord('A'))) <> 0;
  308. end;
  309.  
  310. function PathValid(var Path: PathStr): Boolean;
  311. var
  312.   ExpPath: PathStr;
  313.   SR: SearchRec;
  314. begin
  315.   ExpPath := FExpand(Path);
  316.   if Length(ExpPath) <= 3 then PathValid := DriveValid(ExpPath[1])
  317.   else
  318.   begin
  319.     if ExpPath[Length(ExpPath)] = '\' then Dec(ExpPath[0]);
  320.     FindFirst(ExpPath, Directory, SR);
  321.     PathValid := (Dos.DosError = 0) and (SR.Attr and Directory <> 0);
  322.   end;
  323. end;
  324.  
  325. function ValidFileName(var FileName: PathStr): Boolean;
  326. const
  327.   IllegalChars = ';,=+<>|"[] \';
  328. var
  329.   Dir: DirStr;
  330.   Name: NameStr;
  331.   Ext: ExtStr;
  332.  
  333. { Contains returns true if S1 contains any characters in S2 }
  334. function Contains(S1, S2: String): Boolean; near; assembler;
  335. asm
  336.     PUSH    DS
  337.         CLD
  338.         LDS    SI,S1
  339.         LES    DI,S2
  340.         MOV    DX,DI
  341.         XOR    AH,AH
  342.         LODSB
  343.         MOV    BX,AX
  344.         OR      BX,BX
  345.         JZ      @@2
  346.         MOV    AL,ES:[DI]
  347.         XCHG    AX,CX
  348. @@1:    PUSH    CX
  349.     MOV    DI,DX
  350.     LODSB
  351.         REPNE    SCASB
  352.         POP    CX
  353.         JE    @@3
  354.     DEC    BX
  355.         JNZ    @@1
  356. @@2:    XOR    AL,AL
  357.     JMP    @@4
  358. @@3:    MOV    AL,1
  359. @@4:    POP    DS
  360. end;
  361.  
  362. begin
  363.   ValidFileName := True;
  364.   FSplit(FileName, Dir, Name, Ext);
  365.   if not ((Dir = '') or PathValid(Dir)) or Contains(Name, IllegalChars) or
  366.     Contains(Dir, IllegalChars) then ValidFileName := False;
  367. end;
  368.  
  369. function GetCurDir: DirStr;
  370. var
  371.   CurDir: DirStr;
  372. begin
  373.   GetDir(0, CurDir);
  374.   if Length(CurDir) > 3 then
  375.   begin
  376.     Inc(CurDir[0]);
  377.     CurDir[Length(CurDir)] := '\';
  378.   end;
  379.   GetCurDir := CurDir;
  380. end;
  381.  
  382. type
  383.   PSearchRec = ^TSearchRec;
  384.  
  385. function IsWild(const S: String): Boolean;
  386. begin
  387.   IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
  388. end;
  389.  
  390. function IsDir(const S: String): Boolean;
  391. var
  392.   SR: SearchRec;
  393. begin
  394.   FindFirst(S, Directory, SR);
  395.   if Dos.DosError = 0 then
  396.     IsDir := SR.Attr and Directory <> 0
  397.   else IsDir := False;
  398. end;
  399.  
  400. { TFileInputLine }
  401.  
  402. constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Integer);
  403. begin
  404.   TInputLine.Init(Bounds, AMaxLen);
  405.   EventMask := EventMask or evBroadcast;
  406. end;
  407.  
  408. procedure TFileInputLine.HandleEvent(var Event: TEvent);
  409. var
  410.   Dir: DirStr;
  411.   Name: NameStr;
  412.   Ext: ExtStr;
  413. begin
  414.   TInputLine.HandleEvent(Event);
  415.   if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
  416.     (State and sfSelected = 0) then
  417.   begin
  418.      if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
  419.         Data^ := PSearchRec(Event.InfoPtr)^.Name + '\'+
  420.           PFileDialog(Owner)^.WildCard
  421.      else Data^ := PSearchRec(Event.InfoPtr)^.Name;
  422.      DrawView;
  423.   end;
  424. end;
  425.  
  426. { TFileCollection }
  427.  
  428. function TFileCollection.Compare(Key1, Key2: Pointer): Integer;
  429. begin
  430.   if PSearchRec(Key1)^.Name = PSearchRec(Key2)^.Name then Compare := 0
  431.   else if PSearchRec(Key1)^.Name = '..' then Compare := 1
  432.   else if PSearchRec(Key2)^.Name = '..' then Compare := -1
  433.   else if (PSearchRec(Key1)^.Attr and Directory <> 0) and
  434.      (PSearchRec(Key2)^.Attr and Directory = 0) then Compare := 1
  435.   else if (PSearchRec(Key2)^.Attr and Directory <> 0) and
  436.      (PSearchRec(Key1)^.Attr and Directory = 0) then Compare := -1
  437.   else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
  438.     Compare := 1
  439.   else Compare := -1;
  440. end;
  441.  
  442. procedure TFileCollection.FreeItem(Item: Pointer);
  443. begin
  444.   Dispose(PSearchRec(Item));
  445. end;
  446.  
  447. function TFileCollection.GetItem(var S: TStream): Pointer;
  448. var
  449.   Item: PSearchRec;
  450. begin
  451.   New(Item);
  452.   S.Read(Item^, SizeOf(TSearchRec));
  453.   GetItem := Item;
  454. end;
  455.  
  456. procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
  457. begin
  458.   S.Write(Item^, SizeOf(TSearchRec));
  459. end;
  460.  
  461. { TSortedListBox }
  462.  
  463. constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Word;
  464.   AScrollBar: PScrollBar);
  465. begin
  466.   TListBox.Init(Bounds, ANumCols, AScrollBar);
  467.   SearchPos := 0;
  468.   ShowCursor;
  469.   SetCursor(1,0);
  470. end;
  471.  
  472. procedure TSortedListBox.HandleEvent(var Event: TEvent);
  473. var
  474.   CurString, NewString: String;
  475.   K: Pointer;
  476.   Value, OldPos, OldValue: Integer;
  477.   T: Boolean;
  478.  
  479. function Equal(const S1, S2: String; Count: Word): Boolean;
  480. var
  481.   I: Word;
  482. begin
  483.   Equal := False;
  484.   if (Length(S1) < Count) or (Length(S2) < Count) then Exit;
  485.   for I := 1 to Count do
  486.     if UpCase(S1[I]) <> UpCase(S2[I]) then Exit;
  487.   Equal := True;
  488. end;
  489.  
  490. begin
  491.   OldValue := Focused;
  492.   TListBox.HandleEvent(Event);
  493.   if OldValue <> Focused then SearchPos := 0;
  494.   if Event.What = evKeyDown then
  495.   begin
  496.     if Event.CharCode <> #0 then
  497.     begin
  498.       Value := Focused;
  499.       if Value < Range then CurString := GetText(Value, 255)
  500.       else CurString := '';
  501.       OldPos := SearchPos;
  502.       if Event.KeyCode = kbBack then
  503.       begin
  504.         if SearchPos = 0 then Exit;
  505.         Dec(SearchPos);
  506.         if SearchPos = 0 then ShiftState := GetShiftState;
  507.         CurString[0] := Char(SearchPos);
  508.       end
  509.       else if (Event.CharCode = '.') then SearchPos := Pos('.',CurString)
  510.       else
  511.       begin
  512.         Inc(SearchPos);
  513.         if SearchPos = 1 then ShiftState := GetShiftState;
  514.         CurString[0] := Char(SearchPos);
  515.         CurString[SearchPos] := Event.CharCode;
  516.       end;
  517.       K := GetKey(CurString);
  518.       T := PSortedCollection(List)^.Search(K, Value);
  519.       if Value < Range then
  520.       begin
  521.         if Value < Range then NewString := GetText(Value, 255)
  522.         else NewString := '';
  523.         if Equal(NewString, CurString, SearchPos) then
  524.         begin
  525.           if Value <> OldValue then
  526.           begin
  527.             FocusItem(Value);
  528.             { Assumes ListControl will set the cursor to the first character }
  529.             { of the sfFocused item }
  530.             SetCursor(Cursor.X+SearchPos, Cursor.Y);
  531.           end
  532.           else SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
  533.         end
  534.         else SearchPos := OldPos;
  535.       end
  536.       else SearchPos := OldPos;
  537.       if (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
  538.         ClearEvent(Event);
  539.     end;
  540.   end;
  541. end;
  542.  
  543. function TSortedListBox.GetKey(var S: String): Pointer;
  544. begin
  545.   GetKey := @S;
  546. end;
  547.  
  548. procedure TSortedListBox.NewList(AList: PCollection);
  549. begin
  550.   TListBox.NewList(AList);
  551.   SearchPos := 0;
  552. end;
  553.  
  554. { TFileList }
  555.  
  556. constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
  557. begin
  558.   TSortedListBox.Init(Bounds, 2, AScrollBar);
  559. end;
  560.  
  561. destructor TFileList.Done;
  562. begin
  563.   if List <> nil then Dispose(List, Done);
  564.   TListBox.Done;
  565. end;
  566.  
  567. function TFileList.DataSize: Word;
  568. begin
  569.   DataSize := 0;
  570. end;
  571.  
  572. procedure TFileList.FocusItem(Item: Integer);
  573. begin
  574.   TSortedListBox.FocusItem(Item);
  575.   Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
  576. end;
  577.  
  578. procedure TFileList.GetData(var Rec);
  579. begin
  580. end;
  581.  
  582. function TFileList.GetKey(var S: String): Pointer;
  583. const
  584.   SR: TSearchRec = ();
  585.  
  586. procedure UpStr(var S: String);
  587. var
  588.   I: Integer;
  589. begin
  590.   for I := 1 to Length(S) do S[I] := UpCase(S[I]);
  591. end;
  592.  
  593. begin
  594.   if (ShiftState and $03 <> 0) or ((S <> '') and (S[1]='.')) then
  595.     SR.Attr := Directory
  596.   else SR.Attr := 0;
  597.   SR.Name := S;
  598.   UpStr(SR.Name);
  599.   GetKey := @SR;
  600. end;
  601.  
  602. function TFileList.GetText(Item: Integer; MaxLen: Integer): String;
  603. var
  604.   S: String;
  605.   SR: PSearchRec;
  606. begin
  607.   SR := PSearchRec(List^.At(Item));
  608.   S := SR^.Name;
  609.   if SR^.Attr and Directory <> 0 then
  610.   begin
  611.     S[Length(S)+1] := '\';
  612.     Inc(S[0]);
  613.   end;
  614.   GetText := S;
  615. end;
  616.  
  617. procedure TFileList.HandleEvent(var Event: TEvent);
  618. begin
  619.   if (Event.What = evMouseDown) and (Event.Double) then
  620.   begin
  621.     Event.What := evCommand;
  622.     Event.Command := cmOK;
  623.     PutEvent(Event);
  624.     ClearEvent(Event);
  625.   end
  626.   else TSortedListBox.HandleEvent(Event);
  627. end;
  628.  
  629. procedure TFileList.ReadDirectory(AWildCard: PathStr);
  630. const
  631.   FindAttr = ReadOnly + Archive;
  632.   AllFiles = '*.*';
  633.   PrevDir  = '..';
  634. var
  635.   S: SearchRec;
  636.   P: PSearchRec;
  637.   FileList: PFileCollection;
  638.   NumFiles: Word;
  639.   CurPath: PathStr;
  640.   Dir: DirStr;
  641.   Name: NameStr;
  642.   Ext: ExtStr;
  643.   Event: TEvent;
  644.   Tmp: PathStr;
  645.   Flag: Integer;
  646. begin
  647.   NumFiles := 0;
  648.   AWildCard := FExpand(AWildCard);
  649.   FSplit(AWildCard, Dir, Name, Ext);
  650.   FileList := New(PFileCollection, Init(5, 5));
  651.   FindFirst(AWildCard, FindAttr, S);
  652.   P := @P;
  653.   while (P <> nil) and (Dos.DosError = 0) do
  654.   begin
  655.     if (S.Attr and Directory = 0) then
  656.     begin
  657.       P := MemAlloc(SizeOf(P^));
  658.       if P <> nil then
  659.       begin
  660.         Move(S.Attr, P^, SizeOf(P^));
  661.         FileList^.Insert(P);
  662.       end;
  663.     end;
  664.     FindNext(S);
  665.   end;
  666.   Tmp := Dir + AllFiles;
  667.   FindFirst(Tmp, Directory, S);
  668.   while (P <> nil) and (Dos.DosError = 0) do
  669.   begin
  670.     if (S.Attr and Directory <> 0) and (S.Name[1] <> '.') then
  671.     begin
  672.       P := MemAlloc(SizeOf(P^));
  673.       if P <> nil then
  674.       begin
  675.         Move(S.Attr, P^, SizeOf(P^));
  676.         FileList^.Insert(PObject(P));
  677.       end;
  678.     end;
  679.     FindNext(S);
  680.   end;
  681.   if Length(Dir) > 4 then
  682.   begin
  683.     P := MemAlloc(SizeOf(P^));
  684.     if P <> nil then
  685.     begin
  686.       FindFirst(Tmp, Directory, S);
  687.       FindNext(S);
  688.       if (Dos.DosError = 0) and (S.Name = PrevDir) then
  689.         Move(S.Attr, P^, SizeOf(P^))
  690.       else
  691.       begin
  692.         P^.Name := PrevDir;
  693.         P^.Size := 0;
  694.         P^.Time := $210000;
  695.         P^.Attr := Directory;
  696.       end;
  697.       FileList^.Insert(PObject(P));
  698.     end;
  699.   end;
  700.   if P = nil then MessageBox('Too many files.', nil, mfOkButton + mfWarning);
  701.   NewList(FileList);
  702.   if List^.Count > 0 then
  703.   begin
  704.     Event.What := evBroadcast;
  705.     Event.Command := cmFileFocused;
  706.     Event.InfoPtr := List^.At(0);
  707.     Owner^.HandleEvent(Event);
  708.   end;
  709. end;
  710.  
  711. procedure TFileList.SetData(var Rec);
  712. begin
  713.   with PFileDialog(Owner)^ do
  714.     Self.ReadDirectory(Directory^ + WildCard);
  715. end;
  716.  
  717. { TFileInfoPane }
  718.  
  719. constructor TFileInfoPane.Init(var Bounds: TRect);
  720. begin
  721.   TView.Init(Bounds);
  722.   EventMask := EventMask or evBroadcast;
  723. end;
  724.  
  725. procedure TFileInfoPane.Draw;
  726. var
  727.   B: TDrawBuffer;
  728.   D: String[9];
  729.   M: String[3];
  730.   PM: Boolean;
  731.   Color: Word;
  732.   Time: Dos.DateTime;
  733.   Path: PathStr;
  734.   FmtId: String;
  735.   Params: array[0..7] of LongInt;
  736.   Str: String[80];
  737. const
  738.   sDirectoryLine = ' %-12s %-9s %3s %2d, %4d  %2d:%02d%cm';
  739.   sFileLine      = ' %-12s %-9d %3s %2d, %4d  %2d:%02d%cm';
  740.   Month: array[1..12] of String[3] =
  741.     ('Jan','Feb','Mar','Apr','May','Jun',
  742.      'Jul','Aug','Sep','Oct','Nov','Dec');
  743. begin
  744.   { Display path }
  745.   Path := FExpand(PFileDialog(Owner)^.Directory^+PFileDialog(Owner)^.WildCard);
  746.   Color := GetColor($01);
  747.   MoveChar(B, ' ', Color, Size.X);
  748.   MoveStr(B[1], Path, Color);
  749.   WriteLine(0, 0, Size.X, 1, B);
  750.  
  751.   { Display file }
  752.   Params[0] := LongInt(@S.Name);
  753.   MoveChar(B, ' ', Color, Size.X);
  754.   Params[0] := LongInt(@S.Name);
  755.   if S.Attr and Directory <> 0 then
  756.   begin
  757.     FmtId := sDirectoryLine;
  758.     D := 'Directory';
  759.     Params[1] := LongInt(@D);
  760.   end else
  761.   begin
  762.     FmtId := sFileLine;
  763.     Params[1] := S.Size;
  764.   end;
  765.   UnpackTime(S.Time, Time);
  766.   M := Month[Time.Month];
  767.   Params[2] := LongInt(@M);
  768.   Params[3] := Time.Day;
  769.   Params[4] := Time.Year;
  770.   PM := Time.Hour >= 12;
  771.   Time.Hour := Time.Hour mod 12;
  772.   if Time.Hour = 0 then Time.Hour := 12;
  773.   Params[5] := Time.Hour;
  774.   Params[6] := Time.Min;
  775.   if PM then Params[7] := Byte('p')
  776.   else Params[7] := Byte('a');
  777.   FormatStr(Str, FmtId, Params);
  778.   MoveStr(B, Str, Color);
  779.   WriteLine(0, 1, Size.X, 1, B);
  780.  
  781.   { Fill in rest of rectangle }
  782.   MoveChar(B, ' ', Color, Size.X);
  783.   WriteLine(0, 2, Size.X, Size.Y-2, B);
  784. end;
  785.  
  786. function TFileInfoPane.GetPalette: PPalette;
  787. const
  788.   P: String[Length(CInfoPane)] = CInfoPane;
  789. begin
  790.   GetPalette := @P;
  791. end;
  792.  
  793. procedure TFileInfoPane.HandleEvent(var Event: TEvent);
  794. begin
  795.   TView.HandleEvent(Event);
  796.   if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
  797.   begin
  798.     S := PSearchRec(Event.InfoPtr)^;
  799.     DrawView;
  800.   end;
  801. end;
  802.  
  803. { TFileDialog }
  804.  
  805. constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
  806.   InputName: String; AOptions: Word; HistoryId: Byte);
  807. var
  808.   Control: PView;
  809.   R: TRect;
  810.   Opt: Word;
  811. begin
  812.   R.Assign(15,1,64,20);
  813.   TDialog.Init(R, ATitle);
  814.   Options := Options or ofCentered;
  815.   WildCard := AWildCard;
  816.  
  817.   R.Assign(3,3,31,4);
  818.   FileName := New(PFileInputLine, Init(R, 79));
  819.   FileName^.Data^ := WildCard;
  820.   Insert(FileName);
  821.   R.Assign(2,2,3+CStrLen(InputName),3);
  822.   Control := New(PLabel, Init(R, InputName, FileName));
  823.   Insert(Control);
  824.   R.Assign(31,3,34,4);
  825.   Control := New(PHistory, Init(R, FileName, HistoryId));
  826.   Insert(Control);
  827.  
  828.   R.Assign(3,14,34,15);
  829.   Control := New(PScrollBar, Init(R));
  830.   Insert(Control);
  831.   R.Assign(3,6,34,14);
  832.   FileList := New(PFileList, Init(R, PScrollBar(Control)));
  833.   Insert(FileList);
  834.   R.Assign(2,5,8,6);
  835.   Control := New(PLabel, Init(R, '~F~iles', FileList));
  836.   Insert(Control);
  837.  
  838.   R.Assign(35,3,46,5);
  839.   Opt := bfDefault;
  840.   if AOptions and fdOpenButton <> 0 then
  841.   begin
  842.     Insert(New(PButton, Init(R, '~O~pen', cmFileOpen, Opt)));
  843.     Opt := bfNormal;
  844.     Inc(R.A.Y,3); Inc(R.B.Y,3);
  845.   end;
  846.   if AOptions and fdOkButton <> 0 then
  847.   begin
  848.     Insert(New(PButton, Init(R, 'O~K~', cmFileOpen, Opt)));
  849.     Opt := bfNormal;
  850.     Inc(R.A.Y,3); Inc(R.B.Y,3);
  851.   end;
  852.   if AOptions and fdReplaceButton <> 0 then
  853.   begin
  854.     Insert(New(PButton, Init(R, '~R~eplace',cmFileReplace, Opt)));
  855.     Opt := bfNormal;
  856.     Inc(R.A.Y,3); Inc(R.B.Y,3);
  857.   end;
  858.   if AOptions and fdClearButton <> 0 then
  859.   begin
  860.     Insert(New(PButton, Init(R, '~C~lear',cmFileClear, Opt)));
  861.     Opt := bfNormal;
  862.     Inc(R.A.Y,3); Inc(R.B.Y,3);
  863.   end;
  864.   Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  865.   Inc(R.A.Y,3); Inc(R.B.Y,3);
  866.   if AOptions and fdHelpButton <> 0 then
  867.   begin
  868.     Insert(New(PButton, Init(R, 'Help',cmHelp, bfNormal)));
  869.     Inc(R.A.Y,3); Inc(R.B.Y,3);
  870.   end;
  871.  
  872.   R.Assign(1,16,48,18);
  873.   Control := New(PFileInfoPane, Init(R));
  874.   Insert(Control);
  875.  
  876.   SelectNext(False);
  877.  
  878.   if AOptions and fdNoLoadDir = 0 then ReadDirectory;
  879. end;
  880.  
  881. constructor TFileDialog.Load(var S: TStream);
  882. var
  883.   ACurDir: DirStr;
  884.   ViewId: Word;
  885. begin
  886.   TDialog.Load(S);
  887.   S.Read(WildCard, SizeOf(TWildStr));
  888.   GetSubViewPtr(S, FileName);
  889.   GetSubViewPtr(S, FileList);
  890.  
  891.   ReadDirectory;
  892. end;
  893.  
  894. destructor TFileDialog.Done;
  895. begin
  896.   DisposeStr(Directory);
  897.   TDialog.Done;
  898. end;
  899.  
  900. procedure TFileDialog.GetData(var Rec);
  901. begin
  902.   GetFilename(PathStr(Rec));
  903. end;
  904.  
  905. procedure TFileDialog.GetFileName(var S: PathStr);
  906. var
  907.   Path: PathStr;
  908.   Name: NameStr;
  909.   Ext: ExtStr;
  910.   TPath: PathStr;
  911.   TName: NameStr;
  912.   TExt: NameStr;
  913.  
  914. function LTrim(const S: String): String;
  915. var
  916.   I: Integer;
  917. begin
  918.   I := 1;
  919.   while (I < Length(S)) and (S[I] = ' ') do Inc(I);
  920.   LTrim := Copy(S, I, 255);
  921. end;
  922.  
  923. function RTrim(const S: String): String;
  924. var
  925.   I: Integer;
  926. begin
  927.   I := Length(S);
  928.   while S[I] = ' ' do Dec(I);
  929.   RTrim := Copy(S, 1, I);
  930. end;
  931.  
  932. function RelativePath(var S: PathStr): Boolean;
  933. begin
  934.   S := LTrim(RTrim(S));
  935.   RelativePath := not ((S <> '') and ((S[1] = '\') or (S[2] = ':')));
  936. end;
  937.  
  938. function NoWildChars(S: String): String; near; assembler;
  939. asm
  940.     PUSH    DS
  941.     LDS    SI,S
  942.         XOR     AX,AX
  943.     LODSB
  944.     XCHG    AX,CX
  945.         LES     DI,@Result
  946.         INC     DI
  947.         JCXZ    @@3
  948. @@1:    LODSB
  949.     CMP    AL,'?'
  950.     JE    @@2
  951.     CMP    AL,'*'
  952.     JE    @@2
  953.     STOSB
  954. @@2:    LOOP    @@1
  955. @@3:    XCHG    AX,DI
  956.     MOV    DI,WORD PTR @Result
  957.     SUB    AX,DI
  958.         DEC     AX
  959.         STOSB
  960.     POP    DS
  961. end;
  962.  
  963. begin
  964.   S := FileName^.Data^;
  965.   if RelativePath(S) then S := FExpand(Directory^ + S)
  966.   else S := FExpand(S);
  967.   FSplit(S, Path, Name, Ext);
  968.   if ((Name = '') or (Ext = '')) and not IsDir(S) then
  969.   begin
  970.     FSplit(WildCard, TPath, TName, TExt);
  971.     if ((Name = '') and (Ext = '')) then S := Path + TName + TExt
  972.     else if Name = '' then S := Path + TName + Ext
  973.     else if Ext = '' then
  974.     begin
  975.       if IsWild(Name) then S := Path + Name + TExt
  976.       else S := Path + Name + NoWildChars(TExt);
  977.     end;
  978.   end;
  979. end;
  980.  
  981. procedure TFileDialog.HandleEvent(var Event: TEvent);
  982. begin
  983.   TDialog.HandleEvent(Event);
  984.   if Event.What = evCommand then
  985.     case Event.Command of
  986.       cmFileOpen, cmFileReplace, cmFileClear:
  987.         begin
  988.           EndModal(Event.Command);
  989.           ClearEvent(Event);
  990.         end;
  991.     end;
  992. end;
  993.  
  994. procedure TFileDialog.SetData(var Rec);
  995. begin
  996.   TDialog.SetData(Rec);
  997.   if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
  998.   begin
  999.     Valid(cmFileInit);
  1000.     FileName^.Select;
  1001.   end;
  1002. end;
  1003.  
  1004. procedure TFileDialog.ReadDirectory;
  1005. begin
  1006.   FileList^.ReadDirectory(WildCard);
  1007.   Directory := NewStr(GetCurDir);
  1008. end;
  1009.  
  1010. procedure TFileDialog.Store(var S: TStream);
  1011. begin
  1012.   TDialog.Store(S);
  1013.   S.Write(WildCard, SizeOf(TWildStr));
  1014.   PutSubViewPtr(S, FileName);
  1015.   PutSubViewPtr(S, FileList);
  1016. end;
  1017.  
  1018. function TFileDialog.Valid(Command: Word): Boolean;
  1019. var
  1020.   T: Boolean;
  1021.   FName: PathStr;
  1022.   Dir: DirStr;
  1023.   Name: NameStr;
  1024.   Ext: ExtStr;
  1025.  
  1026. function CheckDirectory(var S: PathStr): Boolean;
  1027. begin
  1028.   if not PathValid(S) then
  1029.   begin
  1030.     MessageBox('Invalid drive or directory.', nil, mfError + mfOkButton);
  1031.     FileName^.Select;
  1032.     CheckDirectory := False;
  1033.   end else CheckDirectory := True;
  1034. end;
  1035.  
  1036. begin
  1037.   if Command = 0 then
  1038.   begin
  1039.     Valid := True;
  1040.     Exit;
  1041.   end else Valid := False;
  1042.   if TDialog.Valid(Command) then
  1043.   begin
  1044.     GetFileName(FName);
  1045.     if (Command <> cmCancel) and (Command <> cmFileClear) then
  1046.     begin
  1047.       if IsWild(FName) then
  1048.       begin
  1049.         FSplit(FName, Dir, Name, Ext);
  1050.         if CheckDirectory(Dir) then
  1051.         begin
  1052.           DisposeStr(Directory);
  1053.           Directory := NewStr(Dir);
  1054.           WildCard := Name+Ext;
  1055.           if Command <> cmFileInit then FileList^.Select;
  1056.           FileList^.ReadDirectory(Directory^+WildCard);
  1057.         end
  1058.       end
  1059.       else if IsDir(FName) then
  1060.       begin
  1061.         if CheckDirectory(FName) then
  1062.         begin
  1063.           DisposeStr(Directory);
  1064.       Directory := NewSTr(FName+'\');
  1065.       if Command <> cmFileInit then FileList^.Select;
  1066.       FileList^.ReadDirectory(Directory^+WildCard);
  1067.         end
  1068.       end else if ValidFileName(FName) then Valid := True
  1069.       else
  1070.       begin
  1071.         MessageBox('Invalid file name.', nil, mfError + mfOkButton);
  1072.         Valid := False;
  1073.       end
  1074.     end
  1075.     else Valid := True;
  1076.   end;
  1077. end;
  1078.  
  1079. { TDirCollection }
  1080.  
  1081. function TDirCollection.GetItem(var S: TStream): Pointer;
  1082. var
  1083.   DirItem: PDirEntry;
  1084. begin
  1085.   New(DirItem);
  1086.   DirItem^.DisplayText := S.ReadStr;
  1087.   DirItem^.Directory := S.ReadStr;
  1088.   GetItem := DirItem;
  1089. end;
  1090.  
  1091. procedure TDirCollection.FreeItem(Item: Pointer);
  1092. var
  1093.   DirItem: PDirEntry absolute Item;
  1094. begin
  1095.   DisposeStr(DirItem^.DisplayText);
  1096.   DisposeStr(DirItem^.Directory);
  1097.   Dispose(DirItem);
  1098. end;
  1099.  
  1100. procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
  1101. var
  1102.   DirItem: PDirEntry absolute Item;
  1103. begin
  1104.   S.WriteStr(DirItem^.DisplayText);
  1105.   S.WriteStr(DirItem^.Directory);
  1106. end;
  1107.  
  1108. { TDirListBox }
  1109.  
  1110. const
  1111.   DrivesS: String[6] = 'Drives';
  1112.   Drives: PString = @DrivesS;
  1113.  
  1114. constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
  1115.   PScrollBar);
  1116. begin
  1117.   TListBox.Init(Bounds, 1, AScrollBar);
  1118.   Dir := '';
  1119. end;
  1120.  
  1121. destructor TDirListBox.Done;
  1122. begin
  1123.   if List <> nil then Dispose(List, Done);
  1124.   TListBox.Done;
  1125. end;
  1126.  
  1127. function TDirListBox.GetText(Item: Integer; MaxLen: Integer): String;
  1128. begin
  1129.   GetText := PDirEntry(List^.At(Item))^.DisplayText^;
  1130. end;
  1131.  
  1132. procedure TDirListBox.HandleEvent(var Event: TEvent);
  1133. begin
  1134.   if (Event.What = evMouseDown) and (Event.Double) then
  1135.   begin
  1136.     Event.What := evCommand;
  1137.     Event.Command := cmChangeDir;
  1138.     PutEvent(Event);
  1139.     ClearEvent(Event);
  1140.   end
  1141.   else TListBox.HandleEvent(Event);
  1142. end;
  1143.  
  1144. function TDirListBox.IsSelected(Item: Integer): Boolean;
  1145. begin
  1146.   IsSelected := Item = Cur;
  1147. end;
  1148.  
  1149. procedure TDirListBox.NewDirectory(var ADir: DirStr);
  1150. const
  1151.   PathDir            = '└─┬';
  1152.   FirstDir           =   '└┬─';
  1153.   MiddleDir          =   ' ├─';
  1154.   LastDir            =   ' └─';
  1155.   IndentSize         = '  ';
  1156. var
  1157.   AList: PCollection;
  1158.   NewDir, Dirct: DirStr;
  1159.   C, OldC: Char;
  1160.   S, Indent: String[80];
  1161.   P: PString;
  1162.   isFirst: Boolean;
  1163.   SR: SearchRec;
  1164.   I: Integer;
  1165.   DirEntry: PDirEntry;
  1166.  
  1167. function NewDirEntry(const DisplayText, Directory: String): PDirEntry; near;
  1168. var
  1169.   DirEntry: PDirEntry;
  1170. begin
  1171.   New(DirEntry);
  1172.   DirEntry^.DisplayText := NewStr(DisplayText);
  1173.   DirEntry^.Directory := NewStr(Directory);
  1174.   NewDirEntry := DirEntry;
  1175. end;
  1176.  
  1177. function GetCurDrive: Char; near;
  1178. var
  1179.   Disk : word;
  1180.   Mask : longint;
  1181. begin
  1182.   DosQCurDisk(@Disk, @Mask);
  1183.   GetCurDrive := chr(Disk+ord('@'));
  1184. end;
  1185.  
  1186. begin
  1187.   Dir := ADir;
  1188.   AList := New(PDirCollection, Init(5,5));
  1189.   AList^.Insert(NewDirEntry(Drives^,Drives^));
  1190.   if Dir = Drives^ then
  1191.   begin
  1192.     isFirst := True;
  1193.     OldC := ' ';
  1194.     for C := 'A' to 'Z' do
  1195.     begin
  1196.       if (C < 'C') or DriveValid(C) then
  1197.       begin
  1198.         if OldC <> ' ' then
  1199.     begin
  1200.           if isFirst then
  1201.       begin
  1202.         S := FirstDir + OldC;
  1203.             isFirst := False;
  1204.           end
  1205.           else S := MiddleDir + OldC;
  1206.       AList^.Insert(NewDirEntry(S, OldC + ':\'));
  1207.         end;
  1208.         if C = GetCurDrive then Cur := AList^.Count;
  1209.         OldC := C;
  1210.       end;
  1211.     end;
  1212.     if OldC <> ' ' then AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':\'));
  1213.   end
  1214.   else
  1215.   begin
  1216.     Indent := IndentSize;
  1217.     NewDir := Dir;
  1218.     Dirct := Copy(NewDir,1,3);
  1219.     AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
  1220.     NewDir := Copy(NewDir,4,255);
  1221.     while NewDir <> '' do
  1222.     begin
  1223.       I := Pos('\',NewDir);
  1224.       if I <> 0 then
  1225.       begin
  1226.         S := Copy(NewDir,1,I-1);
  1227.         Dirct := Dirct + S;
  1228.         AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
  1229.         NewDir := Copy(NewDir,I+1,255);
  1230.       end
  1231.       else
  1232.       begin
  1233.         Dirct := Dirct + NewDir;
  1234.         AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
  1235.         NewDir := '';
  1236.       end;
  1237.       Indent := Indent + IndentSize;
  1238.       Dirct := Dirct + '\';
  1239.     end;
  1240.     Cur := AList^.Count-1;
  1241.     isFirst := True;
  1242.     NewDir := Dirct + '*.*';
  1243.     FindFirst(NewDir, Directory, SR);
  1244.     while Dos.DosError = 0 do
  1245.     begin
  1246.       if (SR.Attr and Directory <> 0) and (SR.Name[1] <> '.') then
  1247.       begin
  1248.         if isFirst then
  1249.     begin
  1250.       S := FirstDir;
  1251.       isFirst := False;
  1252.     end else S := MiddleDir;
  1253.         AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
  1254.       end;
  1255.       FindNext(SR);
  1256.     end;
  1257.     P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
  1258.     I := Pos('└',P^);
  1259.     if I = 0 then
  1260.     begin
  1261.       I := Pos('├',P^);
  1262.       if I <> 0 then P^[I] := '└';
  1263.     end else
  1264.     begin
  1265.       P^[I+1] := '─';
  1266.       P^[I+2] := '─';
  1267.     end;
  1268.   end;
  1269.   NewList(AList);
  1270.   FocusItem(Cur);
  1271. end;
  1272.  
  1273. procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
  1274. begin
  1275.   TListBox.SetState(AState, Enable);
  1276.   if AState and sfFocused <> 0 then
  1277.     PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
  1278. end;
  1279.  
  1280. { TChDirDialog }
  1281.  
  1282. constructor TChDirDialog.Init(AOptions: Word; HistoryId: Word);
  1283. var
  1284.   R: TRect;
  1285.   Control: PView;
  1286.   CurDir: DirStr;
  1287. begin
  1288.   R.Assign(16, 2, 64, 20);
  1289.   TDialog.Init(R, 'Change Directory');
  1290.  
  1291.   Options := Options or ofCentered;
  1292.  
  1293.   R.Assign(3, 3, 30, 4);
  1294.   DirInput := New(PInputLine, Init(R, 68));
  1295.   Insert(DirInput);
  1296.   R.Assign(2, 2, 17, 3);
  1297.   Control := New(PLabel, Init(R, 'Directory ~n~ame', DirInput));
  1298.   Insert(Control);
  1299.   R.Assign(30, 3, 33, 4);
  1300.   Control := New(PHistory, Init(R, DirInput, HistoryId));
  1301.   Insert(Control);
  1302.  
  1303.   R.Assign(32, 6, 33, 16);
  1304.   Control := New(PScrollBar, Init(R));
  1305.   Insert(Control);
  1306.   R.Assign(3, 6, 32, 16);
  1307.   DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
  1308.   Insert(DirList);
  1309.   R.Assign(2, 5, 17, 6);
  1310.   Control := New(PLabel, Init(R, 'Directory ~t~ree', DirList));
  1311.   Insert(Control);
  1312.  
  1313.   R.Assign(35, 6, 45, 8);
  1314.   OkButton := New(PButton, Init(R, 'O~K~', cmOK, bfDefault));
  1315.   Insert(OkButton);
  1316.   Inc(R.A.Y,3); Inc(R.B.Y,3);
  1317.   ChDirButton := New(PButton, Init(R, '~C~hdir', cmChangeDir, bfNormal));
  1318.   Insert(ChDirButton);
  1319.   Inc(R.A.Y,3); Inc(R.B.Y,3);
  1320.   Insert(New(PButton, Init(R, '~R~evert', cmRevert, bfNormal)));
  1321.   if AOptions and cdHelpButton <> 0 then
  1322.   begin
  1323.     Inc(R.A.Y,3); Inc(R.B.Y,3);
  1324.     Insert(New(PButton, Init(R, 'Help', cmHelp, bfNormal)));
  1325.   end;
  1326.  
  1327.   if AOptions and cdNoLoadDir = 0 then SetUpDialog;
  1328.  
  1329.   SelectNext(False);
  1330. end;
  1331.  
  1332. constructor TChDirDialog.Load(var S: TStream);
  1333. var
  1334.   CurDir: DirStr;
  1335. begin
  1336.   TDialog.Load(S);
  1337.   GetSubViewPtr(S, DirList);
  1338.   GetSubViewPtr(S, DirInput);
  1339.   GetSubViewPtr(S, OkButton);
  1340.   GetSubViewPtr(S, ChDirbutton);
  1341.   SetUpDialog;
  1342. end;
  1343.  
  1344. function TChDirDialog.DataSize: Word;
  1345. begin
  1346.   DataSize := 0;
  1347. end;
  1348.  
  1349. procedure TChDirDialog.GetData(var Rec);
  1350. begin
  1351. end;
  1352.  
  1353. procedure TChDirDialog.HandleEvent(var Event: TEvent);
  1354. var
  1355.   CurDir: DirStr;
  1356.   P: PDirEntry;
  1357. begin
  1358.   TDialog.HandleEvent(Event);
  1359.   case Event.What of
  1360.     evCommand:
  1361.       begin
  1362.         case Event.Command of
  1363.           cmRevert: GetDir(0,CurDir);
  1364.           cmChangeDir:
  1365.             begin
  1366.               P := DirList^.List^.At(DirList^.Focused);
  1367.               if (P^.Directory^ = Drives^) or DriveValid(P^.Directory^[1]) then
  1368.                 CurDir := P^.Directory^
  1369.               else Exit;
  1370.             end;
  1371.         else
  1372.           Exit;
  1373.         end;
  1374.         if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = '\') then
  1375.           CurDir := Copy(CurDir,1,Length(CurDir)-1);
  1376.         DirList^.NewDirectory(CurDir);
  1377.         DirInput^.Data^ := CurDir;
  1378.         DirInput^.DrawView;
  1379.         DirList^.Select;
  1380.         ClearEvent(Event);
  1381.       end;
  1382.   end;
  1383. end;
  1384.  
  1385. procedure TChDirDialog.SetData(var Rec);
  1386. begin
  1387. end;
  1388.  
  1389. procedure TChDirDialog.SetUpDialog;
  1390. var
  1391.   CurDir: DirStr;
  1392. begin
  1393.   if DirList <> nil then
  1394.   begin
  1395.     CurDir := GetCurDir;
  1396.     DirList^.NewDirectory(CurDir);
  1397.     if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = '\') then
  1398.       CurDir := Copy(CurDir,1,Length(CurDir)-1);
  1399.     if DirInput <> nil then
  1400.     begin
  1401.       DirInput^.Data^ := CurDir;
  1402.       DirInput^.DrawView;
  1403.     end;
  1404.   end;
  1405. end;
  1406.  
  1407. procedure TChDirDialog.Store(var S: TStream);
  1408. begin
  1409.   TDialog.Store(S);
  1410.   PutSubViewPtr(S, DirList);
  1411.   PutSubViewPtr(S, DirInput);
  1412.   PutSubViewPtr(S, OkButton);
  1413.   PutSubViewPtr(S, ChDirButton);
  1414. end;
  1415.  
  1416. function TChDirDialog.Valid(Command: Word): Boolean;
  1417. var
  1418.   P: PathStr;
  1419. begin
  1420.   Valid := True;
  1421.   if Command = cmOk then
  1422.   begin
  1423.     P := FExpand(DirInput^.Data^);
  1424.     if (Length(P) > 3) and (P[Length(P)] = '\') then Dec(P[0]);
  1425.     {$I-}
  1426.     ChDir(P);
  1427.     if IOResult <> 0 then
  1428.     begin
  1429.       MessageBox('Invalid directory.', nil, mfError + mfOkButton);
  1430.       Valid := False;
  1431.     end;
  1432.     {$I+}
  1433.   end;
  1434. end;
  1435.  
  1436. procedure RegisterStdDlg;
  1437. begin
  1438.   RegisterType(RFileInputLine);
  1439.   RegisterType(RFileCollection);
  1440.   RegisterType(RFileList);
  1441.   RegisterType(RFileInfoPane);
  1442.   RegisterType(RFileDialog);
  1443.   RegisterType(RDirCollection);
  1444.   RegisterType(RDirListBox);
  1445.   RegisterType(RSortedListBox);
  1446.   RegisterType(RChDirDialog);
  1447. end;
  1448.  
  1449. end.
  1450.