
{*******************************************************}
{                                                       }
{       Graphics Vision Unit                            }
{                                                       }
{	Portions copyright (c) 1992 Borland Intl.       }
{       Copyright (c) 1994 Stefan Milius                }
{	Copyright (c) 1997 Matthias Koeppe              }
{                                                       }
{*******************************************************}

Unit GVStdDlg;

{$ifndef FPK}
{$A+,B-,D+,F+,G+,O+,P-,R-,S-,X+,I-,V-}
{$endif}

Interface

{$ifdef FPK}
uses Objects, Drivers, Views, GVViews, GVDialog, GVMsgBox, Dos, Misc,
  FileSys, Memory, GVFPK, Bgi, ExtGraph, GvTexts;
{$i fpkdef.pp}
{$else}
{$ifdef Windows}
uses Objects, Drivers, WinGr, Views, GVViews, GVDialog, GVMsgBox, WinDos, Dos;
{$else}
uses Objects, Drivers, Views, GVViews, GVDialog, GVMsgBox, Dos;
{$endif}
{$endif}

Const

{ Palettes }

  CFileInfoPane = #141#140;

{ Commands }

  cmFileOpen    = 800;   { Returned from TFileDialog when Open pressed }
  cmFileReplace = 801;   { Returned from TFileDialog when Replace pressed }
  cmFileClear   = 802;   { Returned from TFileDialog when Clear pressed }
  cmFileInit    = 803;   { Used by TFileDialog internally }
  cmChangeDir   = 804;   { Used by TChDirDialog internally }
  cmRevert      = 805;   { Used by TChDirDialog internally }

{ Messages }

  cmFileFocused = 806;    { A new file was focused in the TFileList }
  cmFileDoubleClicked     { A file was selected in the TFileList }
                = 807;

Type

{ TSearchRec record }

  {  Record used to store directory information by TFileDialog }

  TSearchRec = record
    Attr: Byte;
    Time: LongInt;
    Size: LongInt;
    Name: String[12];
  end;

Type

{ TFileInputLine object }

  { TFileInputLine is a special input line that is used by      }
  { TFileDialog that will update its contents in response to a  }
  { cmFileFocused command from a TFileList.                     }

  PFileInputLine = ^TFileInputLine;
  TFileInputLine = Object (TInputLine)
    constructor Init(var Bounds: TRect; AMaxLen: Integer);
    procedure HandleEvent(var Event: TEvent); virtual;
  end;

