|
@@ -0,0 +1,2686 @@
|
|
|
+{*******************************************************}
|
|
|
+{ Free Vision Runtime Library }
|
|
|
+{ StdDlg Unit }
|
|
|
+{ Version: 0.1.0 }
|
|
|
+{ Release Date: July 23, 1998 }
|
|
|
+{ }
|
|
|
+{*******************************************************}
|
|
|
+{ }
|
|
|
+{ This unit is a port of Borland International's }
|
|
|
+{ StdDlg.pas unit. It is for distribution with the }
|
|
|
+{ Free Pascal (FPK) Compiler as part of the 32-bit }
|
|
|
+{ Free Vision library. The unit is still fully }
|
|
|
+{ functional under BP7 by using the tp compiler }
|
|
|
+{ directive when rebuilding the library. }
|
|
|
+{ }
|
|
|
+{*******************************************************}
|
|
|
+
|
|
|
+{ Revision History
|
|
|
+
|
|
|
+1.1a (97/12/29)
|
|
|
+ - fixed bug in TFileDialog.HandleEvent that prevented the user from being
|
|
|
+ able to have an action taken automatically when the FileList was
|
|
|
+ selected and kbEnter pressed
|
|
|
+
|
|
|
+1.1
|
|
|
+ - modified OpenNewFile to take a history list ID
|
|
|
+ - implemented OpenNewFile
|
|
|
+
|
|
|
+1.0 (1992)
|
|
|
+ - original implementation }
|
|
|
+
|
|
|
+unit StdDlg;
|
|
|
+
|
|
|
+{
|
|
|
+ This unit has been modified to make some functions global, apply patches
|
|
|
+ from version 3.1 of the TVBUGS list, added TEditChDirDialog, and added
|
|
|
+ several new global functions and procedures.
|
|
|
+}
|
|
|
+
|
|
|
+{$i platform.inc}
|
|
|
+
|
|
|
+{$ifdef PPC_FPC}
|
|
|
+ {$H-}
|
|
|
+{$else}
|
|
|
+ {$F+,O+,E+,N+}
|
|
|
+{$endif}
|
|
|
+{$X+,R-,I-,Q-,V-}
|
|
|
+{$ifndef OS_LINUX}
|
|
|
+ {$S-}
|
|
|
+{$endif}
|
|
|
+{$ifdef OS_DOS}
|
|
|
+ {$define HAS_DOS_DRIVES}
|
|
|
+{$endif}
|
|
|
+{$ifdef OS_WINDOWS}
|
|
|
+ {$define HAS_DOS_DRIVES}
|
|
|
+{$endif}
|
|
|
+{$ifdef OS_OS2}
|
|
|
+ {$define HAS_DOS_DRIVES}
|
|
|
+{$endif}
|
|
|
+
|
|
|
+interface
|
|
|
+
|
|
|
+uses
|
|
|
+ ObjTypes, Objects, Drivers, Views, Dialogs, Validate, Dos;
|
|
|
+
|
|
|
+const
|
|
|
+{$ifdef PPC_FPC}
|
|
|
+ MaxDir = 255; { Maximum length of a DirStr. }
|
|
|
+ MaxFName = 255; { Maximum length of a FNameStr. }
|
|
|
+
|
|
|
+ {$ifdef OS_LINUX}
|
|
|
+ DirSeparator : Char = '/';
|
|
|
+ {$else}
|
|
|
+ DirSeparator : Char = '\';
|
|
|
+ {$endif}
|
|
|
+
|
|
|
+{$else}
|
|
|
+ MaxDir = 67; { Maximum length of a DirStr. }
|
|
|
+ MaxFName = 79; { Maximum length of a FNameStr. }
|
|
|
+ DirSeparator: Char = '\';
|
|
|
+{$endif}
|
|
|
+
|
|
|
+
|
|
|
+type
|
|
|
+ { TSearchRec }
|
|
|
+
|
|
|
+ { Record used to store directory information by TFileDialog
|
|
|
+ This is a part of Dos.Searchrec for Bp !! }
|
|
|
+
|
|
|
+ TSearchRec = packed record
|
|
|
+ Attr: Longint;
|
|
|
+ Time: Longint;
|
|
|
+ Size: Longint;
|
|
|
+{$ifdef PPC_FPC}
|
|
|
+ Name: string[255];
|
|
|
+{$else not PPC_FPC}
|
|
|
+ Name: string[12];
|
|
|
+{$endif not PPC_FPC}
|
|
|
+ end;
|
|
|
+ PSearchRec = ^TSearchRec;
|
|
|
+
|
|
|
+type
|
|
|
+
|
|
|
+ { 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: Sw_Integer);
|
|
|
+ procedure HandleEvent(var Event: TEvent); virtual;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { 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;
|
|
|
+
|
|
|
+ {#Z+}
|
|
|
+ PFileValidator = ^TFileValidator;
|
|
|
+ {#Z-}
|
|
|
+ TFileValidator = Object(TValidator)
|
|
|
+ end; { of TFileValidator }
|
|
|
+
|
|
|
+ { TSortedListBox is a TListBox that assumes it has a }
|
|
|
+ { TStoredCollection instead of just a TCollection. It will }
|
|
|
+ { perform an incremental search on the contents. }
|
|
|
+
|
|
|
+ PSortedListBox = ^TSortedListBox;
|
|
|
+ TSortedListBox = object(TListBox)
|
|
|
+ SearchPos: Byte;
|
|
|
+ ShiftState: Byte;
|
|
|
+ constructor Init(var Bounds: TRect; ANumCols: Sw_Word;
|
|
|
+ AScrollBar: PScrollBar);
|
|
|
+ procedure HandleEvent(var Event: TEvent); virtual;
|
|
|
+ function GetKey(var S: String): Pointer; virtual;
|
|
|
+ procedure NewList(AList: PCollection); virtual;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { 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; AScrollBar: PScrollBar);
|
|
|
+ destructor Done; virtual;
|
|
|
+ function DataSize: Sw_Word; virtual;
|
|
|
+ procedure FocusItem(Item: Sw_Integer); virtual;
|
|
|
+ procedure GetData(var Rec); virtual;
|
|
|
+ function GetText(Item,MaxLen: Sw_Integer): String; virtual;
|
|
|
+ function GetKey(var S: String): Pointer; virtual;
|
|
|
+ procedure HandleEvent(var Event: TEvent); virtual;
|
|
|
+ procedure ReadDirectory(AWildCard: PathStr);
|
|
|
+ procedure SetData(var Rec); virtual;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { TFileInfoPane is a TView that displays the information }
|
|
|
+ { about the currently selected file in the TFileList }
|
|
|
+ { of a TFileDialog. }
|
|
|
+
|
|
|
+ PFileInfoPane = ^TFileInfoPane;
|
|
|
+ TFileInfoPane = object(TView)
|
|
|
+ S: TSearchRec;
|
|
|
+ constructor Init(var Bounds: TRect);
|
|
|
+ procedure Draw; virtual;
|
|
|
+ function GetPalette: PPalette; virtual;
|
|
|
+ procedure HandleEvent(var Event: TEvent); virtual;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { TFileDialog is a standard file name input dialog }
|
|
|
+
|
|
|
+ TWildStr = PathStr;
|
|
|
+
|
|
|
+const
|
|
|
+ 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. }
|
|
|
+
|
|
|
+type
|
|
|
+
|
|
|
+ PFileHistory = ^TFileHistory;
|
|
|
+ TFileHistory = object(THistory)
|
|
|
+ CurDir : PString;
|
|
|
+ procedure HandleEvent(var Event: TEvent);virtual;
|
|
|
+ destructor Done; virtual;
|
|
|
+ procedure AdaptHistoryToDir(Dir : string);
|
|
|
+ end;
|
|
|
+
|
|
|
+ PFileDialog = ^TFileDialog;
|
|
|
+ TFileDialog = object(TDialog)
|
|
|
+ FileName: PFileInputLine;
|
|
|
+ FileList: PFileList;
|
|
|
+ FileHistory: PFileHistory;
|
|
|
+ WildCard: TWildStr;
|
|
|
+ Directory: PString;
|
|
|
+ constructor Init(AWildCard: TWildStr; const ATitle,
|
|
|
+ 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;
|
|
|
+
|
|
|
+ { TDirEntry }
|
|
|
+
|
|
|
+ PDirEntry = ^TDirEntry;
|
|
|
+ TDirEntry = record
|
|
|
+ DisplayText: PString;
|
|
|
+ Directory: PString;
|
|
|
+ end; { of TDirEntry }
|
|
|
+
|
|
|
+ { 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;
|
|
|
+
|
|
|
+ { 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;
|
|
|
+ function GetText(Item,MaxLen: Sw_Integer): String; virtual;
|
|
|
+ procedure HandleEvent(var Event: TEvent); virtual;
|
|
|
+ function IsSelected(Item: Sw_Integer): Boolean; virtual;
|
|
|
+ procedure NewDirectory(var ADir: DirStr);
|
|
|
+ procedure SetState(AState: Word; Enable: Boolean); virtual;
|
|
|
+ end;
|
|
|
+
|
|
|
+ { 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: Sw_Word);
|
|
|
+ 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;
|
|
|
+
|
|
|
+ PEditChDirDialog = ^TEditChDirDialog;
|
|
|
+ TEditChDirDialog = Object(TChDirDialog)
|
|
|
+ { TEditChDirDialog allows setting/getting the starting directory. The
|
|
|
+ transfer record is a DirStr. }
|
|
|
+ function DataSize : Sw_Word; virtual;
|
|
|
+ procedure GetData (var Rec); virtual;
|
|
|
+ procedure SetData (var Rec); virtual;
|
|
|
+ end; { of TEditChDirDialog }
|
|
|
+
|
|
|
+
|
|
|
+ {#Z+}
|
|
|
+ PDirValidator = ^TDirValidator;
|
|
|
+ {#Z-}
|
|
|
+ TDirValidator = Object(TFilterValidator)
|
|
|
+ constructor Init;
|
|
|
+ function IsValid(const S: string): Boolean; virtual;
|
|
|
+ function IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
|
|
|
+ virtual;
|
|
|
+ end; { of TDirValidator }
|
|
|
+
|
|
|
+
|
|
|
+ FileConfirmFunc = function (AFile : FNameStr) : Boolean;
|
|
|
+ { Functions of type FileConfirmFunc's are used to prompt the end user for
|
|
|
+ confirmation of an operation.
|
|
|
+
|
|
|
+ FileConfirmFunc's should ask the user whether to perform the desired
|
|
|
+ action on the file named AFile. If the user elects to perform the
|
|
|
+ function FileConfirmFunc's return True, otherwise they return False.
|
|
|
+
|
|
|
+ Using FileConfirmFunc's allows routines to be coded independant of the
|
|
|
+ user interface implemented. OWL and TurboVision are supported through
|
|
|
+ conditional defines. If you do not use either user interface you must
|
|
|
+ compile this unit with the conditional define cdNoMessages and set all
|
|
|
+ FileConfirmFunc variables to a valid function prior to calling any
|
|
|
+ routines in this unit. }
|
|
|
+ {#X ReplaceFile DeleteFile }
|
|
|
+
|
|
|
+
|
|
|
+var
|
|
|
+
|
|
|
+ ReplaceFile : FileConfirmFunc;
|
|
|
+ { ReplaceFile returns True if the end user elects to replace the existing
|
|
|
+ file with the new file, otherwise it returns False.
|
|
|
+
|
|
|
+ ReplaceFile is only called when #CheckOnReplace# is True. }
|
|
|
+ {#X DeleteFile }
|
|
|
+
|
|
|
+ DeleteFile : FileConfirmFunc;
|
|
|
+ { DeleteFile returns True if the end user elects to delete the file,
|
|
|
+ otherwise it returns False.
|
|
|
+
|
|
|
+ DeleteFile is only called when #CheckOnDelete# is True. }
|
|
|
+ {#X ReplaceFile }
|
|
|
+
|
|
|
+
|
|
|
+const
|
|
|
+
|
|
|
+ CInfoPane = #30;
|
|
|
+
|
|
|
+ { TStream registration records }
|
|
|
+
|
|
|
+function Contains(S1, S2: String): Boolean;
|
|
|
+ { Contains returns true if S1 contains any characters in S2. }
|
|
|
+
|
|
|
+function DriveValid(Drive: Char): Boolean;
|
|
|
+ { DriveValid returns True if Drive is a valid DOS drive. Drive valid works
|
|
|
+ by attempting to change the current directory to Drive, then restoring
|
|
|
+ the original directory. }
|
|
|
+
|
|
|
+function ExtractDir(AFile: FNameStr): DirStr;
|
|
|
+ { ExtractDir returns the path of AFile terminated with a trailing '\'. If
|
|
|
+ AFile contains no directory information, an empty string is returned. }
|
|
|
+
|
|
|
+function ExtractFileName(AFile: FNameStr): NameStr;
|
|
|
+ { ExtractFileName returns the file name without any directory or file
|
|
|
+ extension information. }
|
|
|
+
|
|
|
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
|
|
|
+ { Equal returns True if S1 equals S2 for up to Count characters. Equal is
|
|
|
+ case-insensitive. }
|
|
|
+
|
|
|
+function FileExists (AFile : FNameStr) : Boolean;
|
|
|
+ { FileExists looks for the file specified in AFile. If AFile is present
|
|
|
+ FileExists returns true, otherwise FileExists returns False.
|
|
|
+
|
|
|
+ The search is performed relative to the current system directory, but
|
|
|
+ other directories may be searched by prefacing a file name with a valid
|
|
|
+ directory path.
|
|
|
+
|
|
|
+ There is no check for a vaild file name or drive. Errrors are handled
|
|
|
+ internally and not reported in DosError. Critical errors are left to
|
|
|
+ the system's critical error handler. }
|
|
|
+ {#X OpenFile }
|
|
|
+
|
|
|
+function GetCurDir: DirStr;
|
|
|
+ { GetCurDir returns the current directory. The directory returned always
|
|
|
+ ends with a trailing backslash '\'. }
|
|
|
+
|
|
|
+function GetCurDrive: Char;
|
|
|
+ { GetCurDrive returns the letter of the current drive as reported by the
|
|
|
+ operating system. }
|
|
|
+
|
|
|
+function IsWild(const S: String): Boolean;
|
|
|
+ { IsWild returns True if S contains a question mark (?) or asterix (*). }
|
|
|
+
|
|
|
+function IsList(const S: String): Boolean;
|
|
|
+ { IsList returns True if S contains list separator (;) char }
|
|
|
+
|
|
|
+function IsDir(const S: String): Boolean;
|
|
|
+ { IsDir returns True if S is a valid DOS directory. }
|
|
|
+
|
|
|
+procedure MakeResources;
|
|
|
+ { MakeResources places a language specific version of all resources
|
|
|
+ needed for the StdDlg unit to function on the RezFile using the string
|
|
|
+ constants and variables in the Resource unit. The Resource unit and the
|
|
|
+ appropriate string lists must be initialized prior to calling this
|
|
|
+ procedure. }
|
|
|
+
|
|
|
+function NoWildChars(S: String): String;
|
|
|
+ { NoWildChars deletes the wild card characters ? and * from the string S
|
|
|
+ and returns the result. }
|
|
|
+
|
|
|
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
|
|
|
+ { OpenFile prompts the user to select a file using the file specifications
|
|
|
+ in AFile as the starting file and path. Wildcards are accepted. If the
|
|
|
+ user accepts a file OpenFile returns True, otherwise OpenFile returns
|
|
|
+ False.
|
|
|
+
|
|
|
+ Note: The file returned may or may not exist. }
|
|
|
+
|
|
|
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
|
|
|
+ { OpenNewFile allows the user to select a directory from disk and enter a
|
|
|
+ new file name. If the file name entered is an existing file the user is
|
|
|
+ optionally prompted for confirmation of replacing the file based on the
|
|
|
+ value in #CheckOnReplace#. If a file name is successfully entered,
|
|
|
+ OpenNewFile returns True. }
|
|
|
+ {#X OpenFile }
|
|
|
+
|
|
|
+function PathValid(var Path: PathStr): Boolean;
|
|
|
+ { PathValid returns True if Path is a valid DOS path name. Path may be a
|
|
|
+ file or directory name. Trailing '\'s are removed. }
|
|
|
+
|
|
|
+procedure RegisterStdDlg;
|
|
|
+ { RegisterStdDlg registers all objects in the StdDlg unit for stream
|
|
|
+ usage. }
|
|
|
+
|
|
|
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
|
|
|
+ { SaveAs prompts the user for a file name using AFile as a template. If
|
|
|
+ AFile already exists and CheckOnReplace is True, the user is prompted
|
|
|
+ to replace the file.
|
|
|
+
|
|
|
+ If a valid file name is entered SaveAs returns True, other SaveAs returns
|
|
|
+ False. }
|
|
|
+
|
|
|
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
|
|
|
+ { SelectDir prompts the user to select a directory using ADir as the
|
|
|
+ starting directory. If a directory is selected, SelectDir returns True.
|
|
|
+ The directory returned is gauranteed to exist. }
|
|
|
+
|
|
|
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
|
|
|
+ { ShrinkPath returns a file name with a maximu length of MaxLen.
|
|
|
+ Internal directories are removed and replaced with elipses as needed to
|
|
|
+ make the file name fit in MaxLen.
|
|
|
+
|
|
|
+ AFile must be a valid path name. }
|
|
|
+
|
|
|
+function StdDeleteFile (AFile : FNameStr) : Boolean;
|
|
|
+ { StdDeleteFile returns True if the end user elects to delete the file,
|
|
|
+ otherwise it returns False.
|
|
|
+
|
|
|
+ DeleteFile is only called when CheckOnDelete is True. }
|
|
|
+
|
|
|
+function StdReplaceFile (AFile : FNameStr) : Boolean;
|
|
|
+ { StdReplaceFile returns True if the end user elects to replace the existing
|
|
|
+ AFile with the new AFile, otherwise it returns False.
|
|
|
+
|
|
|
+ ReplaceFile is only called when CheckOnReplace is True. }
|
|
|
+
|
|
|
+function ValidFileName(var FileName: PathStr): Boolean;
|
|
|
+ { ValidFileName returns True if FileName is a valid DOS file name. }
|
|
|
+
|
|
|
+
|
|
|
+const
|
|
|
+ CheckOnReplace : Boolean = True;
|
|
|
+ { CheckOnReplace is used by file functions. If a file exists, it is
|
|
|
+ optionally replaced based on the value of CheckOnReplace.
|
|
|
+
|
|
|
+ If CheckOnReplace is False the file is replaced without asking the
|
|
|
+ user. If CheckOnReplace is True, the end user is asked to replace the
|
|
|
+ file using a call to ReplaceFile.
|
|
|
+
|
|
|
+ CheckOnReplace is set to True by default. }
|
|
|
+
|
|
|
+ CheckOnDelete : Boolean = True;
|
|
|
+ { CheckOnDelete is used by file and directory functions. If a file
|
|
|
+ exists, it is optionally deleted based on the value of CheckOnDelete.
|
|
|
+
|
|
|
+ If CheckOnDelete is False the file or directory is deleted without
|
|
|
+ asking the user. If CheckOnDelete is True, the end user is asked to
|
|
|
+ delete the file/directory using a call to DeleteFile.
|
|
|
+
|
|
|
+ CheckOnDelete is set to True by default. }
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+const
|
|
|
+ RFileInputLine: TStreamRec = (
|
|
|
+ ObjType: idFileInputLine;
|
|
|
+ VmtLink: Ofs(TypeOf(TFileInputLine)^);
|
|
|
+ Load: @TFileInputLine.Load;
|
|
|
+ Store: @TFileInputLine.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RFileCollection: TStreamRec = (
|
|
|
+ ObjType: idFileCollection;
|
|
|
+ VmtLink: Ofs(TypeOf(TFileCollection)^);
|
|
|
+ Load: @TFileCollection.Load;
|
|
|
+ Store: @TFileCollection.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RFileList: TStreamRec = (
|
|
|
+ ObjType: idFileList;
|
|
|
+ VmtLink: Ofs(TypeOf(TFileList)^);
|
|
|
+ Load: @TFileList.Load;
|
|
|
+ Store: @TFileList.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RFileInfoPane: TStreamRec = (
|
|
|
+ ObjType: idFileInfoPane;
|
|
|
+ VmtLink: Ofs(TypeOf(TFileInfoPane)^);
|
|
|
+ Load: @TFileInfoPane.Load;
|
|
|
+ Store: @TFileInfoPane.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RFileDialog: TStreamRec = (
|
|
|
+ ObjType: idFileDialog;
|
|
|
+ VmtLink: Ofs(TypeOf(TFileDialog)^);
|
|
|
+ Load: @TFileDialog.Load;
|
|
|
+ Store: @TFileDialog.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RDirCollection: TStreamRec = (
|
|
|
+ ObjType: idDirCollection;
|
|
|
+ VmtLink: Ofs(TypeOf(TDirCollection)^);
|
|
|
+ Load: @TDirCollection.Load;
|
|
|
+ Store: @TDirCollection.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RDirListBox: TStreamRec = (
|
|
|
+ ObjType: idDirListBox;
|
|
|
+ VmtLink: Ofs(TypeOf(TDirListBox)^);
|
|
|
+ Load: @TDirListBox.Load;
|
|
|
+ Store: @TDirListBox.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RChDirDialog: TStreamRec = (
|
|
|
+ ObjType: idChDirDialog;
|
|
|
+ VmtLink: Ofs(TypeOf(TChDirDialog)^);
|
|
|
+ Load: @TChDirDialog.Load;
|
|
|
+ Store: @TChDirDialog.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ RSortedListBox: TStreamRec = (
|
|
|
+ ObjType: idSortedListBox;
|
|
|
+ VmtLink: Ofs(TypeOf(TSortedListBox)^);
|
|
|
+ Load: @TSortedListBox.Load;
|
|
|
+ Store: @TSortedListBox.Store
|
|
|
+ );
|
|
|
+
|
|
|
+ REditChDirDialog : TStreamRec = (
|
|
|
+ ObjType : idEditChDirDialog;
|
|
|
+ VmtLink : Ofs(TypeOf(TEditChDirDialog)^);
|
|
|
+ Load : @TEditChDirDialog.Load;
|
|
|
+ Store : @TEditChDirDialog.Store);
|
|
|
+
|
|
|
+
|
|
|
+implementation
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ Local Declarations }
|
|
|
+{****************************************************************************}
|
|
|
+
|
|
|
+uses
|
|
|
+ FVConsts, App, Memory, HistList, MsgBox, Resource;
|
|
|
+
|
|
|
+type
|
|
|
+
|
|
|
+ PStringRec = record
|
|
|
+ { PStringRec is needed for properly displaying PStrings using
|
|
|
+ MessageBox. }
|
|
|
+ AString : PString;
|
|
|
+ end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TDirValidator Object }
|
|
|
+{****************************************************************************}
|
|
|
+{****************************************************************************}
|
|
|
+{ TDirValidator.Init }
|
|
|
+{****************************************************************************}
|
|
|
+constructor TDirValidator.Init;
|
|
|
+const { What should this list be? The commented one doesn't allow home,
|
|
|
+ end, right arrow, left arrow, Ctrl+XXXX, etc. }
|
|
|
+ Chars: TCharSet = ['A'..'Z','a'..'z','.','~',':','_','-'];
|
|
|
+{ Chars: TCharSet = [#0..#255]; }
|
|
|
+begin
|
|
|
+ Chars := Chars + [DirSeparator];
|
|
|
+ if not inherited Init(Chars) then
|
|
|
+ Fail;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TDirValidator.IsValid }
|
|
|
+{****************************************************************************}
|
|
|
+function TDirValidator.IsValid(const S: string): Boolean;
|
|
|
+begin
|
|
|
+{ IsValid := False; }
|
|
|
+ IsValid := True;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TDirValidator.IsValidInput }
|
|
|
+{****************************************************************************}
|
|
|
+function TDirValidator.IsValidInput(var S: string; SuppressFill: Boolean): Boolean;
|
|
|
+begin
|
|
|
+{ IsValid := False; }
|
|
|
+ IsValidInput := True;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileInputLine Object }
|
|
|
+{****************************************************************************}
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileInputLine.Init }
|
|
|
+{****************************************************************************}
|
|
|
+constructor TFileInputLine.Init(var Bounds: TRect; AMaxLen: Sw_Integer);
|
|
|
+begin
|
|
|
+ TInputLine.Init(Bounds, AMaxLen);
|
|
|
+ EventMask := EventMask or evBroadcast;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileInputLine.HandleEvent }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TFileInputLine.HandleEvent(var Event: TEvent);
|
|
|
+begin
|
|
|
+ TInputLine.HandleEvent(Event);
|
|
|
+ if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) and
|
|
|
+ (State and sfSelected = 0) then
|
|
|
+ begin
|
|
|
+ if PSearchRec(Event.InfoPtr)^.Attr and Directory <> 0 then
|
|
|
+ begin
|
|
|
+ Data^ := PSearchRec(Event.InfoPtr)^.Name + DirSeparator +
|
|
|
+ PFileDialog(Owner)^.WildCard;
|
|
|
+ { PFileDialog(Owner)^.FileHistory^.AdaptHistoryToDir(
|
|
|
+ PSearchRec(Event.InfoPtr)^.Name+DirSeparator);}
|
|
|
+ end
|
|
|
+ else Data^ := PSearchRec(Event.InfoPtr)^.Name;
|
|
|
+ DrawView;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileCollection Object }
|
|
|
+{****************************************************************************}
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileCollection.Compare }
|
|
|
+{****************************************************************************}
|
|
|
+ function uppername(const s : string) : string;
|
|
|
+ var
|
|
|
+ i : Sw_integer;
|
|
|
+ in_name : boolean;
|
|
|
+ begin
|
|
|
+ in_name:=true;
|
|
|
+ for i:=length(s) downto 1 do
|
|
|
+ if in_name and (s[i] in ['a'..'z']) then
|
|
|
+ uppername[i]:=char(byte(s[i])-32)
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ uppername[i]:=s[i];
|
|
|
+ if s[i] = DirSeparator then
|
|
|
+ in_name:=false;
|
|
|
+ end;
|
|
|
+ uppername[0]:=s[0];
|
|
|
+ end;
|
|
|
+
|
|
|
+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
|
|
|
+{$ifdef linux}
|
|
|
+ else if PSearchRec(Key1)^.Name > PSearchRec(Key2)^.Name then
|
|
|
+{$else linux}
|
|
|
+ else if UpperName(PSearchRec(Key1)^.Name) > UpperName(PSearchRec(Key2)^.Name) then
|
|
|
+{$endif def linux}
|
|
|
+ Compare := 1
|
|
|
+ else Compare := -1;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileCollection.FreeItem }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TFileCollection.FreeItem(Item: Pointer);
|
|
|
+begin
|
|
|
+ Dispose(PSearchRec(Item));
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileCollection.GetItem }
|
|
|
+{****************************************************************************}
|
|
|
+function TFileCollection.GetItem(var S: TStream): Pointer;
|
|
|
+var
|
|
|
+ Item: PSearchRec;
|
|
|
+begin
|
|
|
+ New(Item);
|
|
|
+ S.Read(Item^, SizeOf(TSearchRec));
|
|
|
+ GetItem := Item;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileCollection.PutItem }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TFileCollection.PutItem(var S: TStream; Item: Pointer);
|
|
|
+begin
|
|
|
+ S.Write(Item^, SizeOf(TSearchRec));
|
|
|
+end;
|
|
|
+
|
|
|
+
|
|
|
+{*****************************************************************************
|
|
|
+ TFileList
|
|
|
+*****************************************************************************}
|
|
|
+
|
|
|
+const
|
|
|
+ ListSeparator=';';
|
|
|
+
|
|
|
+function MatchesMask(What, Mask: string): boolean;
|
|
|
+
|
|
|
+ function upper(const s : string) : string;
|
|
|
+ var
|
|
|
+ i : Sw_integer;
|
|
|
+ begin
|
|
|
+ for i:=1 to length(s) do
|
|
|
+ if s[i] in ['a'..'z'] then
|
|
|
+ upper[i]:=char(byte(s[i])-32)
|
|
|
+ else
|
|
|
+ upper[i]:=s[i];
|
|
|
+ upper[0]:=s[0];
|
|
|
+ end;
|
|
|
+
|
|
|
+ Function CmpStr(const hstr1,hstr2:string):boolean;
|
|
|
+ var
|
|
|
+ found : boolean;
|
|
|
+ i1,i2 : Sw_integer;
|
|
|
+ begin
|
|
|
+ i1:=0;
|
|
|
+ i2:=0;
|
|
|
+ if hstr1='' then
|
|
|
+ begin
|
|
|
+ CmpStr:=(hstr2='');
|
|
|
+ exit;
|
|
|
+ end;
|
|
|
+ found:=true;
|
|
|
+ repeat
|
|
|
+ if found then
|
|
|
+ inc(i2);
|
|
|
+ inc(i1);
|
|
|
+ case hstr1[i1] of
|
|
|
+ '?' :
|
|
|
+ found:=true;
|
|
|
+ '*' :
|
|
|
+ begin
|
|
|
+ found:=true;
|
|
|
+ if (i1=length(hstr1)) then
|
|
|
+ i2:=length(hstr2)
|
|
|
+ else
|
|
|
+ if (i1<length(hstr1)) and (hstr1[i1+1]<>hstr2[i2]) then
|
|
|
+ begin
|
|
|
+ if i2<length(hstr2) then
|
|
|
+ dec(i1)
|
|
|
+ end
|
|
|
+ else
|
|
|
+ if i2>1 then
|
|
|
+ dec(i2);
|
|
|
+ end;
|
|
|
+ else
|
|
|
+ found:=(hstr1[i1]=hstr2[i2]) or (hstr2[i2]='?');
|
|
|
+ end;
|
|
|
+ until (i1>=length(hstr1)) or (i2>length(hstr2)) or (not found);
|
|
|
+ if found then
|
|
|
+ found:=(i1>=length(hstr1)) and (i2>=length(hstr2));
|
|
|
+ CmpStr:=found;
|
|
|
+ end;
|
|
|
+
|
|
|
+var
|
|
|
+ D1,D2 : DirStr;
|
|
|
+ N1,N2 : NameStr;
|
|
|
+ E1,E2 : Extstr;
|
|
|
+begin
|
|
|
+{$ifdef linux}
|
|
|
+ FSplit(What,D1,N1,E1);
|
|
|
+ FSplit(Mask,D2,N2,E2);
|
|
|
+{$else}
|
|
|
+ FSplit(Upper(What),D1,N1,E1);
|
|
|
+ FSplit(Upper(Mask),D2,N2,E2);
|
|
|
+{$endif}
|
|
|
+ MatchesMask:=CmpStr(N2,N1) and CmpStr(E2,E1);
|
|
|
+end;
|
|
|
+
|
|
|
+function MatchesMaskList(What, MaskList: string): boolean;
|
|
|
+var P: integer;
|
|
|
+ Match: boolean;
|
|
|
+begin
|
|
|
+ Match:=false;
|
|
|
+ if What<>'' then
|
|
|
+ repeat
|
|
|
+ P:=Pos(ListSeparator, MaskList);
|
|
|
+ if P=0 then P:=length(MaskList)+1;
|
|
|
+ Match:=MatchesMask(What,copy(MaskList,1,P-1));
|
|
|
+ Delete(MaskList,1,P);
|
|
|
+ until Match or (MaskList='');
|
|
|
+ MatchesMaskList:=Match;
|
|
|
+end;
|
|
|
+
|
|
|
+constructor TFileList.Init(var Bounds: TRect; AScrollBar: PScrollBar);
|
|
|
+begin
|
|
|
+ TSortedListBox.Init(Bounds, 2, AScrollBar);
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TFileList.Done;
|
|
|
+begin
|
|
|
+ if List <> nil then Dispose(List, Done);
|
|
|
+ TListBox.Done;
|
|
|
+end;
|
|
|
+
|
|
|
+function TFileList.DataSize: Sw_Word;
|
|
|
+begin
|
|
|
+ DataSize := 0;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileList.FocusItem(Item: Sw_Integer);
|
|
|
+begin
|
|
|
+ TSortedListBox.FocusItem(Item);
|
|
|
+ if (List^.Count > 0) then
|
|
|
+ Message(Owner, evBroadcast, cmFileFocused, List^.At(Item));
|
|
|
+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: Sw_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;
|
|
|
+{$ifndef linux}
|
|
|
+ UpStr(SR.Name);
|
|
|
+{$endif linux}
|
|
|
+ GetKey := @SR;
|
|
|
+end;
|
|
|
+
|
|
|
+function TFileList.GetText(Item,MaxLen: Sw_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] := DirSeparator;
|
|
|
+ Inc(S[0]);
|
|
|
+ end;
|
|
|
+ GetText := S;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileList.HandleEvent(var Event: TEvent);
|
|
|
+var
|
|
|
+ S : String;
|
|
|
+ K : pointer;
|
|
|
+ Value : Sw_integer;
|
|
|
+begin
|
|
|
+ if (Event.What = evMouseDown) and (Event.Double) then
|
|
|
+ begin
|
|
|
+ Event.What := evCommand;
|
|
|
+ Event.Command := cmOK;
|
|
|
+ PutEvent(Event);
|
|
|
+ ClearEvent(Event);
|
|
|
+ end
|
|
|
+ else if (Event.What = evKeyDown) and (Event.CharCode='<') then
|
|
|
+ begin
|
|
|
+ { select '..' }
|
|
|
+ S := '..';
|
|
|
+ K := GetKey(S);
|
|
|
+ If PSortedCollection(List)^.Search(K, Value) then
|
|
|
+ FocusItem(Value);
|
|
|
+ end
|
|
|
+ else TSortedListBox.HandleEvent(Event);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileList.ReadDirectory(AWildCard: PathStr);
|
|
|
+const
|
|
|
+ FindAttr = ReadOnly + Archive;
|
|
|
+{$ifdef linux}
|
|
|
+ AllFiles = '*';
|
|
|
+{$else}
|
|
|
+ AllFiles = '*.*';
|
|
|
+{$endif}
|
|
|
+ PrevDir = '..';
|
|
|
+var
|
|
|
+ S: SearchRec;
|
|
|
+ P: PSearchRec;
|
|
|
+ FileList: PFileCollection;
|
|
|
+ NumFiles: Word;
|
|
|
+ FindStr,
|
|
|
+ WildName : string;
|
|
|
+ Dir: DirStr;
|
|
|
+ Ext: ExtStr;
|
|
|
+ Name: NameStr;
|
|
|
+ Event : TEvent;
|
|
|
+ Tmp: PathStr;
|
|
|
+begin
|
|
|
+ NumFiles := 0;
|
|
|
+ FileList := New(PFileCollection, Init(5, 5));
|
|
|
+ AWildCard := FExpand(AWildCard);
|
|
|
+ FSplit(AWildCard, Dir, Name, Ext);
|
|
|
+ if pos(ListSeparator,AWildCard)>0 then
|
|
|
+ begin
|
|
|
+ WildName:=Copy(AWildCard,length(Dir)+1,255);
|
|
|
+ FindStr:=Dir+AllFiles;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ WildName:=Name+Ext;
|
|
|
+ FindStr:=AWildCard;
|
|
|
+ end;
|
|
|
+ FindFirst(FindStr, FindAttr, S);
|
|
|
+ P := PSearchRec(@P);
|
|
|
+ while assigned(P) and (DosError = 0) do
|
|
|
+ begin
|
|
|
+ if (S.Attr and Directory = 0) and
|
|
|
+ MatchesMaskList(S.Name,WildName) then
|
|
|
+ begin
|
|
|
+ P := MemAlloc(SizeOf(P^));
|
|
|
+ if assigned(P) then
|
|
|
+ begin
|
|
|
+ P^.Attr:=S.Attr;
|
|
|
+ P^.Time:=S.Time;
|
|
|
+ P^.Size:=S.Size;
|
|
|
+ P^.Name:=S.Name;
|
|
|
+ FileList^.Insert(P);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ FindNext(S);
|
|
|
+ end;
|
|
|
+ {$ifdef fpc}
|
|
|
+ FindClose(S);
|
|
|
+ {$endif}
|
|
|
+
|
|
|
+ Tmp := Dir + AllFiles;
|
|
|
+ FindFirst(Tmp, Directory, S);
|
|
|
+ while (P <> nil) and (DosError = 0) do
|
|
|
+ begin
|
|
|
+ if (S.Attr and Directory <> 0) and (S.Name <> '.') and (S.Name <> '..') then
|
|
|
+ begin
|
|
|
+ P := MemAlloc(SizeOf(P^));
|
|
|
+ if P <> nil then
|
|
|
+ begin
|
|
|
+ P^.Attr:=S.Attr;
|
|
|
+ P^.Time:=S.Time;
|
|
|
+ P^.Size:=S.Size;
|
|
|
+ P^.Name:=S.Name;
|
|
|
+ FileList^.Insert(P);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ FindNext(S);
|
|
|
+ end;
|
|
|
+ {$ifdef fpc}
|
|
|
+ FindClose(S);
|
|
|
+ {$endif}
|
|
|
+ {$ifndef linux}
|
|
|
+ if Length(Dir) > 4 then
|
|
|
+ {$endif not linux}
|
|
|
+ begin
|
|
|
+ P := MemAlloc(SizeOf(P^));
|
|
|
+ if P <> nil then
|
|
|
+ begin
|
|
|
+ FindFirst(Tmp, Directory, S);
|
|
|
+ FindNext(S);
|
|
|
+ if (DosError = 0) and (S.Name = PrevDir) then
|
|
|
+ begin
|
|
|
+ P^.Attr:=S.Attr;
|
|
|
+ P^.Time:=S.Time;
|
|
|
+ P^.Size:=S.Size;
|
|
|
+ P^.Name:=S.Name;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ P^.Name := PrevDir;
|
|
|
+ P^.Size := 0;
|
|
|
+ P^.Time := $210000;
|
|
|
+ P^.Attr := Directory;
|
|
|
+ end;
|
|
|
+ FileList^.Insert(PSearchRec(P));
|
|
|
+ {$ifdef fpc}
|
|
|
+ FindClose(S);
|
|
|
+ {$endif}
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if P = nil then
|
|
|
+ MessageBox(strings^.get(sTooManyFiles), nil, mfOkButton + mfWarning);
|
|
|
+ NewList(FileList);
|
|
|
+ if List^.Count > 0 then
|
|
|
+ begin
|
|
|
+ Event.What := evBroadcast;
|
|
|
+ Event.Command := cmFileFocused;
|
|
|
+ Event.InfoPtr := List^.At(0);
|
|
|
+ Owner^.HandleEvent(Event);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileList.SetData(var Rec);
|
|
|
+begin
|
|
|
+ with PFileDialog(Owner)^ do
|
|
|
+ Self.ReadDirectory(Directory^ + WildCard);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileInfoPane Object }
|
|
|
+{****************************************************************************}
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileInfoPane.Init }
|
|
|
+{****************************************************************************}
|
|
|
+constructor TFileInfoPane.Init(var Bounds: TRect);
|
|
|
+begin
|
|
|
+ TView.Init(Bounds);
|
|
|
+ FillChar(S,SizeOf(S),#0);
|
|
|
+ EventMask := EventMask or evBroadcast;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileInfoPane.Draw }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TFileInfoPane.Draw;
|
|
|
+var
|
|
|
+ B: TDrawBuffer;
|
|
|
+ D: String[9];
|
|
|
+ M: String[3];
|
|
|
+ PM: Boolean;
|
|
|
+ Color: Word;
|
|
|
+ Time: DateTime;
|
|
|
+ Path: PathStr;
|
|
|
+ FmtId: String;
|
|
|
+ Params: array[0..7] of LongInt;
|
|
|
+ Str: String[80];
|
|
|
+const
|
|
|
+ sDirectoryLine = ' %-12s %-9s %3s %2d, %4d %2d:%02d%cm';
|
|
|
+ sFileLine = ' %-12s %-9d %3s %2d, %4d %2d:%02d%cm';
|
|
|
+ InValidFiles : array[0..2] of string[12] = ('','.','..');
|
|
|
+var
|
|
|
+ Month: array[1..12] of String[3];
|
|
|
+begin
|
|
|
+ Month[1] := Strings^.Get(smJan);
|
|
|
+ Month[2] := Strings^.Get(smFeb);
|
|
|
+ Month[3] := Strings^.Get(smMar);
|
|
|
+ Month[4] := Strings^.Get(smApr);
|
|
|
+ Month[5] := Strings^.Get(smMay);
|
|
|
+ Month[6] := Strings^.Get(smJun);
|
|
|
+ Month[7] := Strings^.Get(smJul);
|
|
|
+ Month[8] := Strings^.Get(smAug);
|
|
|
+ Month[9] := Strings^.Get(smSep);
|
|
|
+ Month[10] := Strings^.Get(smOct);
|
|
|
+ Month[11] := Strings^.Get(smNov);
|
|
|
+ Month[12] := Strings^.Get(smDec);
|
|
|
+ { Display path }
|
|
|
+ if (PFileDialog(Owner)^.Directory <> nil) then
|
|
|
+ Path := PFileDialog(Owner)^.Directory^
|
|
|
+ else Path := '';
|
|
|
+ Path := FExpand(Path+PFileDialog(Owner)^.WildCard);
|
|
|
+ Color := GetColor($01);
|
|
|
+ MoveChar(B, ' ', Color, Size.X * Size.Y); { fill with empty spaces }
|
|
|
+ WriteLine(0, 0, Size.X, Size.Y, B);
|
|
|
+ MoveStr(B[1], Path, Color);
|
|
|
+ WriteLine(0, 0, Size.X, 1, B);
|
|
|
+ if (S.Name = InValidFiles[0]) or (S.Name = InValidFiles[1]) or
|
|
|
+ (S.Name = InValidFiles[2]) then
|
|
|
+ Exit;
|
|
|
+
|
|
|
+ { Display file }
|
|
|
+ Params[0] := LongInt(@S.Name);
|
|
|
+ if S.Attr and Directory <> 0 then
|
|
|
+ begin
|
|
|
+ FmtId := sDirectoryLine;
|
|
|
+ D := Strings^.Get(sDirectory);
|
|
|
+ Params[1] := LongInt(@D);
|
|
|
+ end else
|
|
|
+ begin
|
|
|
+ FmtId := sFileLine;
|
|
|
+ Params[1] := S.Size;
|
|
|
+ end;
|
|
|
+ UnpackTime(S.Time, Time);
|
|
|
+ M := Month[Time.Month];
|
|
|
+ Params[2] := LongInt(@M);
|
|
|
+ Params[3] := Time.Day;
|
|
|
+ Params[4] := Time.Year;
|
|
|
+ PM := Time.Hour >= 12;
|
|
|
+ Time.Hour := Time.Hour mod 12;
|
|
|
+ if Time.Hour = 0 then Time.Hour := 12;
|
|
|
+ Params[5] := Time.Hour;
|
|
|
+ Params[6] := Time.Min;
|
|
|
+ if PM then
|
|
|
+ Params[7] := Byte('p')
|
|
|
+ else Params[7] := Byte('a');
|
|
|
+ FormatStr(Str, FmtId, Params);
|
|
|
+ MoveStr(B, Str, Color);
|
|
|
+ WriteLine(0, 1, Size.X, 1, B);
|
|
|
+
|
|
|
+ { Fill in rest of rectangle }
|
|
|
+ MoveChar(B, ' ', Color, Size.X);
|
|
|
+ WriteLine(0, 2, Size.X, Size.Y-2, B);
|
|
|
+end;
|
|
|
+
|
|
|
+function TFileInfoPane.GetPalette: PPalette;
|
|
|
+const
|
|
|
+ P: String[Length(CInfoPane)] = CInfoPane;
|
|
|
+begin
|
|
|
+ GetPalette := PPalette(@P);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileInfoPane.HandleEvent(var Event: TEvent);
|
|
|
+begin
|
|
|
+ TView.HandleEvent(Event);
|
|
|
+ if (Event.What = evBroadcast) and (Event.Command = cmFileFocused) then
|
|
|
+ begin
|
|
|
+ S := PSearchRec(Event.InfoPtr)^;
|
|
|
+ DrawView;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************
|
|
|
+ TFileHistory
|
|
|
+****************************************************************************}
|
|
|
+
|
|
|
+ function LTrim(const S: String): String;
|
|
|
+ var
|
|
|
+ I: Sw_Integer;
|
|
|
+ begin
|
|
|
+ I := 1;
|
|
|
+ while (I < Length(S)) and (S[I] = ' ') do Inc(I);
|
|
|
+ LTrim := Copy(S, I, 255);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function RTrim(const S: String): String;
|
|
|
+ var
|
|
|
+ I: Sw_Integer;
|
|
|
+ begin
|
|
|
+ I := Length(S);
|
|
|
+ while S[I] = ' ' do Dec(I);
|
|
|
+ RTrim := Copy(S, 1, I);
|
|
|
+ end;
|
|
|
+
|
|
|
+ function RelativePath(var S: PathStr): Boolean;
|
|
|
+ begin
|
|
|
+ S := LTrim(RTrim(S));
|
|
|
+ RelativePath := not ((S <> '') and ((S[1] = DirSeparator) or (S[2] = ':')));
|
|
|
+ end;
|
|
|
+
|
|
|
+{ try to reduce the length of S+dir as a file path+pattern }
|
|
|
+
|
|
|
+ function Simplify (var S,Dir : string) : string;
|
|
|
+ var i : sw_integer;
|
|
|
+ begin
|
|
|
+ if RelativePath(Dir) then
|
|
|
+ begin
|
|
|
+ if (S<>'') and (Copy(Dir,1,3)='..'+DirSeparator) then
|
|
|
+ begin
|
|
|
+ i:=Length(S);
|
|
|
+ for i:=Length(S)-1 downto 1 do
|
|
|
+ if S[i]=DirSeparator then
|
|
|
+ break;
|
|
|
+ if S[i]=DirSeparator then
|
|
|
+ Simplify:=Copy(S,1,i)+Copy(Dir,4,255)
|
|
|
+ else
|
|
|
+ Simplify:=S+Dir;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ Simplify:=S+Dir;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ Simplify:=Dir;
|
|
|
+ end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TFileHistory.HandleEvent }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TFileHistory.HandleEvent(var Event: TEvent);
|
|
|
+var
|
|
|
+ HistoryWindow: PHistoryWindow;
|
|
|
+ R,P: TRect;
|
|
|
+ C: Word;
|
|
|
+ Rslt: String;
|
|
|
+begin
|
|
|
+ TView.HandleEvent(Event);
|
|
|
+ if (Event.What = evMouseDown) or
|
|
|
+ ((Event.What = evKeyDown) and (CtrlToArrow(Event.KeyCode) = kbDown) and
|
|
|
+ (Link^.State and sfFocused <> 0)) then
|
|
|
+ begin
|
|
|
+ if not Link^.Focus then
|
|
|
+ begin
|
|
|
+ ClearEvent(Event);
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if assigned(CurDir) then
|
|
|
+ Rslt:=CurDir^
|
|
|
+ else
|
|
|
+ Rslt:='';
|
|
|
+ Rslt:=Simplify(Rslt,Link^.Data^);
|
|
|
+ If IsWild(Rslt) then
|
|
|
+ RecordHistory(Rslt);
|
|
|
+ Link^.GetBounds(R);
|
|
|
+ Dec(R.A.X); Inc(R.B.X); Inc(R.B.Y,7); Dec(R.A.Y,1);
|
|
|
+ Owner^.GetExtent(P);
|
|
|
+ R.Intersect(P);
|
|
|
+ Dec(R.B.Y,1);
|
|
|
+ HistoryWindow := InitHistoryWindow(R);
|
|
|
+ if HistoryWindow <> nil then
|
|
|
+ begin
|
|
|
+ C := Owner^.ExecView(HistoryWindow);
|
|
|
+ if C = cmOk then
|
|
|
+ begin
|
|
|
+ Rslt := HistoryWindow^.GetSelection;
|
|
|
+ if Length(Rslt) > Link^.MaxLen then Rslt[0] := Char(Link^.MaxLen);
|
|
|
+ Link^.Data^ := Rslt;
|
|
|
+ Link^.SelectAll(True);
|
|
|
+ Link^.DrawView;
|
|
|
+ end;
|
|
|
+ Dispose(HistoryWindow, Done);
|
|
|
+ end;
|
|
|
+ ClearEvent(Event);
|
|
|
+ end
|
|
|
+ else if (Event.What = evBroadcast) then
|
|
|
+ if ((Event.Command = cmReleasedFocus) and (Event.InfoPtr = Link))
|
|
|
+ or (Event.Command = cmRecordHistory) then
|
|
|
+ begin
|
|
|
+ if assigned(CurDir) then
|
|
|
+ Rslt:=CurDir^
|
|
|
+ else
|
|
|
+ Rslt:='';
|
|
|
+ Rslt:=Simplify(Rslt,Link^.Data^);
|
|
|
+ If IsWild(Rslt) then
|
|
|
+ RecordHistory(Rslt);
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileHistory.AdaptHistoryToDir(Dir : string);
|
|
|
+ var S,S2 : String;
|
|
|
+ i,Count : Sw_word;
|
|
|
+begin
|
|
|
+ if assigned(CurDir) then
|
|
|
+ begin
|
|
|
+ S:=CurDir^;
|
|
|
+ if S=Dir then
|
|
|
+ exit;
|
|
|
+ DisposeStr(CurDir);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ S:='';
|
|
|
+ CurDir:=NewStr(Simplify(S,Dir));
|
|
|
+
|
|
|
+ Count:=HistoryCount(HistoryId);
|
|
|
+ for i:=1 to count do
|
|
|
+ begin
|
|
|
+ S2:=HistoryStr(HistoryId,1);
|
|
|
+ HistoryRemove(HistoryId,1);
|
|
|
+ if RelativePath(S2) then
|
|
|
+ if S<>'' then
|
|
|
+ S2:=S+S2
|
|
|
+ else
|
|
|
+ S2:=FExpand(S2);
|
|
|
+ { simply full path
|
|
|
+ we should simplify relative to Dir ! }
|
|
|
+ HistoryAdd(HistoryId,S2);
|
|
|
+ end;
|
|
|
+
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TFileHistory.Done;
|
|
|
+begin
|
|
|
+ If assigned(CurDir) then
|
|
|
+ DisposeStr(CurDir);
|
|
|
+ Inherited Done;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************
|
|
|
+ TFileDialog
|
|
|
+****************************************************************************}
|
|
|
+
|
|
|
+constructor TFileDialog.Init(AWildCard: TWildStr; const ATitle,
|
|
|
+ InputName: String; AOptions: Word; HistoryId: Byte);
|
|
|
+var
|
|
|
+ Control: PView;
|
|
|
+ R: TRect;
|
|
|
+ Opt: Word;
|
|
|
+begin
|
|
|
+ R.Assign(15,1,64,20);
|
|
|
+ TDialog.Init(R, ATitle);
|
|
|
+ Options := Options or ofCentered;
|
|
|
+ WildCard := AWildCard;
|
|
|
+
|
|
|
+ R.Assign(3,3,31,4);
|
|
|
+ FileName := New(PFileInputLine, Init(R, 79));
|
|
|
+ FileName^.Data^ := WildCard;
|
|
|
+ Insert(FileName);
|
|
|
+ R.Assign(2,2,3+CStrLen(InputName),3);
|
|
|
+ Control := New(PLabel, Init(R, InputName, FileName));
|
|
|
+ Insert(Control);
|
|
|
+ R.Assign(31,3,34,4);
|
|
|
+ FileHistory := New(PFileHistory, Init(R, FileName, HistoryId));
|
|
|
+ Insert(FileHistory);
|
|
|
+
|
|
|
+ R.Assign(3,14,34,15);
|
|
|
+ Control := New(PScrollBar, Init(R));
|
|
|
+ Insert(Control);
|
|
|
+ R.Assign(3,6,34,14);
|
|
|
+ FileList := New(PFileList, Init(R, PScrollBar(Control)));
|
|
|
+ Insert(FileList);
|
|
|
+ R.Assign(2,5,8,6);
|
|
|
+ Control := New(PLabel, Init(R, labels^.get(slFiles), FileList));
|
|
|
+ Insert(Control);
|
|
|
+
|
|
|
+ R.Assign(35,3,46,5);
|
|
|
+ Opt := bfDefault;
|
|
|
+ if AOptions and fdOpenButton <> 0 then
|
|
|
+ begin
|
|
|
+ Insert(New(PButton, Init(R,labels^.get(slOpen), cmFileOpen, Opt)));
|
|
|
+ Opt := bfNormal;
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ end;
|
|
|
+ if AOptions and fdOkButton <> 0 then
|
|
|
+ begin
|
|
|
+ Insert(New(PButton, Init(R,labels^.get(slOk), cmFileOpen, Opt)));
|
|
|
+ Opt := bfNormal;
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ end;
|
|
|
+ if AOptions and fdReplaceButton <> 0 then
|
|
|
+ begin
|
|
|
+ Insert(New(PButton, Init(R, labels^.get(slReplace),cmFileReplace, Opt)));
|
|
|
+ Opt := bfNormal;
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ end;
|
|
|
+ if AOptions and fdClearButton <> 0 then
|
|
|
+ begin
|
|
|
+ Insert(New(PButton, Init(R, labels^.get(slClear),cmFileClear, Opt)));
|
|
|
+ Opt := bfNormal;
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ end;
|
|
|
+ Insert(New(PButton, Init(R, labels^.get(slCancel), cmCancel, bfNormal)));
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ if AOptions and fdHelpButton <> 0 then
|
|
|
+ begin
|
|
|
+ Insert(New(PButton, Init(R,labels^.get(slHelp),cmHelp, bfNormal)));
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ end;
|
|
|
+
|
|
|
+ R.Assign(1,16,48,18);
|
|
|
+ Control := New(PFileInfoPane, Init(R));
|
|
|
+ Insert(Control);
|
|
|
+
|
|
|
+ SelectNext(False);
|
|
|
+
|
|
|
+ if AOptions and fdNoLoadDir = 0 then ReadDirectory;
|
|
|
+end;
|
|
|
+
|
|
|
+constructor TFileDialog.Load(var S: TStream);
|
|
|
+begin
|
|
|
+ if not TDialog.Load(S) then
|
|
|
+ Fail;
|
|
|
+ S.Read(WildCard, SizeOf(TWildStr));
|
|
|
+ if (S.Status <> stOk) then
|
|
|
+ begin
|
|
|
+ TDialog.Done;
|
|
|
+ Fail;
|
|
|
+ end;
|
|
|
+ GetSubViewPtr(S, FileName);
|
|
|
+ GetSubViewPtr(S, FileList);
|
|
|
+ GetSubViewPtr(S, FileHistory);
|
|
|
+ ReadDirectory;
|
|
|
+ if (DosError <> 0) then
|
|
|
+ begin
|
|
|
+ TDialog.Done;
|
|
|
+ Fail;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TFileDialog.Done;
|
|
|
+begin
|
|
|
+ DisposeStr(Directory);
|
|
|
+ TDialog.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;
|
|
|
+ TWild : string;
|
|
|
+ TPath: PathStr;
|
|
|
+ TName: NameStr;
|
|
|
+ TExt: NameStr;
|
|
|
+ i : Sw_integer;
|
|
|
+begin
|
|
|
+ S := FileName^.Data^;
|
|
|
+ if RelativePath(S) then
|
|
|
+ begin
|
|
|
+ if (Directory <> nil) then
|
|
|
+ S := FExpand(Directory^ + S);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ S := FExpand(S);
|
|
|
+ if Pos(ListSeparator,S)=0 then
|
|
|
+ begin
|
|
|
+ If FileExists(S) then
|
|
|
+ exit;
|
|
|
+ FSplit(S, Path, Name, Ext);
|
|
|
+ if ((Name = '') or (Ext = '')) and not IsDir(S) then
|
|
|
+ begin
|
|
|
+ TWild:=WildCard;
|
|
|
+ repeat
|
|
|
+ i:=Pos(ListSeparator,TWild);
|
|
|
+ if i=0 then
|
|
|
+ i:=length(TWild)+1;
|
|
|
+ FSplit(Copy(TWild,1,i-1), 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;
|
|
|
+ if FileExists(S) then
|
|
|
+ break;
|
|
|
+ System.Delete(TWild,1,i);
|
|
|
+ until TWild='';
|
|
|
+ if TWild='' then
|
|
|
+ S := Path + Name + Ext;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileDialog.HandleEvent(var Event: TEvent);
|
|
|
+begin
|
|
|
+ if (Event.What and evBroadcast <> 0) and
|
|
|
+ (Event.Command = cmListItemSelected) then
|
|
|
+ begin
|
|
|
+ EndModal(cmFileOpen);
|
|
|
+ ClearEvent(Event);
|
|
|
+ end;
|
|
|
+ TDialog.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.SetData(var Rec);
|
|
|
+begin
|
|
|
+ TDialog.SetData(Rec);
|
|
|
+ if (PathStr(Rec) <> '') and (IsWild(TWildStr(Rec))) then
|
|
|
+ begin
|
|
|
+ Valid(cmFileInit);
|
|
|
+ FileName^.Select;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileDialog.ReadDirectory;
|
|
|
+begin
|
|
|
+ FileList^.ReadDirectory(WildCard);
|
|
|
+ FileHistory^.AdaptHistoryToDir(GetCurDir);
|
|
|
+ Directory := NewStr(GetCurDir);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TFileDialog.Store(var S: TStream);
|
|
|
+begin
|
|
|
+ TDialog.Store(S);
|
|
|
+ S.Write(WildCard, SizeOf(TWildStr));
|
|
|
+ PutSubViewPtr(S, FileName);
|
|
|
+ PutSubViewPtr(S, FileList);
|
|
|
+ PutSubViewPtr(S, FileHistory);
|
|
|
+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(Strings^.Get(sInvalidDriveOrDir), nil, mfError + mfOkButton);
|
|
|
+ FileName^.Select;
|
|
|
+ CheckDirectory := False;
|
|
|
+ end else CheckDirectory := True;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function CompleteDir(const Path: string): string;
|
|
|
+ begin
|
|
|
+ { keep c: untouched PM }
|
|
|
+ if (Path<>'') and (Path[Length(Path)]<>DirSeparator) and
|
|
|
+ (Path[Length(Path)]<>':') then
|
|
|
+ CompleteDir:=Path+DirSeparator
|
|
|
+ else
|
|
|
+ CompleteDir:=Path;
|
|
|
+ end;
|
|
|
+
|
|
|
+ function NormalizeDir(const Path: string): string;
|
|
|
+ var Root: boolean;
|
|
|
+ begin
|
|
|
+ Root:=false;
|
|
|
+ {$ifdef Linux}
|
|
|
+ if Path=DirSeparator then Root:=true;
|
|
|
+ {$else}
|
|
|
+ if (length(Path)=3) and (Upcase(Path[1]) in['A'..'Z']) and
|
|
|
+ (Path[2]=':') and (Path[3]=DirSeparator) then
|
|
|
+ Root:=true;
|
|
|
+ {$endif}
|
|
|
+ if (Root=false) and (copy(Path,length(Path),1)=DirSeparator) then
|
|
|
+ NormalizeDir:=copy(Path,1,length(Path)-1)
|
|
|
+ else
|
|
|
+ NormalizeDir:=Path;
|
|
|
+ end;
|
|
|
+function NormalizeDirF(var S: openstring): boolean;
|
|
|
+begin
|
|
|
+ S:=NormalizeDir(S);
|
|
|
+ NormalizeDirF:=true;
|
|
|
+end;
|
|
|
+
|
|
|
+begin
|
|
|
+ if Command = 0 then
|
|
|
+ begin
|
|
|
+ Valid := True;
|
|
|
+ Exit;
|
|
|
+ end
|
|
|
+ else Valid := False;
|
|
|
+ if TDialog.Valid(Command) then
|
|
|
+ begin
|
|
|
+ GetFileName(FName);
|
|
|
+ if (Command <> cmCancel) and (Command <> cmFileClear) then
|
|
|
+ begin
|
|
|
+ if IsWild(FName) or IsList(FName) then
|
|
|
+ begin
|
|
|
+ FSplit(FName, Dir, Name, Ext);
|
|
|
+ if CheckDirectory(Dir) then
|
|
|
+ begin
|
|
|
+ FileHistory^.AdaptHistoryToDir(Dir);
|
|
|
+ DisposeStr(Directory);
|
|
|
+ Directory := NewStr(Dir);
|
|
|
+ if Pos(ListSeparator,FName)>0 then
|
|
|
+ WildCard:=Copy(FName,length(Dir)+1,255)
|
|
|
+ else
|
|
|
+ WildCard := Name+Ext;
|
|
|
+ if Command <> cmFileInit then
|
|
|
+ FileList^.Select;
|
|
|
+ FileList^.ReadDirectory(Directory^+WildCard);
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else
|
|
|
+ if NormalizeDirF(FName) then
|
|
|
+ { ^^ this is just a dummy if construct (the func always returns true,
|
|
|
+ it's just there, 'coz I don't want to rearrange the following "if"s... }
|
|
|
+ if IsDir(FName) then
|
|
|
+ begin
|
|
|
+ if CheckDirectory(FName) then
|
|
|
+ begin
|
|
|
+ FileHistory^.AdaptHistoryToDir(CompleteDir(FName));
|
|
|
+ DisposeStr(Directory);
|
|
|
+ Directory := NewSTr(CompleteDir(FName));
|
|
|
+ if Command <> cmFileInit then FileList^.Select;
|
|
|
+ FileList^.ReadDirectory(Directory^+WildCard);
|
|
|
+ end
|
|
|
+ end
|
|
|
+ else
|
|
|
+ if ValidFileName(FName) then
|
|
|
+ Valid := True
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ MessageBox(^C + Strings^.Get(sInvalidFileName), nil, mfError + mfOkButton);
|
|
|
+ Valid := False;
|
|
|
+ end;
|
|
|
+ end
|
|
|
+ else Valid := True;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{ TDirCollection }
|
|
|
+
|
|
|
+function TDirCollection.GetItem(var S: TStream): Pointer;
|
|
|
+var
|
|
|
+ DirItem: PDirEntry;
|
|
|
+begin
|
|
|
+ New(DirItem);
|
|
|
+ DirItem^.DisplayText := S.ReadStr;
|
|
|
+ DirItem^.Directory := S.ReadStr;
|
|
|
+ GetItem := DirItem;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TDirCollection.FreeItem(Item: Pointer);
|
|
|
+var
|
|
|
+ DirItem: PDirEntry absolute Item;
|
|
|
+begin
|
|
|
+ DisposeStr(DirItem^.DisplayText);
|
|
|
+ DisposeStr(DirItem^.Directory);
|
|
|
+ Dispose(DirItem);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TDirCollection.PutItem(var S: TStream; Item: Pointer);
|
|
|
+var
|
|
|
+ DirItem: PDirEntry absolute Item;
|
|
|
+begin
|
|
|
+ S.WriteStr(DirItem^.DisplayText);
|
|
|
+ S.WriteStr(DirItem^.Directory);
|
|
|
+end;
|
|
|
+
|
|
|
+{ TDirListBox }
|
|
|
+
|
|
|
+const
|
|
|
+ DrivesS: String = '';
|
|
|
+ Drives: PString = @DrivesS;
|
|
|
+
|
|
|
+constructor TDirListBox.Init(var Bounds: TRect; AScrollBar:
|
|
|
+ PScrollBar);
|
|
|
+begin
|
|
|
+ DrivesS := strings^.get(sDrives);
|
|
|
+ TListBox.Init(Bounds, 1, AScrollBar);
|
|
|
+ Dir := '';
|
|
|
+end;
|
|
|
+
|
|
|
+destructor TDirListBox.Done;
|
|
|
+begin
|
|
|
+ if (List <> nil) then
|
|
|
+ Dispose(List,Done);
|
|
|
+ TListBox.Done;
|
|
|
+end;
|
|
|
+
|
|
|
+function TDirListBox.GetText(Item,MaxLen: Sw_Integer): String;
|
|
|
+begin
|
|
|
+ GetText := PDirEntry(List^.At(Item))^.DisplayText^;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TDirListBox.HandleEvent(var Event: TEvent);
|
|
|
+begin
|
|
|
+ case Event.What of
|
|
|
+ evMouseDown:
|
|
|
+ if Event.Double then
|
|
|
+ begin
|
|
|
+ Event.What := evCommand;
|
|
|
+ Event.Command := cmChangeDir;
|
|
|
+ PutEvent(Event);
|
|
|
+ ClearEvent(Event);
|
|
|
+ end;
|
|
|
+ evKeyboard:
|
|
|
+ if (Event.CharCode = ' ') and
|
|
|
+ (PSearchRec(List^.At(Focused))^.Name = '..') then
|
|
|
+ NewDirectory(PSearchRec(List^.At(Focused))^.Name);
|
|
|
+ end;
|
|
|
+ TListBox.HandleEvent(Event);
|
|
|
+end;
|
|
|
+
|
|
|
+function TDirListBox.IsSelected(Item: Sw_Integer): Boolean;
|
|
|
+begin
|
|
|
+ IsSelected := Item = Cur;
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TDirListBox.NewDirectory(var ADir: DirStr);
|
|
|
+const
|
|
|
+ PathDir = 'ÀÄÂ';
|
|
|
+ FirstDir = 'ÀÂÄ';
|
|
|
+ MiddleDir = ' ÃÄ';
|
|
|
+ LastDir = ' ÀÄ';
|
|
|
+ IndentSize = ' ';
|
|
|
+var
|
|
|
+ AList: PCollection;
|
|
|
+ NewDir, Dirct: DirStr;
|
|
|
+ C, OldC: Char;
|
|
|
+ S, Indent: String[80];
|
|
|
+ P: PString;
|
|
|
+ isFirst: Boolean;
|
|
|
+ SR: SearchRec;
|
|
|
+ I: Sw_Integer;
|
|
|
+
|
|
|
+ function NewDirEntry(const DisplayText, Directory: String): PDirEntry;{$ifdef PPC_BP}near;{$endif}
|
|
|
+ var
|
|
|
+ DirEntry: PDirEntry;
|
|
|
+ begin
|
|
|
+ New(DirEntry);
|
|
|
+ DirEntry^.DisplayText := NewStr(DisplayText);
|
|
|
+ DirEntry^.Directory := NewStr(Directory);
|
|
|
+ NewDirEntry := DirEntry;
|
|
|
+ end;
|
|
|
+
|
|
|
+begin
|
|
|
+ Dir := ADir;
|
|
|
+ AList := New(PDirCollection, Init(5,5));
|
|
|
+{$ifdef HAS_DOS_DRIVES}
|
|
|
+ AList^.Insert(NewDirEntry(Drives^,Drives^));
|
|
|
+ if Dir = Drives^ then
|
|
|
+ begin
|
|
|
+ isFirst := True;
|
|
|
+ OldC := ' ';
|
|
|
+ for C := 'A' to 'Z' do
|
|
|
+ begin
|
|
|
+ if (C < 'C') or DriveValid(C) then
|
|
|
+ begin
|
|
|
+ if OldC <> ' ' then
|
|
|
+ begin
|
|
|
+ if isFirst then
|
|
|
+ begin
|
|
|
+ S := FirstDir + OldC;
|
|
|
+ isFirst := False;
|
|
|
+ end
|
|
|
+ else S := MiddleDir + OldC;
|
|
|
+ AList^.Insert(NewDirEntry(S, OldC + ':' + DirSeparator));
|
|
|
+ end;
|
|
|
+ if C = GetCurDrive then Cur := AList^.Count;
|
|
|
+ OldC := C;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if OldC <> ' ' then
|
|
|
+ AList^.Insert(NewDirEntry(LastDir + OldC, OldC + ':' + DirSeparator));
|
|
|
+ end
|
|
|
+ else
|
|
|
+{$endif HAS_DOS_DRIVES}
|
|
|
+ begin
|
|
|
+ Indent := IndentSize;
|
|
|
+ NewDir := Dir;
|
|
|
+{$ifdef HAS_DOS_DRIVES}
|
|
|
+ Dirct := Copy(NewDir,1,3);
|
|
|
+ AList^.Insert(NewDirEntry(PathDir + Dirct, Dirct));
|
|
|
+ NewDir := Copy(NewDir,4,255);
|
|
|
+{$else HAS_DOS_DRIVES}
|
|
|
+ Dirct := '';
|
|
|
+{$endif HAS_DOS_DRIVES}
|
|
|
+ while NewDir <> '' do
|
|
|
+ begin
|
|
|
+ I := Pos(DirSeparator,NewDir);
|
|
|
+ if I <> 0 then
|
|
|
+ begin
|
|
|
+ S := Copy(NewDir,1,I-1);
|
|
|
+ Dirct := Dirct + S;
|
|
|
+ AList^.Insert(NewDirEntry(Indent + PathDir + S, Dirct));
|
|
|
+ NewDir := Copy(NewDir,I+1,255);
|
|
|
+ end
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Dirct := Dirct + NewDir;
|
|
|
+ AList^.Insert(NewDirEntry(Indent + PathDir + NewDir, Dirct));
|
|
|
+ NewDir := '';
|
|
|
+ end;
|
|
|
+ Indent := Indent + IndentSize;
|
|
|
+ Dirct := Dirct + DirSeparator;
|
|
|
+ end;
|
|
|
+ Cur := AList^.Count-1;
|
|
|
+ isFirst := True;
|
|
|
+ NewDir := Dirct + '*.*';
|
|
|
+ FindFirst(NewDir, Directory, SR);
|
|
|
+ while DosError = 0 do
|
|
|
+ begin
|
|
|
+ if (SR.Attr and Directory <> 0) and
|
|
|
+{$ifdef FPC}
|
|
|
+ (SR.Name <> '.') and (SR.Name <> '..') then
|
|
|
+{$else : not FPC}
|
|
|
+ (SR.Name[1] <> '.') then
|
|
|
+{$endif not FPC}
|
|
|
+ begin
|
|
|
+ if isFirst then
|
|
|
+ begin
|
|
|
+ S := FirstDir;
|
|
|
+ isFirst := False;
|
|
|
+ end else S := MiddleDir;
|
|
|
+ AList^.Insert(NewDirEntry(Indent + S + SR.Name, Dirct + SR.Name));
|
|
|
+ end;
|
|
|
+ FindNext(SR);
|
|
|
+ end;
|
|
|
+ {$ifdef fpc}
|
|
|
+ FindClose(SR);
|
|
|
+ {$endif}
|
|
|
+ P := PDirEntry(AList^.At(AList^.Count-1))^.DisplayText;
|
|
|
+ I := Pos('À',P^);
|
|
|
+ if I = 0 then
|
|
|
+ begin
|
|
|
+ I := Pos('Ã',P^);
|
|
|
+ if I <> 0 then P^[I] := 'À';
|
|
|
+ end else
|
|
|
+ begin
|
|
|
+ P^[I+1] := 'Ä';
|
|
|
+ P^[I+2] := 'Ä';
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ NewList(AList);
|
|
|
+ FocusItem(Cur);
|
|
|
+end;
|
|
|
+
|
|
|
+procedure TDirListBox.SetState(AState: Word; Enable: Boolean);
|
|
|
+begin
|
|
|
+ TListBox.SetState(AState, Enable);
|
|
|
+ if AState and sfFocused <> 0 then
|
|
|
+ PChDirDialog(Owner)^.ChDirButton^.MakeDefault(Enable);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog Object }
|
|
|
+{****************************************************************************}
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.Init }
|
|
|
+{****************************************************************************}
|
|
|
+constructor TChDirDialog.Init(AOptions: Word; HistoryId: Sw_Word);
|
|
|
+var
|
|
|
+ R: TRect;
|
|
|
+ Control: PView;
|
|
|
+begin
|
|
|
+ R.Assign(16, 2, 64, 20);
|
|
|
+ TDialog.Init(R,strings^.get(sChangeDirectory));
|
|
|
+
|
|
|
+ Options := Options or ofCentered;
|
|
|
+
|
|
|
+ R.Assign(3, 3, 30, 4);
|
|
|
+ DirInput := New(PInputLine, Init(R, 68));
|
|
|
+ Insert(DirInput);
|
|
|
+ R.Assign(2, 2, 17, 3);
|
|
|
+ Control := New(PLabel, Init(R,labels^.get(slDirectoryName), DirInput));
|
|
|
+ Insert(Control);
|
|
|
+ R.Assign(30, 3, 33, 4);
|
|
|
+ Control := New(PHistory, Init(R, DirInput, HistoryId));
|
|
|
+ Insert(Control);
|
|
|
+
|
|
|
+ R.Assign(32, 6, 33, 16);
|
|
|
+ Control := New(PScrollBar, Init(R));
|
|
|
+ Insert(Control);
|
|
|
+ R.Assign(3, 6, 32, 16);
|
|
|
+ DirList := New(PDirListBox, Init(R, PScrollBar(Control)));
|
|
|
+ Insert(DirList);
|
|
|
+ R.Assign(2, 5, 17, 6);
|
|
|
+ Control := New(PLabel, Init(R, labels^.get(slDirectoryTree), DirList));
|
|
|
+ Insert(Control);
|
|
|
+
|
|
|
+ R.Assign(35, 6, 45, 8);
|
|
|
+ OkButton := New(PButton, Init(R, labels^.get(slOk), cmOK, bfDefault));
|
|
|
+ Insert(OkButton);
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ ChDirButton := New(PButton,Init(R,labels^.get(slChDir),cmChangeDir,
|
|
|
+ bfNormal));
|
|
|
+ Insert(ChDirButton);
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ Insert(New(PButton, Init(R,labels^.get(slRevert), cmRevert, bfNormal)));
|
|
|
+ if AOptions and cdHelpButton <> 0 then
|
|
|
+ begin
|
|
|
+ Inc(R.A.Y,3); Inc(R.B.Y,3);
|
|
|
+ Insert(New(PButton, Init(R,labels^.get(slHelp), cmHelp, bfNormal)));
|
|
|
+ end;
|
|
|
+
|
|
|
+ if AOptions and cdNoLoadDir = 0 then SetUpDialog;
|
|
|
+
|
|
|
+ SelectNext(False);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.Load }
|
|
|
+{****************************************************************************}
|
|
|
+constructor TChDirDialog.Load(var S: TStream);
|
|
|
+begin
|
|
|
+ TDialog.Load(S);
|
|
|
+ GetSubViewPtr(S, DirList);
|
|
|
+ GetSubViewPtr(S, DirInput);
|
|
|
+ GetSubViewPtr(S, OkButton);
|
|
|
+ GetSubViewPtr(S, ChDirbutton);
|
|
|
+ SetUpDialog;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.DataSize }
|
|
|
+{****************************************************************************}
|
|
|
+function TChDirDialog.DataSize: Sw_Word;
|
|
|
+begin
|
|
|
+ DataSize := 0;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.GetData }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TChDirDialog.GetData(var Rec);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.HandleEvent }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TChDirDialog.HandleEvent(var Event: TEvent);
|
|
|
+var
|
|
|
+ CurDir: DirStr;
|
|
|
+ P: PDirEntry;
|
|
|
+begin
|
|
|
+ TDialog.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 (P^.Directory^ = Drives^)
|
|
|
+ or DriveValid(P^.Directory^[1]) then
|
|
|
+ CurDir := P^.Directory^
|
|
|
+ else Exit;
|
|
|
+ end;
|
|
|
+ else
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if (Length(CurDir) > 3) and
|
|
|
+ (CurDir[Length(CurDir)] = DirSeparator) then
|
|
|
+ CurDir := Copy(CurDir,1,Length(CurDir)-1);
|
|
|
+ DirList^.NewDirectory(CurDir);
|
|
|
+ DirInput^.Data^ := CurDir;
|
|
|
+ DirInput^.DrawView;
|
|
|
+ DirList^.Select;
|
|
|
+ ClearEvent(Event);
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.SetData }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TChDirDialog.SetData(var Rec);
|
|
|
+begin
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.SetUpDialog }
|
|
|
+{****************************************************************************}
|
|
|
+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)] = DirSeparator) then
|
|
|
+ CurDir := Copy(CurDir,1,Length(CurDir)-1);
|
|
|
+ if DirInput <> nil then
|
|
|
+ begin
|
|
|
+ DirInput^.Data^ := CurDir;
|
|
|
+ DirInput^.DrawView;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.Store }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TChDirDialog.Store(var S: TStream);
|
|
|
+begin
|
|
|
+ TDialog.Store(S);
|
|
|
+ PutSubViewPtr(S, DirList);
|
|
|
+ PutSubViewPtr(S, DirInput);
|
|
|
+ PutSubViewPtr(S, OkButton);
|
|
|
+ PutSubViewPtr(S, ChDirButton);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TChDirDialog.Valid }
|
|
|
+{****************************************************************************}
|
|
|
+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)] = DirSeparator) then
|
|
|
+ Dec(P[0]);
|
|
|
+ {$I-}
|
|
|
+ ChDir(P);
|
|
|
+ if (IOResult <> 0) then
|
|
|
+ begin
|
|
|
+ MessageBox(Strings^.Get(sInvalidDirectory), nil, mfError + mfOkButton);
|
|
|
+ Valid := False;
|
|
|
+ end;
|
|
|
+ {$I+}
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TEditChDirDialog Object }
|
|
|
+{****************************************************************************}
|
|
|
+{****************************************************************************}
|
|
|
+{ TEditChDirDialog.DataSize }
|
|
|
+{****************************************************************************}
|
|
|
+function TEditChDirDialog.DataSize : Sw_Word;
|
|
|
+begin
|
|
|
+ DataSize := SizeOf(DirStr);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TEditChDirDialog.GetData }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TEditChDirDialog.GetData (var Rec);
|
|
|
+var
|
|
|
+ CurDir : DirStr absolute Rec;
|
|
|
+begin
|
|
|
+ if (DirInput = nil) then
|
|
|
+ CurDir := ''
|
|
|
+ else begin
|
|
|
+ CurDir := DirInput^.Data^;
|
|
|
+ if (CurDir[Length(CurDir)] <> DirSeparator) then
|
|
|
+ CurDir := CurDir + DirSeparator;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TEditChDirDialog.SetData }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TEditChDirDialog.SetData (var Rec);
|
|
|
+var
|
|
|
+ CurDir : DirStr absolute Rec;
|
|
|
+begin
|
|
|
+ if DirList <> nil then
|
|
|
+ begin
|
|
|
+ DirList^.NewDirectory(CurDir);
|
|
|
+ if DirInput <> nil then
|
|
|
+ begin
|
|
|
+ if (Length(CurDir) > 3) and (CurDir[Length(CurDir)] = DirSeparator) then
|
|
|
+ DirInput^.Data^ := Copy(CurDir,1,Length(CurDir)-1)
|
|
|
+ else DirInput^.Data^ := CurDir;
|
|
|
+ DirInput^.DrawView;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TSortedListBox Object }
|
|
|
+{****************************************************************************}
|
|
|
+{****************************************************************************}
|
|
|
+{ TSortedListBox.Init }
|
|
|
+{****************************************************************************}
|
|
|
+constructor TSortedListBox.Init(var Bounds: TRect; ANumCols: Sw_Word;
|
|
|
+ AScrollBar: PScrollBar);
|
|
|
+begin
|
|
|
+ TListBox.Init(Bounds, ANumCols, AScrollBar);
|
|
|
+ SearchPos := 0;
|
|
|
+ ShowCursor;
|
|
|
+ SetCursor(1,0);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ TSortedListBox.HandleEvent }
|
|
|
+{****************************************************************************}
|
|
|
+procedure TSortedListBox.HandleEvent(var Event: TEvent);
|
|
|
+const
|
|
|
+ SpecialChars: set of Char = [#0,#9,#27];
|
|
|
+var
|
|
|
+ CurString, NewString: String;
|
|
|
+ K: Pointer;
|
|
|
+ Value : Sw_integer;
|
|
|
+ OldPos, OldValue: Sw_Integer;
|
|
|
+ T: Boolean;
|
|
|
+begin
|
|
|
+ OldValue := Focused;
|
|
|
+ TListBox.HandleEvent(Event);
|
|
|
+ if (OldValue <> Focused) or
|
|
|
+ ((Event.What = evBroadcast) and (Event.InfoPtr = @Self) and
|
|
|
+ (Event.Command = cmReleasedFocus)) then
|
|
|
+ SearchPos := 0;
|
|
|
+ if Event.What = evKeyDown then
|
|
|
+ begin
|
|
|
+ { patched to prevent error when no or empty list or Escape pressed }
|
|
|
+ if (not (Event.CharCode in SpecialChars)) and
|
|
|
+ (List <> nil) and (List^.Count > 0) then
|
|
|
+ begin
|
|
|
+ Value := Focused;
|
|
|
+ if Value < Range then CurString := GetText(Value, 255)
|
|
|
+ else CurString := '';
|
|
|
+ OldPos := SearchPos;
|
|
|
+ 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 := '';
|
|
|
+ if Equal(NewString, CurString, SearchPos) then
|
|
|
+ begin
|
|
|
+ if Value <> OldValue then
|
|
|
+ begin
|
|
|
+ FocusItem(Value);
|
|
|
+ { Assumes ListControl will set the cursor to the first character }
|
|
|
+ { of the sfFocused item }
|
|
|
+ SetCursor(Cursor.X+SearchPos, Cursor.Y);
|
|
|
+ end
|
|
|
+ else SetCursor(Cursor.X+(SearchPos-OldPos), Cursor.Y);
|
|
|
+ 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
|
|
|
+ TListBox.NewList(AList);
|
|
|
+ SearchPos := 0;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ Global Procedures and Functions }
|
|
|
+{****************************************************************************}
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ Contains }
|
|
|
+{****************************************************************************}
|
|
|
+function Contains(S1, S2: String): Boolean;
|
|
|
+ { Contains returns true if S1 contains any characters in S2. }
|
|
|
+var
|
|
|
+ i : Byte;
|
|
|
+begin
|
|
|
+ Contains := True;
|
|
|
+ i := 1;
|
|
|
+ while ((i < Length(S2)) and (i < Length(S1))) do
|
|
|
+ if (Upcase(S1[i]) = Upcase(S2[i])) then
|
|
|
+ Exit
|
|
|
+ else Inc(i);
|
|
|
+ Contains := False;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ StdDeleteFile }
|
|
|
+{****************************************************************************}
|
|
|
+function StdDeleteFile (AFile : FNameStr) : Boolean;
|
|
|
+var
|
|
|
+ Rec : PStringRec;
|
|
|
+begin
|
|
|
+ if CheckOnDelete then
|
|
|
+ begin
|
|
|
+ AFile := ShrinkPath(AFile,33);
|
|
|
+ Rec.AString := PString(@AFile);
|
|
|
+ StdDeleteFile := (MessageBox(^C + Strings^.Get(sDeleteFile),
|
|
|
+ @Rec,mfConfirmation or mfOkCancel) = cmOk);
|
|
|
+ end
|
|
|
+ else StdDeleteFile := False;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ DriveValid }
|
|
|
+{****************************************************************************}
|
|
|
+function DriveValid(Drive: Char): Boolean;
|
|
|
+{$ifdef HAS_DOS_DRIVES}
|
|
|
+var
|
|
|
+ D: Char;
|
|
|
+begin
|
|
|
+ D := GetCurDrive;
|
|
|
+ {$I-}
|
|
|
+ ChDir(Drive+':');
|
|
|
+ if (IOResult = 0) then
|
|
|
+ begin
|
|
|
+ DriveValid := True;
|
|
|
+ ChDir(D+':')
|
|
|
+ end
|
|
|
+ else DriveValid := False;
|
|
|
+ {$I+}
|
|
|
+end;
|
|
|
+{$else HAS_DOS_DRIVES}
|
|
|
+begin
|
|
|
+ DriveValid:=true;
|
|
|
+end;
|
|
|
+{$endif HAS_DOS_DRIVES}
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ Equal }
|
|
|
+{****************************************************************************}
|
|
|
+function Equal(const S1, S2: String; Count: Sw_word): Boolean;
|
|
|
+var
|
|
|
+ i: Sw_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;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ ExtractDir }
|
|
|
+{****************************************************************************}
|
|
|
+function ExtractDir(AFile: FNameStr): DirStr;
|
|
|
+ { ExtractDir returns the path of AFile terminated with a trailing '\'. If
|
|
|
+ AFile contains no directory information, an empty string is returned. }
|
|
|
+var
|
|
|
+ D: DirStr;
|
|
|
+ N: NameStr;
|
|
|
+ E: ExtStr;
|
|
|
+begin
|
|
|
+ FSplit(AFile,D,N,E);
|
|
|
+ if D = '' then
|
|
|
+ begin
|
|
|
+ ExtractDir := '';
|
|
|
+ Exit;
|
|
|
+ end;
|
|
|
+ if D[Byte(D[0])] <> DirSeparator then
|
|
|
+ D := D + DirSeparator;
|
|
|
+ ExtractDir := D;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ ExtractFileName }
|
|
|
+{****************************************************************************}
|
|
|
+function ExtractFileName(AFile: FNameStr): NameStr;
|
|
|
+var
|
|
|
+ D: DirStr;
|
|
|
+ N: NameStr;
|
|
|
+ E: ExtStr;
|
|
|
+begin
|
|
|
+ FSplit(AFile,D,N,E);
|
|
|
+ ExtractFileName := N;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ FileExists }
|
|
|
+{****************************************************************************}
|
|
|
+function FileExists (AFile : FNameStr) : Boolean;
|
|
|
+begin
|
|
|
+ FileExists := (FSearch(AFile,'') <> '');
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ GetCurDir }
|
|
|
+{****************************************************************************}
|
|
|
+function GetCurDir: DirStr;
|
|
|
+var
|
|
|
+ CurDir: DirStr;
|
|
|
+begin
|
|
|
+ GetDir(0, CurDir);
|
|
|
+ if (Length(CurDir) > 3) then
|
|
|
+ begin
|
|
|
+ Inc(CurDir[0]);
|
|
|
+ CurDir[Length(CurDir)] := DirSeparator;
|
|
|
+ end;
|
|
|
+ GetCurDir := CurDir;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ GetCurDrive }
|
|
|
+{****************************************************************************}
|
|
|
+function GetCurDrive: Char;
|
|
|
+{$ifdef go32v2}
|
|
|
+var
|
|
|
+ Regs : Registers;
|
|
|
+begin
|
|
|
+ Regs.AH := $19;
|
|
|
+ Intr($21,Regs);
|
|
|
+ GetCurDrive := Char(Regs.AL + Byte('A'));
|
|
|
+end;
|
|
|
+{$else not go32v2}
|
|
|
+var
|
|
|
+ D : DirStr;
|
|
|
+begin
|
|
|
+ D:=GetCurDir;
|
|
|
+ if (Length(D)>1) and (D[2]=':') then
|
|
|
+ begin
|
|
|
+ if (D[1]>='a') and (D[1]<='z') then
|
|
|
+ GetCurDrive:=Char(Byte(D[1])+Byte('A')-Byte('a'))
|
|
|
+ else
|
|
|
+ GetCurDrive:=D[1];
|
|
|
+ end
|
|
|
+ else
|
|
|
+ GetCurDrive:='C';
|
|
|
+end;
|
|
|
+{$endif not go32v2}
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ IsDir }
|
|
|
+{****************************************************************************}
|
|
|
+function IsDir(const S: String): Boolean;
|
|
|
+var
|
|
|
+ SR: SearchRec;
|
|
|
+ Is: boolean;
|
|
|
+begin
|
|
|
+ Is:=false;
|
|
|
+{$ifdef Linux}
|
|
|
+ Is:=(S=DirSeparator); { handle root }
|
|
|
+{$else}
|
|
|
+ Is:=(length(S)=3) and (Upcase(S[1]) in['A'..'Z']) and (S[2]=':') and (S[3]=DirSeparator);
|
|
|
+ { handle root dirs }
|
|
|
+{$endif}
|
|
|
+ if Is=false then
|
|
|
+ begin
|
|
|
+ FindFirst(S, Directory, SR);
|
|
|
+ if DosError = 0 then
|
|
|
+ Is := (SR.Attr and Directory) <> 0
|
|
|
+ else
|
|
|
+ Is := False;
|
|
|
+ {$ifdef fpc}
|
|
|
+ FindClose(SR);
|
|
|
+ {$endif}
|
|
|
+ end;
|
|
|
+ IsDir:=Is;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ IsWild }
|
|
|
+{****************************************************************************}
|
|
|
+function IsWild(const S: String): Boolean;
|
|
|
+begin
|
|
|
+ IsWild := (Pos('?',S) > 0) or (Pos('*',S) > 0);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ IsList }
|
|
|
+{****************************************************************************}
|
|
|
+function IsList(const S: String): Boolean;
|
|
|
+begin
|
|
|
+ IsList := (Pos(ListSeparator,S) > 0);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ MakeResources }
|
|
|
+{****************************************************************************}
|
|
|
+procedure MakeResources;
|
|
|
+var
|
|
|
+ Dlg : PDialog;
|
|
|
+ Key : String;
|
|
|
+ i : Word;
|
|
|
+begin
|
|
|
+ for i := 0 to 1 do
|
|
|
+ begin
|
|
|
+ case i of
|
|
|
+ 0 : begin
|
|
|
+ Key := reOpenDlg;
|
|
|
+ Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),
|
|
|
+ labels^.get(slName),
|
|
|
+ fdOkButton or fdHelpButton or fdNoLoadDir,0));
|
|
|
+ end;
|
|
|
+ 1 : begin
|
|
|
+ Key := reSaveAsDlg;
|
|
|
+ Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
|
|
|
+ labels^.get(slName),
|
|
|
+ fdOkButton or fdHelpButton or fdNoLoadDir,0));
|
|
|
+ end;
|
|
|
+ 2 : begin
|
|
|
+ Key := reEditChDirDialog;
|
|
|
+ Dlg := New(PEditChDirDialog,Init(cdHelpButton,
|
|
|
+ hiCurrentDirectories));
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ if Dlg = nil then
|
|
|
+ begin
|
|
|
+ PrintStr('Error initializing dialog ' + Key);
|
|
|
+ Halt;
|
|
|
+ end
|
|
|
+ else begin
|
|
|
+ RezFile^.Put(Dlg,Key);
|
|
|
+ if (RezFile^.Stream^.Status <> stOk) then
|
|
|
+ begin
|
|
|
+ PrintStr('Error writing dialog ' + Key + ' to the resource file.');
|
|
|
+ Halt;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ NoWildChars }
|
|
|
+{****************************************************************************}
|
|
|
+function NoWildChars(S: String): String;
|
|
|
+const
|
|
|
+ WildChars : array[0..1] of Char = ('?','*');
|
|
|
+var
|
|
|
+ i : Sw_Word;
|
|
|
+begin
|
|
|
+ repeat
|
|
|
+ i := Pos('?',S);
|
|
|
+ if (i > 0) then
|
|
|
+ System.Delete(S,i,1);
|
|
|
+ until (i = 0);
|
|
|
+ repeat
|
|
|
+ i := Pos('*',S);
|
|
|
+ if (i > 0) then
|
|
|
+ System.Delete(S,i,1);
|
|
|
+ until (i = 0);
|
|
|
+ NoWildChars:=S;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ OpenFile }
|
|
|
+{****************************************************************************}
|
|
|
+function OpenFile (var AFile : FNameStr; HistoryID : Byte) : Boolean;
|
|
|
+var
|
|
|
+ Dlg : PFileDialog;
|
|
|
+begin
|
|
|
+ {$ifdef cdResource}
|
|
|
+ Dlg := PFileDialog(RezFile^.Get(reOpenDlg));
|
|
|
+ {$else}
|
|
|
+ Dlg := New(PFileDialog,Init('*.*',strings^.get(sOpen),labels^.get(slName),
|
|
|
+ fdOkButton or fdHelpButton,0));
|
|
|
+ {$endif cdResource}
|
|
|
+ { this might not work }
|
|
|
+ PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
|
|
|
+ OpenFile := (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ OpenNewFile }
|
|
|
+{****************************************************************************}
|
|
|
+function OpenNewFile (var AFile: FNameStr; HistoryID: Byte): Boolean;
|
|
|
+ { OpenNewFile allows the user to select a directory from disk and enter a
|
|
|
+ new file name. If the file name entered is an existing file the user is
|
|
|
+ optionally prompted for confirmation of replacing the file based on the
|
|
|
+ value in #CheckOnReplace#. If a file name is successfully entered,
|
|
|
+ OpenNewFile returns True. }
|
|
|
+ {#X OpenFile }
|
|
|
+begin
|
|
|
+ OpenNewFile := False;
|
|
|
+ if OpenFile(AFile,HistoryID) then
|
|
|
+ begin
|
|
|
+ if not ValidFileName(AFile) then
|
|
|
+ Exit;
|
|
|
+ if FileExists(AFile) then
|
|
|
+ if (not CheckOnReplace) or (not ReplaceFile(AFile)) then
|
|
|
+ Exit;
|
|
|
+ OpenNewFile := True;
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ PathValid }
|
|
|
+{****************************************************************************}
|
|
|
+{$ifdef go32v2}
|
|
|
+{$define NetDrive}
|
|
|
+{$endif go32v2}
|
|
|
+{$ifdef win32}
|
|
|
+{$define NetDrive}
|
|
|
+{$endif win32}
|
|
|
+function PathValid (var Path: PathStr): Boolean;
|
|
|
+var
|
|
|
+ ExpPath: PathStr;
|
|
|
+ SR: SearchRec;
|
|
|
+begin
|
|
|
+ ExpPath := FExpand(Path);
|
|
|
+{$ifdef HAS_DOS_DRIVES}
|
|
|
+ if (Length(ExpPath) <= 3) then
|
|
|
+ PathValid := DriveValid(ExpPath[1])
|
|
|
+ else
|
|
|
+{$endif}
|
|
|
+ begin
|
|
|
+ { do not change '/' into '' }
|
|
|
+ if (Length(ExpPath)>1) and (ExpPath[Length(ExpPath)] = DirSeparator) then
|
|
|
+ Dec(ExpPath[0]);
|
|
|
+ FindFirst(ExpPath, Directory, SR);
|
|
|
+ PathValid := (DosError = 0) and (SR.Attr and Directory <> 0);
|
|
|
+{$ifdef NetDrive}
|
|
|
+ if DosError=66 then
|
|
|
+ begin
|
|
|
+ {$ifdef fpc}
|
|
|
+ FindClose(SR);
|
|
|
+ {$endif}
|
|
|
+ FindFirst(ExpPath+'\*',AnyFile,SR);
|
|
|
+ PathValid:=(DosError = 0);
|
|
|
+ end;
|
|
|
+{$endif NetDrive}
|
|
|
+ {$ifdef fpc}
|
|
|
+ FindClose(SR);
|
|
|
+ {$endif}
|
|
|
+ end;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ RegisterStdDlg }
|
|
|
+{****************************************************************************}
|
|
|
+procedure RegisterStdDlg;
|
|
|
+begin
|
|
|
+ RegisterType(RFileInputLine);
|
|
|
+ RegisterType(RFileCollection);
|
|
|
+ RegisterType(RFileList);
|
|
|
+ RegisterType(RFileInfoPane);
|
|
|
+ RegisterType(RFileDialog);
|
|
|
+ RegisterType(RDirCollection);
|
|
|
+ RegisterType(RDirListBox);
|
|
|
+ RegisterType(RSortedListBox);
|
|
|
+ RegisterType(RChDirDialog);
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ StdReplaceFile }
|
|
|
+{****************************************************************************}
|
|
|
+function StdReplaceFile (AFile : FNameStr) : Boolean;
|
|
|
+var
|
|
|
+ Rec : PStringRec;
|
|
|
+begin
|
|
|
+ if CheckOnReplace then
|
|
|
+ begin
|
|
|
+ AFile := ShrinkPath(AFile,33);
|
|
|
+ Rec.AString := PString(@AFile);
|
|
|
+ StdReplaceFile :=
|
|
|
+ (MessageBox(^C + Strings^.Get(sReplaceFile),
|
|
|
+ @Rec,mfConfirmation or mfOkCancel) = cmOk);
|
|
|
+ end
|
|
|
+ else StdReplaceFile := True;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ SaveAs }
|
|
|
+{****************************************************************************}
|
|
|
+function SaveAs (var AFile : FNameStr; HistoryID : Word) : Boolean;
|
|
|
+var
|
|
|
+ Dlg : PFileDialog;
|
|
|
+begin
|
|
|
+ SaveAs := False;
|
|
|
+ {$ifdef cdResource}
|
|
|
+ Dlg := PFileDialog(RezFile^.Get(reSaveAsDlg));
|
|
|
+ {$else}
|
|
|
+ Dlg := New(PFileDialog,Init('*.*',strings^.get(sSaveAs),
|
|
|
+ labels^.get(slSaveAs),
|
|
|
+ fdOkButton or fdHelpButton,0));
|
|
|
+ {$endif cdResource}
|
|
|
+ { this might not work }
|
|
|
+ PHistory(Dlg^.FileName^.Next^.Next)^.HistoryID := HistoryID;
|
|
|
+ Dlg^.HelpCtx := hcSaveAs;
|
|
|
+ if (Application^.ExecuteDialog(Dlg,@AFile) = cmFileOpen) and
|
|
|
+ ((not FileExists(AFile)) or ReplaceFile(AFile)) then
|
|
|
+ SaveAs := True;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ SelectDir }
|
|
|
+{****************************************************************************}
|
|
|
+function SelectDir (var ADir : DirStr; HistoryID : Byte) : Boolean;
|
|
|
+var
|
|
|
+ Dir: DirStr;
|
|
|
+ Dlg : PEditChDirDialog;
|
|
|
+ Rec : DirStr;
|
|
|
+begin
|
|
|
+ {$I-}
|
|
|
+ GetDir(0,Dir);
|
|
|
+ {$I+}
|
|
|
+ Rec := FExpand(ADir);
|
|
|
+ {$ifdef cdResource}
|
|
|
+ Dlg := PEditChDirDialog(RezFile^.Get(reEditChDirDialog));
|
|
|
+ {$else}
|
|
|
+ Dlg := New(PEditChDirDialog,Init(cdHelpButton,HistoryID));
|
|
|
+ {$endif cdResource}
|
|
|
+ if (Application^.ExecuteDialog(Dlg,@Rec) = cmOk) then
|
|
|
+ begin
|
|
|
+ SelectDir := True;
|
|
|
+ ADir := Rec;
|
|
|
+ end
|
|
|
+ else SelectDir := False;
|
|
|
+ {$I-}
|
|
|
+ ChDir(Dir);
|
|
|
+ {$I+}
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ ShrinkPath }
|
|
|
+{****************************************************************************}
|
|
|
+function ShrinkPath (AFile : FNameStr; MaxLen : Byte) : FNameStr;
|
|
|
+var
|
|
|
+ Filler: string;
|
|
|
+ D1 : DirStr;
|
|
|
+ N1 : NameStr;
|
|
|
+ E1 : ExtStr;
|
|
|
+ i : Sw_Word;
|
|
|
+
|
|
|
+begin
|
|
|
+ if Length(AFile) > MaxLen then
|
|
|
+ begin
|
|
|
+ FSplit(FExpand(AFile),D1,N1,E1);
|
|
|
+ AFile := Copy(D1,1,3) + '..' + DirSeparator;
|
|
|
+ i := Pred(Length(D1));
|
|
|
+ while (i > 0) and (D1[i] <> DirSeparator) do
|
|
|
+ Dec(i);
|
|
|
+ if (i = 0) then
|
|
|
+ AFile := AFile + D1
|
|
|
+ else AFile := AFile + Copy(D1,Succ(i),Length(D1)-i);
|
|
|
+ if AFile[Length(AFile)] <> DirSeparator then
|
|
|
+ AFile := AFile + DirSeparator;
|
|
|
+ if Length(AFile)+Length(N1)+Length(E1) <= MaxLen then
|
|
|
+ AFile := AFile + N1 + E1
|
|
|
+ else
|
|
|
+ begin
|
|
|
+ Filler := '...' + DirSeparator;
|
|
|
+ AFile:=Copy(Afile,1,MaxLen-Length(Filler)-Length(N1)-Length(E1))
|
|
|
+ +Filler+N1+E1;
|
|
|
+ end;
|
|
|
+ end;
|
|
|
+ ShrinkPath := AFile;
|
|
|
+end;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ ValidFileName }
|
|
|
+{****************************************************************************}
|
|
|
+function ValidFileName(var FileName: PathStr): Boolean;
|
|
|
+var
|
|
|
+ IllegalChars: string[12];
|
|
|
+ Dir: DirStr;
|
|
|
+ Name: NameStr;
|
|
|
+ Ext: ExtStr;
|
|
|
+begin
|
|
|
+{$ifdef PPC_FPC}
|
|
|
+{$ifdef go32v2}
|
|
|
+ { spaces are allowed if LFN is supported }
|
|
|
+ if LFNSupport then
|
|
|
+ IllegalChars := ';,=+<>|"[]'+DirSeparator
|
|
|
+ else
|
|
|
+ IllegalChars := ';,=+<>|"[] '+DirSeparator;
|
|
|
+{$else not go32v2}
|
|
|
+{$ifdef win32}
|
|
|
+ IllegalChars := ';,=+<>|"[]'+DirSeparator;
|
|
|
+{$else not go32v2 and not win32 }
|
|
|
+ IllegalChars := ';,=+<>|"[] '+DirSeparator;
|
|
|
+{$endif not win32}
|
|
|
+{$endif not go32v2}
|
|
|
+{$else not PPC_FPC}
|
|
|
+ IllegalChars := ';,=+<>|"[] '+DirSeparator;
|
|
|
+{$endif PPC_FPC}
|
|
|
+ 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;
|
|
|
+
|
|
|
+{****************************************************************************}
|
|
|
+{ Unit Initialization Section }
|
|
|
+{****************************************************************************}
|
|
|
+begin
|
|
|
+{$ifdef PPC_BP}
|
|
|
+ ReplaceFile := StdReplaceFile;
|
|
|
+ DeleteFile := StdDeleteFile;
|
|
|
+{$else}
|
|
|
+ ReplaceFile := @StdReplaceFile;
|
|
|
+ DeleteFile := @StdDeleteFile;
|
|
|
+{$endif PPC_BP}
|
|
|
+end.
|