{ TFileCollection object }

  { TFileCollection is a collection of TSearchRec's.            }

  PFileCollection = ^TFileCollection;
  TFileCollection = Object (TSortedCollection)
    function Compare (Key1, Key2: Pointer): Sw_Integer; virtual;
    procedure FreeItem (Item: Pointer); virtual;
    function GetItem (var S: TStream): Pointer; virtual;
    procedure PutItem (var S: TStream; Item: Pointer); virtual;
  end;

{ TSortedListBox object }

  { TSortedListBox is a TListBox that assumes it has a          }
  { TSortedCollection instead of just a TCollection.  It will   }
  { perform an incremental search on the contents.              }

  PSortedListBox = ^TSortedListBox;
  TSortedListBox = Object (TListBox)
    SearchPos: Word;
    ShiftState: Byte;
    constructor Init(var Bounds: TRect; AScrollBar: PScrollBar);
    procedure HandleEvent (var Event: TEvent); virtual;
    function GetKey (var S: String): Pointer; virtual;
    procedure NewList (AList: PCollection); virtual;
  end;

const

{ TFileList flags }

  lfFileLowerCase = $1000;
  lfDirLowerCase  = $2000;
  lfLowerCase     = lfFileLowerCase + lfDirLowerCase;

{ Standard TFileList flags }

  StdFileListFlags: Word = lfLowerCase;

type

{ TFileList object }

  { TFileList is a TSortedList box that assumes it contains     }
  { a TFileCollection as its collection.  It also communicates  }
  { through broadcast messages to TFileInput and TInfoPane      }
  { what file is currently selected.                            }

  PFileList = ^TFileList;
  TFileList = Object (TSortedListBox)
    constructor Init (var Bounds: TRect; AWildCard: PathStr;
      AScrollBar: PScrollBar);
    destructor Done; virtual;
    function DataSize: Sw_Word; virtual;
    procedure FocusItem (Item: Integer); virtual;
    procedure GetData (var Rec); virtual;
    function GetKey (var S: String): Pointer; virtual;
    function GetText (Item: Integer; MaxLen: Integer): String; virtual;
    procedure HandleEvent (var Event: TEvent); virtual;
    procedure ReadDirectory (AWildCard: PathStr);
    procedure SetData (var Rec); virtual;
  end;

{ TFileInfoPane object }

  { Palette layout }
  { 1 = Background }
  { 2 = Text       }

  { TFileInfoPane is a TView that displays the information      }
  { about the currently selected file in the TFileList          }
  { of a TFileDialog.                                           }

  PFileInfoPane = ^TFileInfoPane;
  TFileInfoPane = Object (TGView)
    S: TSearchRec;
    constructor Init(var Bounds: TRect);
    constructor Load(var Str: TStream);
    procedure ChangeBounds (var Bounds: TRect); virtual;
    procedure Draw; virtual;
    function GetPalette: PPalette; virtual;
    procedure HandleEvent (var Event: TEvent); virtual;
    procedure SetState (AState: Word; Enable: Boolean); virtual;
  private
    Flag: Boolean;
    Path: PathStr;
  end;

  { TFileDialog is a standard file name input dialog            }

  TWildStr = PathStr;

const

{ File dialog flags }

  fdOkButton       = $0001;      { Put an OK button in the dialog }
  fdOpenButton     = $0002;      { Put an Open button in the dialog }
  fdReplaceButton  = $0004;      { Put a Replace button in the dialog }
  fdClearButton    = $0008;      { Put a Clear button in the dialog }
  fdHelpButton     = $0010;      { Put a Help button in the dialog }
  fdNoLoadDir      = $0100;      { Do not load the current directory }
				 { contents into the dialog at Init. }
				 { This means you intend to change the }
				 { WildCard by using SetData or store }
				 { the dialog on a stream. }
  fdDefaultColumns = $0000;
  fdOneColumns     = $1000;
  fdTwoColumns     = $2000;

  fd_Buttons       = $00FF;
  fd_Columns       = $F000;

{ Standard file dialog flags }

  StdFileDialogFlags: Word = fdTwoColumns;

type

{ TFileDialog object }

  PFileDialog = ^TFileDialog;
  TFileDialog = Object (TDialog)
    FileName: PFileInputLine;
    FileList: PFileList;
    WildCard: TWildStr;
    Directory: PString;
    constructor Init (AWildCard: TWildStr; ATitle: String;
      InputName: String; AOptions: Word; HistoryId: Byte);
    constructor Load (var S: TStream);
    destructor Done; virtual;
    procedure GetData (var Rec); virtual;
    procedure GetFileName (var S: PathStr);
    procedure HandleEvent (var Event: TEvent); virtual;
    procedure SetData (var Rec); virtual;
    procedure Store (var S: TStream);
    function Valid (Command: Word): Boolean; virtual;
  private
    procedure ReadDirectory;
  end;

type

{ TDirEntry record }

  PDirEntry = ^TDirEntry;
  TDirEntry = Record
    DisplayOpt: Word;
    Directory: PString;
  end;

{ TDirCollection object }

  { TDirCollection is a collection of TDirEntry's used by       }
  { TDirListBox.                                                }

  PDirCollection = ^TDirCollection;
  TDirCollection = Object (TCollection)
    function GetItem (var S: TStream): Pointer; virtual;
    procedure FreeItem (Item: Pointer); virtual;
    procedure PutItem (var S: TStream; Item: Pointer); virtual;
  end;

const
  { TDirListBox flags }

  dfLowerCase = $1000;
  dfSorted    = $2000;

  { Standard TDirListBox flags }

  StdDirListFlags: Word = dfLowerCase + dfSorted;

type
{ TDirListBox object }

  { TDirListBox displays a tree of directories for use in the }
  { TChDirDialog.                                               }

  PDirListBox = ^TDirListBox;
  TDirListBox = Object (TListBox)
    Dir: DirStr;
    Cur: Word;
    constructor Init (var Bounds: TRect; AScrollBar: PScrollBar);
    destructor Done; virtual;
    procedure DrawItemText (Item: Integer; R: TRect); virtual;
    function GetText (Item: Integer; MaxLen: Integer): String; virtual;
    procedure HandleEvent (var Event: TEvent); virtual;
    function IsSelected (Item: Integer): Boolean; virtual;
    procedure NewDirectory (var ADir: DirStr); virtual;
    procedure SetState (AState: Word; Enable: Boolean); virtual;
  end;

{ TChDirDialog object }

  { TChDirDialog is a standard change directory dialog.         }

Const

  cdNormal     = $0000; { Option to use dialog immediately }
  cdNoLoadDir  = $0001; { Option to init the dialog to store on a stream }
  cdHelpButton = $0002; { Put a help button in the dialog }

Type

  PChDirDialog = ^TChDirDialog;
  TChDirDialog = object(TDialog)
    DirInput: PInputLine;
    DirList: PDirListBox;
    OkButton: PButton;
    ChDirButton: PButton;
    constructor Init (AOptions: Word; HistoryId: Byte);
    constructor Load (var S: TStream);
    function DataSize: Sw_Word; virtual;
    procedure GetData (var Rec); virtual;
    procedure HandleEvent (var Event: TEvent); virtual;
    procedure SetData (var Rec); virtual;
    procedure Store (var S: TStream);
    function Valid (Command: Word): Boolean; virtual;
  private
    procedure SetUpDialog;
  end;

const
  PathSeparator	= {$ifdef LINUX} '/' {$else} '\' {$endif};
  AllFiles	= {$ifdef LINUX} '*' {$else} '*.*' {$endif};
  PrevDir	= '..';

{ TDirEntry DisplayOpt values }

  doDrivesText = 0;
  doDrive      = 256;
  doPathDir    = 512;
  doFirstDir   = 768;
  doMiddleDir  = 1024;
  doLastDir    = 1280;

Const

{ TStream registration records }

  RFileInputLine: TStreamRec = (
     ObjType: 160;
     VmtLink: Ofs(TypeOf(TFileInputLine)^);
     Load:    @TFileInputLine.Load;
     Store:   @TFileInputLine.Store);

  RFileCollection: TStreamRec = (
     ObjType: 161;
     VmtLink: Ofs(TypeOf(TFileCollection)^);
     Load:    @TFileCollection.Load;
     Store:   @TFileCollection.Store);

  RFileList: TStreamRec = (
     ObjType: 162;
     VmtLink: Ofs(TypeOf(TFileList)^);
     Load:    @TFileList.Load;
     Store:   @TFileList.Store);

  RFileInfoPane: TStreamRec = (
     ObjType: 163;
     VmtLink: Ofs(TypeOf(TFileInfoPane)^);
     Load:    @TFileInfoPane.Load;
     Store:   @TFileInfoPane.Store);

  RFileDialog: TStreamRec = (
     ObjType: 164;
     VmtLink: Ofs(TypeOf(TFileDialog)^);
     Load:    @TFileDialog.Load;
     Store:   @TFileDialog.Store);

  RDirCollection: TStreamRec = (
     ObjType: 165;
     VmtLink: Ofs(TypeOf(TDirCollection)^);
     Load:    @TDirCollection.Load;
     Store:   @TDirCollection.Store);

  RDirListBox: TStreamRec = (
     ObjType: 166;
     VmtLink: Ofs(TypeOf(TDirListBox)^);
     Load:    @TDirListBox.Load;
     Store:   @TDirListBox.Store);

  RChDirDialog: TStreamRec = (
     ObjType: 167;
     VmtLink: Ofs(TypeOf(TChDirDialog)^);
     Load:    @TChDirDialog.Load;
     Store:   @TChDirDialog.Store);

procedure RegisterGVStdDlg;

Implementation

{$ifndef FPK}
{$ifdef Windows}
uses OMemory, ExtGraph, Misc, GvTexts {$ifdef HAVE_REDIR}, GvRedir{$endif};
{$else}
uses GVDriver, Memory, Gr, MetaGr, ExtGraph, Misc, MyFonts, GVTexts
  {$ifdef HAVE_REDIR}, GvRedir{$endif};
{$endif}
{$endif}

Type PSearchRec = ^TSearchRec;

(************************** Internal used procedures ************************)

{$ifdef FPK}
function DriveValid(Drive: Char): Boolean;
begin
  DriveValid := true {&}
end; { DriveValid }

function ValidFileName(var FileName: PathStr): Boolean;
begin
  ValidFileName := IsValidName(FileName)
end; { ValidFileName }

function GetCurDir: DirStr;
begin
   GetCurDir := GetCurrentDir + PathSeparator
end; { GetCurDir }

function IsWild(var S: String): Boolean;
begin
  IsWild := ContainsWildcards(S)
end; { IsWild }

{function IsDir(var S: String): Boolean;
begin
  IsDir := CheckName(S) = cnDirectory
end;}

function PathValid(var Path: PathStr): Boolean;
var
  ExpPath: PathStr;
  SR: SearchRec;
begin
  ExpPath := FExpand(Path);
  if Length(ExpPath) <= 3 then PathValid := DriveValid(ExpPath[1])
  else
  begin
    if ExpPath[Length(ExpPath)] = PathSeparator then Dec(ExpPath[0]);
    FindFirst(ExpPath, Directory, SR);
    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
  end;
end; { PathValid }

{$ifndef LINUX}
function GetCurDrive: Char; assembler;
asm
  movb $0x19, %ah
  int $0x21
  addb 'a', %al
end; { GetCurDrive }
{$endif}

procedure CopySearchRec(const S: SearchRec; var P: TSearchRec);
begin
  P.Attr := S.Attr;
  P.Time := S.Time;
  P.Size := S.Size;
  P.Name := Copy(S.Name, 1, 12)
end;

{$else !FPK}

function DriveValid(Drive: Char): Boolean; near; assembler;
asm
	MOV	AH,19H          { Save the current drive in BL }
        INT	21H
        MOV	BL,AL
 	MOV	DL,Drive	{ Select the given drive }
        SUB	DL,'A'
        MOV	AH,0EH
        INT	21H
        MOV	AH,19H		{ Retrieve what DOS thinks is current }
        INT	21H
        MOV	CX,0		{ Assume false }
        CMP	AL,DL		{ Is the current drive the given drive? }
	JNE	@@1
        MOV	CX,1		{ It is, so the drive is valid }
	MOV	DL,BL		{ Restore the old drive }
        MOV	AH,0EH
        INT	21H
@@1:	XCHG	AX,CX		{ Put the return value into AX }
end;

function PathValid(var Path: PathStr): Boolean;
var
  ExpPath: PathStr;
  F: File;
  SR: SearchRec;
begin
  ExpPath := FExpand(Path);
  if Length(ExpPath) <= 3 then PathValid := DriveValid(ExpPath[1])
  else
  begin
    if ExpPath[Length(ExpPath)] = PathSeparator then Dec(ExpPath[0]);
    FindFirst(ExpPath, Directory, SR);
    PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
  end;
end;

function ValidFileName(var FileName: PathStr): Boolean;
const
  IllegalChars = ';,=+<>|"[] \';
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;

{ Contains returns true if S1 contains any characters in S2 }
function Contains(S1, S2: String): Boolean; near; assembler;
asm
	PUSH	DS
        CLD
        LDS	SI,S1
        LES	DI,S2
        MOV	DX,DI
        XOR	AH,AH
        LODSB
        MOV	BX,AX
        OR      BX,BX
        JZ      @@2
        MOV	AL,ES:[DI]
        XCHG	AX,CX
@@1:	PUSH	CX
	MOV	DI,DX
	LODSB
        REPNE	SCASB
        POP	CX
        JE	@@3
	DEC	BX
        JNZ	@@1
@@2:	XOR	AL,AL
	JMP	@@4
@@3:	MOV	AL,1
@@4:	POP	DS
end;

begin
  ValidFileName := True;
  FSplit(FileName, Dir, Name, Ext);
  if not ((Dir = '') or PathValid(Dir)) or Contains(Name, IllegalChars) or
    Contains(Dir, IllegalChars) then ValidFileName := False;
end;

function GetCurDir: DirStr;
var
  CurDir: DirStr;
begin
  GetDir(0, CurDir);
  if Length(CurDir) > 3 then
  begin
    Inc(CurDir[0]);
    CurDir[Length(CurDir)] := PathSeparator;
  end;
  GetCurDir := CurDir;
end;

function IsWild(var S: String): Boolean;
begin
  IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
end;

function GetCurDrive: Char; Assembler;
Asm
  MOV	AH,19H
  INT	21H
  ADD	AL,'A'
End;
 { GetCurDrive }

procedure CopySearchRec({const }S: SearchRec; var P: TSearchRec);
begin
  System.Move (S.Attr, P, SizeOf(P))
end; { CopySearchRec }

{$endif}

function IsDir(var S: String): Boolean;
var SR: SearchRec;
begin
  while S[Length(S)] = PathSeparator do Dec(S[0]);
  FindFirst(S, Directory, SR);
  if DosError = 0 then
    IsDir := SR.Attr and Directory <> 0
  else IsDir := False;
end;
 { IsDir }

procedure LoStr(var S: String);
var I: Integer;
begin
  For I:=1 to Length (S) do
    if S[I] in ['A'..'Z'] then S[I] := Chr(Ord(S[I]) + 32);
End;

(************************** TFileInputLine object ***************************)

constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Integer);
begin
  TInputLine.Init (Bounds, AMaxLen);
  EventMask := EventMask or evBroadcast;
end;

procedure TFileInputLine.HandleEvent(var Event: TEvent);
var
  Nm: string;
Begin
  TInputLine.HandleEvent(Event);
  If (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
    (State and sfSelected = 0) and (Event.InfoPtr <> nil) then Begin
      Nm := PSearchRec(Event.InfoPtr)^.Name;
    If PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
      Data^:= Nm + PathSeparator + PFileDialog(GOwner)^.WildCard
    Else
      Data^ := Nm;
    DrawView;
  End;
End;

(************************** TFileCollection object **************************)

function TFileCollection.Compare(Key1, Key2: Pointer): Sw_Integer;
Begin
  If PSearchRec (Key1)^.Name = PSearchRec (Key2)^.Name then Compare:=0
  Else
    If PSearchRec(Key1)^.Name = '..' then Compare:=1
    Else
      If PSearchRec(Key2)^.Name = '..' then Compare:=-1
      Else
        If (PSearchRec(Key1)^.Attr and Directory <> 0) and
           (PSearchRec(Key2)^.Attr and Directory = 0) then Compare:=1
        Else
          If (PSearchRec(Key2)^.Attr and Directory <> 0) and
             (PSearchRec(Key1)^.Attr and Directory = 0) then Compare:=-1
          Else
            If PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then Compare:=1
            Else
              Compare := -1;
end;

procedure TFileCollection.FreeItem(Item: Pointer);
Begin
  Dispose(PSearchRec(Item))
End;

function TFileCollection.GetItem(var S: TStream): Pointer;
var Item: PSearchRec;
Begin
  New (Item);
  S.Read (Item^, SizeOf (TSearchRec));
  GetItem:=Item;
End;

procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
Begin
  S.Write (Item^, SizeOf (TSearchRec));
End;

(************************** TSortedListBox object ***************************)

constructor TSortedListBox.Init(var Bounds: TRect; AScrollBar: PScrollBar);
Begin
  TListBox.Init (Bounds, AScrollBar);
  SearchPos:=0;
End;

procedure TSortedListBox.HandleEvent(var Event: TEvent);
var
  CurString, NewString: String;
  K: Pointer;
  Value, OldPos, OldValue: Sw_Integer;
  T: Boolean;

 function Equal(var S1: String; var S2: String; Count: Word): Boolean;
 var I: Word;
 Begin
   Equal:=False;
   if (Length(S1) < Count) or (Length(S2) < Count) then Exit;
   for I:=1 to Count do
     if UpCase(S1[I]) <> UpCase(S2[I]) then Exit;
   Equal:=True;
 End;

Begin
  OldValue := Focused;
  inherited HandleEvent (Event);
  If OldValue <> Focused then SearchPos:=0;
  If Event.What = evKeyDown then Begin
    If Event.CharCode <> #0 then Begin
      Value:=Focused;
      If Value < Range then CurString:=GetText(Value, 255)
                       else CurString:='';
      OldPos := SearchPos;
      While CurString [1]=' ' do Delete (CurString,1,1);
      If Event.KeyCode = kbBack then Begin
        If SearchPos = 0 then Exit;
        Dec (SearchPos);
        If SearchPos = 0 then ShiftState := GetShiftState;
        CurString[0]:=Char (SearchPos);
      End
      Else If (Event.CharCode = '.') then SearchPos:=Pos('.',CurString)
           Else Begin
             Inc(SearchPos);
             if SearchPos = 1 then ShiftState := GetShiftState;
             CurString[0]:=Char (SearchPos);
             CurString[SearchPos]:=Event.CharCode;
           End;
      K := GetKey (CurString);
      T := PSortedCollection(List)^.Search (K, Value);
      If Value < Range then Begin
        If Value < Range then NewString:=GetText (Value, 255)
                         else NewString := '';
        While NewString [1]=' ' do Delete (NewString,1,1);
        If Equal (NewString, CurString, SearchPos) then Begin
          If Value <> OldValue then FocusItem (Value);
        End
        Else SearchPos:=OldPos;
      End
      Else SearchPos:=OldPos;
      If (SearchPos <> OldPos) or (Event.CharCode in ['A'..'Z','a'..'z']) then
        ClearEvent (Event);
    End;
  End;
End;

function TSortedListBox.GetKey(var S: String): Pointer;
Begin GetKey:=@S End;

procedure TSortedListBox.NewList(AList: PCollection);
Begin
  inherited NewList (AList);
  SearchPos:=0;
End;

(****************************** TFileList object ****************************)

constructor TFileList.Init(var Bounds: TRect; AWildCard: PathStr;
  AScrollBar: PScrollBar);
Begin
  TSortedListBox.Init(Bounds, AScrollBar);
  Flags := StdFileListFlags
End;

destructor TFileList.Done;
Begin
  If List <> nil then Dispose (List, Done);
  inherited Done;
End;

function TFileList.DataSize: Sw_Word;
Begin
  DataSize:=0
End;

procedure TFileList.FocusItem(Item: Integer);
var OldF: Integer;
Begin
  OldF:=Focused;
  inherited FocusItem (Item);
  {If OldF<>Focused then}
  If (Item<Range) and (Item>=0) then
    Message (GOwner, evBroadcast, cmFileFocused, List^.At(Item))
  else Message(GOwner, evBroadcast, cmFileFocused, nil)
End;

procedure TFileList.GetData(var Rec);
Begin
End;

function TFileList.GetKey(var S: String): Pointer;
Const SR: TSearchRec = ();

 procedure UpStr(var S: String);
 var I: Integer;
 Begin
   For I:=1 to Length (S) do S[I]:=UpCase(S[I]);
 End;

Begin
  If (ShiftState and $03 <> 0) or ((S <> '') and (S[1]='.')) then
    SR.Attr:=Directory
  Else SR.Attr:=0;
  SR.Name:=S;
  UpStr (SR.Name);
  GetKey:=@SR;
End;

function TFileList.GetText(Item: Integer; MaxLen: Integer): String;
var S: String;
    SR: PSearchRec;
Begin
  SR:=PSearchRec(List^.At(Item));
  S:=SR^.Name;
  If SR^.Attr and Directory <> 0 then Begin
    S[Length (S)+1]:=PathSeparator;
    Inc (S[0]);
  End;
  if Flags and lfFileLowerCase <> 0
  then LoStr(S);
  {GetText:='    '+S;}
  GetText := S
End;

procedure TFileList.HandleEvent(var Event: TEvent);
Begin
  If (Event.What = evMouseDown) and (Event.Double) then Begin
    If MouseInView (Event.Where) then Begin
       Event.What:=evCommand;
       Event.Command:=cmDefault;
       PutEvent(Event);
       ClearEvent(Event);
    End
  End
  Else inherited HandleEvent(Event);
End;

procedure TFileList.ReadDirectory(AWildCard: PathStr);
const FindAttr = ReadOnly + Archive;

var S: SearchRec;
    P: PSearchRec;
    FileList: PFileCollection;
    NumFiles: Word;
    Dir: DirStr;
    Name: NameStr;
    Ext: ExtStr;
    Event: TEvent;
    Tmp: PathStr;

Begin
  NumFiles:=0;
  AWildCard:=FExpand (AWildCard);
  FSplit (AWildCard, Dir, Name, Ext);
  FileList:=New (PFileCollection, Init (5,5));
  FindFirst (AWildCard, FindAttr, S);
  P:=@P;
  While (P <> nil) and (DosError = 0) do Begin
    If (S.Attr and Directory = 0) then Begin
      P:=MemAlloc (SizeOf(TSearchRec));
      If P<>nil then Begin
	CopySearchRec(S, P^);
        FileList^.Insert(P);
      End;
    End;
    FindNext(S);
  end;
  Tmp:=Dir+AllFiles;
  FindFirst (Tmp, Directory, S);
  While (P <> nil) and (DosError = 0) do Begin
    If (S.Attr and Directory <> 0) and (S.Name[1] <> '.') then Begin
      P:=MemAlloc (SizeOf(TSearchRec));
      If P <> nil then Begin
	CopySearchRec(S, P^);
        FileList^.Insert (PObject(P));
      End;
    End;
    FindNext(S);
  End;
  If Length (Dir) > 4 then Begin
    P:=MemAlloc (SizeOf(TSearchRec));
    If P <> nil then Begin
      FindFirst (Tmp, Directory, S);
      FindNext (S);
      If (DosError = 0) and (S.Name = PrevDir) then
        CopySearchRec(S, P^)
      Else Begin
        P^.Name:=PrevDir;
        P^.Size:=0;
        P^.Time:=$210000;
        P^.Attr:=Directory;
      End;
      FileList^.Insert(PObject(P));
    End;
  End;
  If P = nil then MessageBox (GetStr(89), nil, mfOkButton + mfWarning);
  NewList (FileList);
  Event.What:=evBroadcast;
  Event.Command:=cmFileFocused;
  if List^.Count > 0
    then Event.InfoPtr:=List^.At(0)
  else Event.InfoPtr:=nil;
  GOwner^.HandleEvent(Event);
End;

procedure TFileList.SetData(var Rec);
Begin
  With PFileDialog (GOwner)^ do
    Self.ReadDirectory (Directory^+WildCard);
End;

(************************** TFileInfoPane object ****************************)

constructor TFileInfoPane.Init(var Bounds: TRect);
Begin
  TGView.Init(Bounds);
  EventMask:=EventMask or evBroadcast;
  Flag:=true;
  Path:=' ';
End;

constructor TFileInfoPane.Load(var Str: TStream);
Begin
  TGView.Load (Str);
  Flag:=true;
  Path:=' ';
End;

procedure TFileInfoPane.ChangeBounds(var Bounds: TRect);
Begin
  {Path[2]:=' ';}
  TGView.ChangeBounds (Bounds);
End;

procedure TFileInfoPane.Draw;
var R: TRect;
    D: String[11];
    M: String[3];
    C: Word;
    Time: DateTime;
    FmtId: String;
    Params: array[0..6] of LongInt;
    Str: String[80];
const
  sFileLine: String[34] = ' %-12s %-9d %3s %2d, %4d  %2d:%02d';
begin
  { Display path }
  SetFillStyle (SolidFill, GetColor (1));
  C:=GetColor (2);
  SetGVStyle (ftMonoSpace);
  If Flag then Begin
    Bar (0, 0, Size.X-1, 14);
    R.Assign (1, 1, Size.X-1, 14);
    OutGVText (R.A, Path, C,C, R.B, False);
  End;
  { Display file }
  Params[0] := LongInt(@S.Name);
  If S.Attr and Directory <> 0 then
  Begin
    FmtId:=GetStr(90);
    D:=GetStr(103);
    Params[1] := LongInt(@D);
  End
  Else Begin
    FmtId:=sFileLine;
    Params[1]:=S.Size;
  End;
  UnpackTime (S.Time, Time);
  M:=GetStr(90 + Time.Month);
  Params[2]:=LongInt(@M);
  Params[3]:=Time.Day;
  Params[4]:=Time.Year;
  Params[5]:=Time.Hour;
  Params[6]:=Time.Min;
  FormatStr (Str, FmtId, Params);
  Bar (0, 15, Size.X-1, Size.Y-1);
  R.Assign (1, 16, Size.X-1, 14);
  OutGVText (R.A, Str, C,C, R.B, False);
end;

function TFileInfoPane.GetPalette: PPalette;
const P: String [Length (CFileInfoPane)] = CFileInfoPane;
Begin
  GetPalette := @P;
End;

procedure TFileInfoPane.HandleEvent(var Event: TEvent);
var
  P: PathStr;
begin
  TGView.HandleEvent(Event);
  If (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then Begin
    If Event.InfoPtr = nil
    then Hide
    else begin
{$ifdef FPK}
      Move(Event.InfoPtr^, S, SizeOf(TSearchRec));
{$else}
      S := PSearchRec (Event.InfoPtr)^;
{$endif}
      if (GOwner <> nil) and (PFileDialog(GOwner)^.Directory <> nil)
      then begin
        P:=' '+FExpand(PFileDialog(GOwner)^.Directory^+PFileDialog(GOwner)^.WildCard);
        If P<>Path
        then Path:=P
        else Flag:=false; { Update only second line }
      end;
      DrawView;
      Flag := true;
      Show
    end
  End;
End;

procedure TFileInfoPane.SetState(AState: Word; Enable: Boolean);
Begin
  {
  If (AState and sfExposed <>0) and Enable and not Exposed then Flag:=True;
  }
  {If (AState = sfDragging) and not Enable then Flag := true;}
  TGView.SetState (AState, Enable);
End;

(*************************** TFileDialog object *****************************)

constructor TFileDialog.Init(AWildCard: TWildStr; ATitle: String;
      InputName: String; AOptions: Word; HistoryId: Byte);
var Control: PGView;
    R: TRect;
    Opt: Word;
begin
  R.Assign(0,0,365,305);
  TDialog.Init (R, ATitle);
  Options:=Options or ofCentered;
  WildCard := AWildCard;

  { Combine with default flags. }
  if AOptions and fd_Columns = 0
  then AOptions := AOptions or (StdFileDialogFlags and fd_Columns);
  AOptions := AOptions or (StdFileDialogFlags and fd_Buttons);

  R.Assign(15,53,203,73);
  FileName := New (PFileInputLine, Init(R, 79));
  FileName^.Data^ := WildCard;
  SetTextParams (ftSansSerif,0,0,True);
  R.Assign (15,30,25+TextWidth (InputName),50);
  Control:=New (PLabel, Init (R, InputName, FileName));
  Insert (FileName);
  Insert (Control);
  R.Assign(202, 53, 220, 73);
  Control := New(PHistory, Init(R, FileName, HistoryId));
  Insert(Control);

  case AOptions and fd_Columns of
    fdTwoColumns:
      begin
	R.Assign (15,235,220,253);
	Control:=New (PScrollBar, Init(R));
	R.Assign(15,110,220,236);
	FileList:=New (PFileList, Init (R, WildCard, PScrollBar(Control)));
	FileList^.SetNumCols(2)
      end;
    {fdOneColumn:}
    else
      begin
	R.Assign (202,110,220,251);
	Control:=New (PScrollBar, Init(R));
	R.Assign(15,110,203,251);
	FileList:=New (PFileList, Init (R, WildCard, PScrollBar(Control)));
      end;
  end;

  Insert (Control);
  R.Assign (15,85,80,105);
  Control:=New (PLabel, Init (R, GetStr(104), FileList));
  Insert (FileList);
  Insert (Control);

  R.Assign (240,30,340,55);
  Opt:=bfDefault;
  If AOptions and fdOpenButton <> 0 then Begin
    Insert (New (PButton, Init (R, GetStr(105), cmFileOpen, Opt)));
    Opt:=bfNormal;
    R.Move (0,35);
  End;
  If AOptions and fdOkButton <> 0 then Begin
    Insert (New (PButton, Init (R, GetStr(106), cmFileOpen, Opt)));
    Opt:=bfNormal;
    R.Move (0,35);
  End;
  If AOptions and fdReplaceButton <> 0 then Begin
    Insert (New (PButton, Init (R, GetStr(107),cmFileReplace, Opt)));
    Opt:=bfNormal;
    R.Move (0,35);
  End;
  If AOptions and fdClearButton <> 0 then Begin
    Insert (New (PButton, Init (R, GetStr(108),cmFileClear, Opt)));
    Opt:=bfNormal;
    R.Move (0,35);
  End;
  Insert (New (PButton, Init (R, GetStr(109), cmCancel, bfNormal)));
  R.Move (0,35);
  If AOptions and fdHelpButton <> 0 then Begin
    Control:=New (PButton, Init (R, GetStr(110),cmHelp, bfNormal));
    Insert (Control);
    R.Move (0,35);
  End;

  GetExtent (R);
  R.Grow (-6,-6);
  R.A.Y:=R.B.Y-30;
  Control := New (PFileInfoPane, Init(R));
  Insert(Control);

  SelectNext (false);

  If AOptions and fdNoLoadDir = 0 then ReadDirectory;
End;

constructor TFileDialog.Load(var S: TStream);
Begin
  inherited Load(S);
  S.Read (WildCard, SizeOf(TWildStr));
  GetSubViewPtr(S, FileName);
  GetSubViewPtr(S, FileList);

  ReadDirectory;
  SelectNext (false);
End;

destructor TFileDialog.Done;
Begin
  DisposeStr (Directory);
  inherited Done;
End;

procedure TFileDialog.GetData(var Rec);
Begin
  GetFilename (PathStr(Rec));
End;

procedure TFileDialog.GetFileName(var S: PathStr);
var Path: PathStr;
    Name: NameStr;
    Ext: ExtStr;
    TPath: PathStr;
    TName: NameStr;
    TExt: NameStr;

 function LTrim (S: String): String;
 var I: Integer;
 Begin
   I:=1;
   While (I < Length(S)) and (S[I] = ' ') do Inc(I);
   LTrim:=Copy(S, I, 255);
 End;

 function RTrim (S: String): String;
 Begin
   While S[Length(S)] = ' ' do Dec(S[0]);
   RTrim:=S;
 End;

 function RelativePath (var S: PathStr): Boolean;
 Begin
   S:=LTrim(RTrim(S));
   If (S <> '') and ((S[1] = PathSeparator) or (S[2] = ':')) then RelativePath:=False
                                                   else RelativePath:=True;
 End;

{$ifdef NOIASM}
 function NoWildChars(S: String): String;
 var
   i, j: Integer;
 begin
   j := 1;
   for i := 1 to length(S) do
     if not (S[i] in ['*', '?'])
       then begin
	 S[j] := S[i];
	 Inc(j)
       end;
   S[0] := Chr(j - 1);
   NoWildChars := S
 end; { NoWildChars }
{$else}
 function NoWildChars(S: String): String; Assembler;
 asm
	 PUSH	DS
	 LDS	SI,S
         XOR     AX,AX
	 LODSB
	 XCHG	AX,CX
         LES     DI,@Result
         INC     DI
         JCXZ    @@3
 @@1:	 LODSB
	 CMP	AL,'?'
	 JE	@@2
	 CMP	AL,'*'
	 JE	@@2
	 STOSB
 @@2:	 LOOP	@@1
 @@3:    XCHG	AX,DI
	 MOV	DI,WORD PTR @Result
	 SUB	AX,DI
         DEC     AX
	 STOSB
	 POP	DS
 End;
{$endif}

Begin
  S:=FileName^.Data^;
  If RelativePath (S) then S:=FExpand (Directory^ + S)
                      else S:=FExpand (S);
  FSplit (S, Path, Name, Ext);
  If ((Name = '') or (Ext = '')) and not IsDir(S) then Begin
    FSplit (WildCard, TPath, TName, TExt);
    If ((Name = '') and (Ext = '')) then S := Path + TName + TExt
    Else
      If Name = '' then S := Path + TName + Ext
      Else
	If Ext = '' then Begin
          If IsWild(Name) then S := Path + Name + TExt
          Else
            S := Path + Name + NoWildChars(TExt);
	End;
  End;
End;

procedure TFileDialog.HandleEvent(var Event: TEvent);
Begin
  inherited HandleEvent(Event);
  If Event.What = evCommand then
    Case Event.Command of
      cmFileOpen, cmFileReplace, cmFileClear:
        Begin
          EndModal (Event.Command);
          ClearEvent (Event);
        End;
    End;
End;

procedure TFileDialog.ReadDirectory;
Begin
  FileList^.ReadDirectory (WildCard);
  Directory:=NewStr (GetCurDir);
End;

procedure TFileDialog.SetData(var Rec);
Begin
  inherited SetData (Rec);
  If (PathStr(Rec) <> '') and (IsWild (TWildStr(Rec))) then Begin
    Valid (cmFileInit);
    FileName^.Select;
  End;
End;

procedure TFileDialog.Store(var S: TStream);
Begin
  inherited Store(S);
  S.Write (WildCard, SizeOf (TWildStr));
  PutSubViewPtr (S, FileName);
  PutSubViewPtr (S, FileList);
End;

function TFileDialog.Valid(Command: Word): Boolean;
var 
  FName: PathStr;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;

 function CheckDirectory (var S: PathStr): Boolean;
 Begin
   If not PathValid (S) then Begin
     MessageBox (GetStr(111), nil, mfError + mfOkButton);
     FileName^.Select;
     CheckDirectory:=False;
   End
   Else CheckDirectory:=True;
 End;

Begin
  If Command = 0 then Begin
    Valid:=True;
    Exit;
  End
  Else Valid := False;
  If inherited Valid (Command) then Begin
    GetFileName (FName);
    If (Command <> cmCancel) and (Command <> cmFileClear) and (Command <> cmClose) then Begin
      If IsWild (FName) then Begin
        FSplit (FName, Dir, Name, Ext);
        if Dir[Length(Dir)] = PathSeparator
        then begin
          while Dir[Length(Dir)] = PathSeparator do Dec(Dir[0]);
          Dir := Dir + PathSeparator
        end;
        If CheckDirectory (Dir) then Begin
          DisposeStr (Directory);
          Directory:=NewStr (Dir);
          WildCard:=Name+Ext;
          If Command <> cmFileInit then FileList^.Select;
          FileList^.ReadDirectory (Directory^+WildCard);
        End
      End
      Else If IsDir (FName) then Begin
             If CheckDirectory (FName) then Begin
               DisposeStr (Directory);
	       Directory:=NewStr (FName+PathSeparator);
               If Command <> cmFileInit then FileList^.Select;
               FileList^.ReadDirectory(Directory^+WildCard);
             End
           End
           Else If ValidFileName (FName) then Valid:=True
                Else Begin
                  MessageBox(GetStr(112), nil, mfError + mfOkButton);
                  Valid:=False;
                End
      End
      Else Valid:=True;
  End;
End;

(************************** TDirCollection object ***************************)

function TDirCollection.GetItem(var S: TStream): Pointer;
var DirItem: PDirEntry;
Begin
  New (DirItem);
  S.Read(DirItem^.DisplayOpt, SizeOf(Word));
  DirItem^.Directory:=S.ReadStr;
  GetItem:=DirItem;
End;

procedure TDirCollection.FreeItem(Item: Pointer);
var DirItem: PDirEntry absolute Item;
Begin
  DisposeStr (DirItem^.Directory);
  Dispose (DirItem);
End;

procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
var DirItem: PDirEntry absolute Item;
Begin
  S.Write(DirItem^.DisplayOpt, SizeOf(Word));
  S.WriteStr (DirItem^.Directory);
End;

(**************************** TDirListBox object ****************************)

constructor TDirListBox.Init(var Bounds: TRect; AScrollBar: PScrollBar);
Begin
  inherited Init(Bounds, AScrollBar);
  Flags := StdDirListFlags;
  Dir:='';
End;

destructor TDirListBox.Done;
Begin
  If List <> nil then Dispose (List, Done);
  inherited Done;
End;

procedure TDirListBox.DrawItemText(Item: Integer; R: TRect);
var S: String;
    CurOpt: Word;
    Color: Word;
    Icon: Word;
Begin
  S := GetText(Item, $FF);
  CurOpt := PDirEntry(List^.At(Item))^.DisplayOpt;

  R.Grow(-5, 0);
  SetSubRect(R);

  case CurOpt and $FF00 of
    doPathDir :
      If IsSelected(Item) then Icon := 27 else Icon := 26;
{$ifndef LINUX}
    doDrive   :
      Icon := 27 + {$ifdef HAVE_REDIR} FileSystem^.GetDriveType(S)
        {$else} GetDriveType(S[1]) {$endif};
    doDrivesText:
      begin
	Dec(R.A.X, 10);
	Icon := 0;
      end;
{$endif}
   else
     Icon := 25;
  end;

  {$ifdef LINUX}
  if S <> PathSeparator
    then While Pos(PathSeparator,S) <> 0 do Delete(S, 1, Pos(PathSeparator,S));
  {$else}
  If Length(S) <> 3 then
    While Pos(PathSeparator,S) <> 0 do Delete(S, 1, Pos(PathSeparator,S))
    Else If CurOpt and $FF00 = doDrive then Dec(S[0], 2);
  {$endif}

  If (State and sfSelected<>0) and (Item = Focused) then Color := 15
						    else Color := 0;

  If Icon <> 0
  then DrawColIcon(R.A.X + Lo(CurOpt) * 10 - 10,
    (R.A.Y + R.B.Y - DrawIcon(0, 0, Icon, $FFFF)) div 2, Icon, Color);

  {While TextWidth(S) > R.B.X do Dec(S[0]);}

  Dec(R.B.Y, R.A.Y);
  OutTextXY(R.A.X + 10 + Lo(CurOpt) * 10, R.A.Y + R.B.Y div 2 + 1, S);
End;

function TDirListBox.GetText(Item: Integer; MaxLen: Integer): String;
var
  D: PString;
Begin
  D := PDirEntry (List^.At(Item))^.Directory;
  if D = nil
  then GetText := ''
  else GetText := D^;
  {GetText:=PDirEntry (List^.At(Item))^.Directory^;}
End;

procedure TDirListBox.HandleEvent(var Event: TEvent);
Begin
  If (Event.What = evMouseDown) and (Event.Double) then Begin
    Event.What:=evCommand;
    Event.Command:=cmChangeDir;
    PutEvent(Event);
    ClearEvent(Event);
  End
  Else inherited HandleEvent(Event);
End;

function TDirListBox.IsSelected(Item: Integer): Boolean;
Begin
  IsSelected:=Item=Cur;
End;

procedure TDirListBox.NewDirectory(var ADir: DirStr);
const
  IndentSize         = '  ';

var AList: PCollection;
    NewDir, Dirct: DirStr;
    C, OldC: Char;
    S: String[80];
    P: PString;
    isFirst: Boolean;
    SR: SearchRec;
    I: Integer;
    DirEntry: PDirEntry;
    Index: Integer;
    Opt: Word;
    Indent: Byte;

 function NewDirEntry (DisplayOpt: Word; Directory: String): PDirEntry; {$ifndef FPK}near;{$endif}
 var DirEntry: PDirEntry;
 Begin
   New (DirEntry);
   DirEntry^.DisplayOpt:=DisplayOpt;
   DirEntry^.Directory:=NewStr (Directory);
   NewDirEntry:=DirEntry;
 End;

Begin
  Dir:=ADir;
  AList:=New (PDirCollection, Init(5,5));
{$ifndef LINUX}
  AList^.Insert (NewDirEntry (doDrivesText,GetStr(113)));
  If Dir = GetStr(113) then Begin {Drives}
    isFirst:=True;
    OldC:=' ';
    for C:='A' to 'Z' do Begin
      If ((C < 'C') and (GetDriveType(C) <> dtInvalid)) or DriveValid(C)
      then Begin
	If OldC <> ' ' then Begin
          If isFirst then Begin
	    Opt:=doDrive;
            isFirst:=False;
          End
          Else Opt:=doDrive;
	  AList^.Insert (NewDirEntry (Opt + 1, OldC + ':\'));
        End;
        If C = GetCurDrive then Cur := AList^.Count;
        OldC:=C;
      End;
    End;
    If OldC <> ' ' then AList^.Insert (NewDirEntry (doDrive + 1, OldC + ':\'));
  End
  Else Begin
    Indent:=1;
    NewDir:=Dir;
    if Flags and dfLowerCase <> 0 then LoStr(NewDir);
    Dirct:=Copy (NewDir,1,3);
    AList^.Insert (NewDirEntry(doPathDir + Indent, Dirct));
    Inc(Indent);
    NewDir:=Copy(NewDir,4,255);
{$else}
  Begin
    Indent := 0;
    Dirct := PathSeparator;
    AList^.Insert(NewDirEntry(doPathDir + Indent, Dirct));
    Inc(Indent);
    NewDir := Copy(Dir, 2, 255);
{$endif}
    While NewDir <> '' do Begin
      I:=Pos (PathSeparator,NewDir);
      If I <> 0 then Begin
        S:=Copy (NewDir,1,I-1);
	Dirct := Dirct + S;
        AList^.Insert (NewDirEntry (doPathDir + Indent , Dirct));
        NewDir:=Copy(NewDir,I+1,255);
      End
      Else Begin
        Dirct:=Dirct + NewDir;
        AList^.Insert (NewDirEntry (doPathDir + Indent, Dirct));
	NewDir:='';
      End;
      Inc(Indent);
      Dirct:=Dirct + PathSeparator;
    End;
    Cur:=AList^.Count-1;
    isFirst:=True;
    NewDir:=Dirct + AllFiles;
    FindFirst (NewDir, Directory, SR);
    While DosError = 0 do Begin
      If (SR.Attr and Directory <> 0) and (SR.Name[1] <> '.') then Begin
        if Flags and dfLowerCase <> 0 then LoStr(SR.Name);
        If isFirst then	Begin
	  Opt:=doFirstDir;
	  isFirst:=False;
	End
        Else Opt:=doMiddleDir;
        Index := AList^.Count;
        if Flags and dfSorted <> 0
        then begin
          while (PDirEntry(AList^.At(Index-1))^.DisplayOpt and 255 = Indent)
                and (PDirEntry(AList^.At(Index-1))^.Directory^ > Dirct + SR.Name)
          do Dec(Index);
        end;
        AList^.AtInsert(Index, NewDirEntry (Indent + Opt, Dirct + SR.Name));
      End;
      FindNext (SR);
    End;
  End;
  NewFocus := Cur;
  If TopItem <> 0 then TopItem := 0;
  NewList (AList);
End;

procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
Begin
  inherited SetState (AState, Enable);
  if (AState and sfFocused <> 0) and
     (PChDirDialog(GOwner)^.ChDirButton<>nil) then
    PChDirDialog(GOwner)^.ChDirButton^.MakeDefault (Enable);
End;

(************************** TChDirDialog object *****************************)

constructor TChDirDialog.Init(AOptions: Word; HistoryId: Byte);
var R: TRect;
    Control: PGView;
Begin
  R.Assign(0, 0, 435, 270);
  inherited Init(R, GetStr(114));
  Options:=Options or (ofCenterX+ofCenterY);

  R.Assign(15, 62, 263, 82);
  DirInput:=New (PInputLine, Init(R, 68));
  R.Assign (15, 40, 150, 60);
  Control:=New (PLabel, Init (R, GetStr(119), DirInput));
  Insert (DirInput);
  Insert (Control);
  R.Assign(262, 62, 280, 82);
  Control := New(PHistory, Init(R, DirInput, HistoryId));
  Insert(Control);

  R.Assign (262, 125, 280, 252);
  Control:=New (PScrollBar, Init (R));
  R.Assign(15, 125, 263, 252);
  DirList:=New (PDirListBox, Init (R, PScrollBar(Control)));
  Insert (Control);

  R.Assign (15, 100, 150, 120);
  Control:=New (PLabel, Init (R, GetStr(120), DirList));
  Insert (DirList);
  Insert(Control);

  R.Assign(300, 40, 420, 65);
  OkButton:=New (PButton, Init(R, GetStr(115), cmOK, bfDefault));
  Insert (OkButton);
  R.Move (0,35);
  ChDirButton:=New (PButton, Init (R, GetStr(116), cmChangeDir, bfNormal));
  Insert (ChDirButton);
  R.Move (0,35);
  Insert (New (PButton, Init (R, GetStr(117), cmRevert, bfNormal)));
  If AOptions and cdHelpButton <> 0 then Begin
    R.Move (0,35);
    Control:=New (PButton, Init (R, GetStr(118), cmHelp, bfNormal));
    Insert (Control);
  End;

  If AOptions and cdNoLoadDir = 0 then SetUpDialog;

  SelectNext (false);
End;

constructor TChDirDialog.Load(var S: TStream);
Begin
  inherited Load(S);
  GetSubViewPtr(S, DirList);
  GetSubViewPtr(S, DirInput);
  GetSubViewPtr(S, OkButton);
  GetSubViewPtr(S, ChDirbutton);
  SetUpDialog;
End;

function TChDirDialog.DataSize: Sw_Word;
Begin
  DataSize:=0
End;

procedure TChDirDialog.GetData(var Rec);
Begin
End;

procedure TChDirDialog.HandleEvent(var Event: TEvent);
var CurDir: DirStr;
    P: PDirEntry;
Begin
  inherited HandleEvent (Event);
  Case Event.What of
    evCommand:
      Begin
        Case Event.Command of
          cmRevert: GetDir (0,CurDir);
          cmChangeDir:
            Begin
              P:=DirList^.List^.At(DirList^.Focused);
              If {$ifndef LINUX}(P^.Directory^ = GetStr(113)) or {$endif}
		DriveValid(P^.Directory^[1]) then
                CurDir := P^.Directory^
              Else Exit;
            End;
         else Exit;
        End;
	If (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = PathSeparator) then
          CurDir:=Copy (CurDir,1,Length (CurDir)-1);
        DirList^.NewDirectory (CurDir);
        DirInput^.Data^:=CurDir;
        DirInput^.DrawView;
        DirList^.Select;
        ClearEvent(Event);
      End;
  End;
End;

procedure TChDirDialog.SetData(var Rec);
Begin
End;

procedure TChDirDialog.SetUpDialog;
var CurDir: DirStr;
Begin
  If DirList <> nil then Begin
    CurDir:=GetCurDir;
    DirList^.NewDirectory (CurDir);
    If (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = PathSeparator) then
      CurDir:=Copy(CurDir,1,Length(CurDir)-1);
    If DirInput <> nil then Begin
      DirInput^.Data^:=CurDir;
      DirInput^.DrawView;
    End;
  End;
End;

procedure TChDirDialog.Store(var S: TStream);
Begin
  inherited Store (S);
  PutSubViewPtr (S, DirList);
  PutSubViewPtr (S, DirInput);
  PutSubViewPtr (S, OkButton);
  PutSubViewPtr (S, ChDirButton);
End;

function TChDirDialog.Valid(Command: Word): Boolean;
var P: PathStr;
Begin
  Valid:=True;
  If Command = cmOk then Begin
    P:=FExpand (DirInput^.Data^);
    If (Length(P) > 3) and (P[Length(P)] = PathSeparator) then Dec(P[0]);
    {$I-}
    ChDir (P);
    If IOResult <> 0 then Begin
      MessageBox(GetStr(121), nil, mfError + mfOkButton);
      Valid := False;
      ChDir(DirList^.Dir);
    End;
    {$I+}
  End;
End;

(*********************** Stream registration procedure **********************)

procedure RegisterGVStdDlg;
Begin
  RegisterType (RFileInputLine);
  RegisterType (RFileCollection);
  RegisterType (RFileList);
  RegisterType (RFileInfoPane);
  RegisterType (RFileDialog);
  RegisterType (RDirCollection);
  RegisterType (RDirListBox);
  RegisterType (RChDirDialog);
End;

End.
