summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/corelib/fpgfx.pas2
-rw-r--r--src/corelib/gdi/gfx_gdi.pas49
-rw-r--r--src/corelib/gfxbase.pas359
-rw-r--r--src/corelib/x11/gfx_x11.pas33
-rw-r--r--src/gui/gui_dialogs.pas89
-rw-r--r--src/gui/gui_grid.pas309
6 files changed, 462 insertions, 379 deletions
diff --git a/src/corelib/fpgfx.pas b/src/corelib/fpgfx.pas
index d4b32b99..29ea9bdf 100644
--- a/src/corelib/fpgfx.pas
+++ b/src/corelib/fpgfx.pas
@@ -259,6 +259,8 @@ type
TfpgClipboard = class(TfpgClipboardImpl)
end;
+ TfpgFileList = class(TfpgFileListImpl)
+ end;
var
fpgStyle: TfpgStyle; { TODO -ograemeg : move this into fpgApplication }
diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index f284bb38..b198fa24 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -206,6 +206,14 @@ type
procedure InitClipboard; override;
end;
+
+ { TfpgFileListImpl }
+
+ TfpgFileListImpl = class(TfpgFileListBase)
+ function InitializeEntry(sr: TSearchRec): TFileEntry; override;
+ function UpdateDirectory(const aDirectory: TfpgString): TfpgString; override;
+ end;
+
implementation
uses
@@ -1989,6 +1997,47 @@ begin
);
end;
+{ TfpgFileListImpl }
+
+function TfpgFileListImpl.InitializeEntry(sr: TSearchRec): TFileEntry;
+begin
+ Result := inherited InitializeEntry(sr);
+ if Assigned(Result) then
+ begin
+ Result.Name := UTF8Encode(Result.Name);
+ Result.Extention := UTF8Encode(Result.Extention);
+ end;
+end;
+
+function TfpgFileListImpl.UpdateDirectory(const aDirectory: TfpgString
+ ): TfpgString;
+var
+ n: integer;
+ drvs: string;
+begin
+ FSpecialDirs.Clear;
+
+ // making drive list
+ if Copy(aDirectory, 2, 1) = ':' then
+ begin
+ n := 0;
+ { TODO: replace 25 with a constant: max nested directories displayed }
+ while n <= 25 do
+ begin
+ drvs := chr(n+ord('A'))+':\';
+ if Windows.GetDriveType(PChar(drvs)) <> 1 then
+ begin
+ // vvzh: to avoid doubling of drive letters in inherited UpdateDirectory
+ if Pos(drvs, aDirectory) <> 1 then
+ FSpecialDirs.Add(drvs);
+ end;
+ inc(n);
+ end;
+ end;
+
+ Result := inherited UpdateDirectory(aDirectory);
+end;
+
initialization
wapplication := nil;
MouseFocusedWH := 0;
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 87cc4e54..17a6fd21 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -420,6 +420,69 @@ type
constructor Create;
property Text: string read DoGetText write DoSetText;
end;
+
+ TFileEntryType = (etFile, etDir);
+ TFileListSortOrder = (soNone, soFileName, soCSFileName, soFileExt, soSize, soTime);
+
+ // A simple data object
+ TFileEntry = class(TObject)
+ private
+ FAttributes: longword;
+ FEntryType: TFileEntryType;
+ FExtention: string;
+ FGroupID: integer; // unix
+ FIsLink: boolean;
+ FLinkTarget: string;
+ FMode: longword; // unix
+ FModTime: TDateTime;
+ FName: string;
+ FOwnerID: integer; // unix
+ FSize: int64;
+ public
+ constructor Create;
+ property Name: string read FName write FName;
+ property Extention: string read FExtention write FExtention;
+ property Size: int64 read FSize write FSize;
+ property EntryType: TFileEntryType read FEntryType write FEntryType;
+ property IsLink: boolean read FIsLink write FIsLink;
+ property Attributes: longword read FAttributes write FAttributes;
+ property Mode: longword read FMode write FMode; // only used by unix OS's
+ property ModTime: TDateTime read FModTime write FModTime;
+ property OwnerID: integer read FOwnerID write FOwnerID;
+ property GroupID: integer read FGroupID write FGroupID;
+ property LinkTarget: string read FLinkTarget write FLinkTarget;
+ end;
+
+ { TfpgFileListBase }
+
+ TfpgFileListBase = class(TObject)
+ private
+ FEntries: TList;
+ FDirectoryName: TfpgString;
+ FFileMask: TfpgString;
+ FShowHidden: boolean;
+ FCurrentSpecialDir: integer;
+ procedure AddEntry(sr: TSearchRec);
+ function GetEntry(i: integer): TFileEntry;
+ function HasAttrib(fileAttrib, testAttrib: Integer): Boolean;
+ protected
+ FSpecialDirs: TStringList;
+ function InitializeEntry(sr: TSearchRec): TFileEntry; virtual;
+ function UpdateDirectory(const aDirectory: TfpgString): TfpgString virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Count: integer;
+ function CurrentSpecialDir: integer;
+ function ReadDirectory(const aDirectory: TfpgString = ''): boolean;
+ procedure Clear;
+ procedure Sort(AOrder: TFileListSortOrder);
+ property Entry[i: integer]: TFileEntry read GetEntry;
+ property SpecialDirs: TStringList read FSpecialDirs;
+ property DirectoryName: TfpgString read FDirectoryName;
+ property FileMask: TfpgString read FFileMask write FFileMask;
+ property ShowHidden: boolean read FShowHidden write FShowHidden;
+ end;
{ ******** Helper functions ******** }
@@ -446,6 +509,7 @@ implementation
uses
fpgfx, // needed for fpgApplication
+ gfx_utils, // needed for fpgFileList
typinfo;
@@ -1698,5 +1762,300 @@ begin
InitClipboard;
end;
+// Helper functions for TFileEntry and TfpgFileListBase
+
+function StringMatches(const astr, apat: string): boolean;
+var
+ pati, si: longint;
+begin
+ result := True;
+ pati := 1;
+ si := 1;
+ while result and (si <= length(astr)) and (pati <= length(apat)) do
+ begin
+ if (apat[pati] = '?') or (apat[pati] = astr[si]) then
+ begin
+ inc(si);
+ inc(pati);
+ end
+ else if (apat[pati] = '*') then
+ begin
+ while (pati <= length(apat)) and (apat[pati] in ['?','*']) do
+ inc(pati);
+ if pati > length(apat) then
+ begin
+ si := length(astr)+1;
+ Break; // * at the end
+ end;
+
+ while (si <= length(astr)) and (astr[si] <> apat[pati]) do
+ inc(si);
+ if si > length(astr) then
+ result := False;
+ end
+ else
+ begin
+ result := False;
+ end;
+ end;
+
+ result := result and (si > length(astr));
+end;
+
+// multiple patterns separated with ;
+function FileNameMatches(const astr, apats: string): boolean;
+var
+ cpat: string;
+ p: integer;
+ s: string;
+ astrupper: string;
+begin
+ astrupper := UpperCase(astr);
+ result := False;
+ s := apats;
+ repeat
+ cpat := '';
+ p := pos(';',s);
+ if p > 0 then
+ begin
+ cpat := copy(s, 1, p-1);
+ delete(s, 1, p);
+ end
+ else
+ begin
+ cpat := s;
+ s := '';
+ end; { if/else }
+ cpat := UpperCase(trim(cpat));
+ if cpat <> '' then
+ result := StringMatches(astrupper, cpat);
+ until result or (cpat = '');
+end;
+
+{ TFileEntry }
+
+constructor TFileEntry.Create;
+begin
+ FAttributes := 0;
+ FMode := 0;
+ FSize := 0;
+ FIsLink := False;
+ FEntryType := etFile;
+end;
+
+{ TfpgFileListBase }
+
+procedure TfpgFileListBase.AddEntry(sr: TSearchRec);
+var
+ e: TFileEntry;
+begin
+ e := InitializeEntry(sr);
+ if Assigned(e) then
+ FEntries.Add(e);
+end;
+
+function TfpgFileListBase.HasAttrib(fileAttrib, testAttrib: Integer): Boolean;
+begin
+ { HasAttrib() tests whether or not a file (with attributes fileAttrib) has the
+ testAttrib attribute bit set. }
+ Result := (fileAttrib and testAttrib) <> 0;
+end;
+
+function TfpgFileListBase.GetEntry(i: integer): TFileEntry;
+begin
+ if (i < 1) or (i > FEntries.Count) then
+ Result := nil
+ else
+ Result := TFileEntry(FEntries[i-1]);
+end;
+
+function TfpgFileListBase.InitializeEntry(sr: TSearchRec): TFileEntry;
+var
+ e: TFileEntry;
+ fullname: TfpgString;
+begin
+ e := TFileEntry.Create;
+ e.Name := sr.Name;
+ e.Extention := ExtractFileExt(e.Name);
+ e.Size := sr.Size;
+ e.Attributes := sr.Attr; // this is incorrect and needs to improve!
+ e.EntryType := etFile;
+ fullname := FDirectoryName + e.Name;
+ e.IsLink := FileIsSymlink(fullname);
+ e.LinkTarget := ExtractTargetSymLinkPath(fullname);
+ e.ModTime := FileDateToDateTime(sr.Time);
+
+ if HasAttrib(sr.Attr, faDirectory) then
+ e.EntryType := etDir
+ else
+ e.EntryType := etFile;
+
+ if (e.Name = '.') or
+ ((e.Name = '..') and (FDirectoryName = '/')) or
+ (not FShowHidden and (Copy(e.Name, 1, 1) = '.') and (Copy(e.Name, 2, 1) <> '.')) or
+// (not FShowHidden and HasAttrib(sr.Attr, faHidden)) or
+ ((e.EntryType = etFile) and not FileNameMatches(e.Name, FFileMask)) then
+ begin
+ // do not add this entry
+ Result := nil;
+ end else
+ Result := e;
+end;
+
+function TfpgFileListBase.UpdateDirectory(const aDirectory: TfpgString): TfpgString;
+{Sets up FSpecialDirs list}
+var
+ i, n: integer;
+ rootadd: integer;
+begin
+ // find insert position
+ i := 0;
+ while (i < FSpecialDirs.Count)
+ and (FSpecialDirs.Strings[i][1] <= aDirectory[1]) do
+ inc(i);
+
+ n := 1;
+ rootadd := 1;
+ while n < Length(aDirectory) do
+ begin
+ if aDirectory[n] = DirectorySeparator then
+ begin
+ FSpecialDirs.Insert(i, Copy(aDirectory, 1, n-1+rootadd));
+ rootadd := 0;
+ inc(i);
+ end;
+ inc(n);
+ end;
+
+ FSpecialDirs.Insert(i, aDirectory);
+ FCurrentSpecialDir := i;
+
+ Result := aDirectory;
+end;
+
+constructor TfpgFileListBase.Create;
+begin
+ FEntries := TList.Create;
+ FDirectoryName := '';
+ FSpecialDirs := TStringList.Create;
+end;
+
+destructor TfpgFileListBase.Destroy;
+begin
+ Clear;
+ FSpecialDirs.Free;
+ FEntries.Free;
+ inherited Destroy;
+end;
+
+function TfpgFileListBase.Count: integer;
+begin
+ Result := FEntries.Count;
+end;
+
+function TfpgFileListBase.CurrentSpecialDir: integer;
+begin
+ Result := FCurrentSpecialDir;
+end;
+
+function TfpgFileListBase.ReadDirectory(const aDirectory: TfpgString = ''): boolean;
+var
+ SearchRec: TSearchRec;
+ dir: TfpgString; // to prevent FDirectoryName from having incorrect value
+begin
+ // default parameter value is current directory
+ if aDirectory <> '' then
+ dir := ExpandFileName(aDirectory)
+ else
+ GetDir(0, dir);
+
+ // vvzh: now we have to use SetCurrentDir in order to make ExpandFileName work
+ if not SetCurrentDir(dir) then
+ begin
+ Result := False;
+ Exit; //==>
+ end;
+
+ FDirectoryName := UpdateDirectory(dir);
+ // Add PathDelim to end if it doesn't yet exist
+ FDirectoryName := IncludeTrailingPathDelimiter(FDirectoryName);
+
+ Clear;
+ try
+ // The extra 'or' includes Normal attribute files under Windows. faAnyFile doesn't return those.
+ // Reported to FPC as bug 9440 in Mantis.
+ if SysUtils.FindFirst(FDirectoryName + '*', faAnyFile or $00000080, SearchRec) = 0 then
+ begin
+ AddEntry(SearchRec);
+ while SysUtils.FindNext(SearchRec) = 0 do
+ begin
+ AddEntry(SearchRec);
+ end;
+ end;
+ finally
+ SysUtils.FindClose(SearchRec);
+ end;
+end;
+
+procedure TfpgFileListBase.Clear;
+var
+ n: integer;
+begin
+ for n := 0 to FEntries.Count-1 do
+ TFileEntry(FEntries[n]).Free;
+ FEntries.Clear;
+end;
+
+procedure TfpgFileListBase.Sort(AOrder: TFileListSortOrder);
+var
+ newl: TList;
+ n: integer;
+ i: integer;
+ e: TFileEntry;
+
+ function IsBefore(newitem, item: TFileEntry): boolean;
+ begin
+ //if newitem.etype = etDir then writeln('dir: ',newitem.name,' (',item.name,')');
+ if (newitem.EntryType = etDir) and (item.EntryType <> etDir) then
+ begin
+ result := true;
+ end
+ else if (newitem.EntryType <> etDir) and (item.EntryType = etDir) then
+ begin
+ result := false;
+ end
+ else if (newitem.EntryType = etDir) and (newitem.Name = '..') then
+ begin
+ result := true;
+ end
+ else if (item.EntryType = etDir) and (item.Name = '..') then
+ begin
+ result := false;
+ end
+ else
+ case AOrder of
+ soFileName : result := UpperCase(newitem.Name) < UpperCase(item.Name);
+ soCSFileName : result := newitem.Name < item.Name;
+ soFileExt : result := UpperCase(newitem.Extention+' '+newitem.Name) < UpperCase(item.Extention+' '+item.Name);
+ soSize : result := newitem.size < item.size;
+ soTime : result := newitem.modtime < item.modtime;
+ else
+ result := False;
+ end;
+ end;
+
+begin
+ newl := TList.Create;
+ for n := 0 to FEntries.Count-1 do
+ begin
+ e := TFileEntry(FEntries[n]);
+ i := 0;
+ while (i < newl.Count) and not IsBefore(e,TFileEntry(newl[i])) do inc(i);
+ newl.Insert(i,e);
+ end;
+ FEntries.Free;
+ FEntries := newl;
+end;
+
end.
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index b7063c79..2ece401a 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -202,6 +202,11 @@ type
procedure InitClipboard; override;
end;
+
+ TfpgFileListImpl = class(TfpgFileListBase)
+ function InitializeEntry(sr: TSearchRec): TFileEntry; override;
+ function UpdateDirectory(const aDirectory: TfpgString): TfpgString; override;
+ end;
implementation
@@ -2060,7 +2065,35 @@ begin
xapplication.RootWindow, 10, 10, 10, 10, 0, 0, 0);
end;
+{ TfpgFileListImpl }
+function TfpgFileListImpl.InitializeEntry(sr: TSearchRec): TFileEntry;
+var
+ info: Tstat;
+begin
+ Result := inherited InitializeEntry(sr);
+ if Assigned(Result) then
+ begin
+ Result.mode := sr.Mode;
+ Fpstat(PChar(DirectoryName + Result.Name), info);
+ Result.GroupID := info.st_gid;
+ Result.OwnerID := info.st_uid;
+ end;
+end;
+
+function TfpgFileListImpl.UpdateDirectory(const aDirectory: TfpgString
+ ): TfpgString;
+var
+ ds: string;
+begin
+ FSpecialDirs.Clear;
+
+ ds := aDirectory;
+ if Copy(ds, 1, 1) <> DirectorySeparator then
+ ds := DirectorySeparator + ds;
+
+ Result := inherited UpdateDirectory(ds);
+end;
initialization
xapplication := nil;
diff --git a/src/gui/gui_dialogs.pas b/src/gui/gui_dialogs.pas
index 2e50b963..fd85d875 100644
--- a/src/gui/gui_dialogs.pas
+++ b/src/gui/gui_dialogs.pas
@@ -1127,9 +1127,10 @@ begin
begin
if dlg.Directory <> '' then
begin
- ShowMessage(dlg.Directory);
mkdir(dlg.Directory);
- grid.FileList.ReadDirectory(GetFileFilter, ShowHidden);
+ grid.FileList.FileMask := GetFileFilter;
+ grid.FileList.ShowHidden := ShowHidden;
+ grid.FileList.ReadDirectory();
grid.FileList.Sort(soFileName);
grid.Invalidate;
end;
@@ -1154,85 +1155,27 @@ end;
procedure TfpgFileDialog.SetCurrentDirectory(const ADir: string);
var
- ds: string;
- n: integer;
- rootadd: integer;
fsel: string;
-{$ifdef Win32}
- drvind: integer;
- drvs: string;
-{$endif}
begin
- ds := '';
- GetDir(0, ds);
- fsel := ExtractFileName(ds);
+ if ADir = '..' then
+ fsel := ExtractFileName(
+ ExcludeTrailingPathDelimiter(grid.FileList.DirectoryName))
+ else
+ fsel := '';
+
+ grid.FileList.FileMask := GetFileFilter;
+ grid.FileList.ShowHidden := ShowHidden;
- if not SetCurrentDir(ADir) then
+ if not grid.FileList.ReadDirectory(ADir) then
begin
ShowMessage(Format(rsErrCouldNotOpenDir, [ADir]), rsError);
Exit; //==>
end;
-
- chlDir.Items.Clear;
- if ADir <> '..' then
- fsel := '';
-
- GetDir(0, ds);
- rootadd := 1;
-
- {$IFDEF MSWINDOWS}
- // making drive list 1
- drvind := -1;
- if Copy(ds, 2, 1) = ':' then
- drvind := ord(UpCase(ds[1]))-ord('A');
- n := 0;
- while n < drvind do
- begin
- drvs := chr(n+ord('A'))+':\';
- if Windows.GetDriveType(PChar(drvs)) <> 1 then
- begin
- chlDir.Items.Add(drvs);
- end;
- inc(n);
- end;
- {$ENDIF}
-
- {$IFDEF UNIX}
- if Copy(ds, 1, 1) <> DirectorySeparator then
- ds := DirectorySeparator + ds;
- {$ENDIF}
-
- n := 1;
- while n < Length(ds) do
- begin
- if ds[n] = DirectorySeparator then
- begin
- chlDir.Items.Add(Copy(ds, 1, n-1+rootadd));
- rootadd := 0;
- end;
- inc(n);
- end;
-
- chlDir.Items.Add(ds);
- chlDir.FocusItem := chlDir.Items.Count;
-
- {$IFDEF MSWINDOWS}
- // making drive list 2
- n := drvind+1;
- if n < 0 then n := 0;
- while n <= 25 do
- begin
- drvs := chr(n+ord('A'))+':\';
- if Windows.GetDriveType(PChar(drvs)) <> 1 then
- begin
- chlDir.Items.Add(drvs);
- end;
- inc(n);
- end;
- {$ENDIF}
-
- grid.FileList.ReadDirectory(GetFileFilter, ShowHidden);
+
grid.FileList.Sort(soFileName);
+
+ chlDir.Items.Assign(grid.FileList.SpecialDirs);
+ chlDir.FocusItem := grid.FileList.CurrentSpecialDir + 1;
if fsel <> '' then
SelectFile(fsel)
diff --git a/src/gui/gui_grid.pas b/src/gui/gui_grid.pas
index 8d19e040..697c1b8c 100644
--- a/src/gui/gui_grid.pas
+++ b/src/gui/gui_grid.pas
@@ -66,61 +66,10 @@ type
property OnDoubleClick;
end;
}
-
- //***************** Move these to CoreLib ********************
- TFileEntryType = (etFile, etDir);
- TFileListSortOrder = (soNone, soFileName, soCSFileName, soFileExt, soSize, soTime);
-
- // A simple data object
- TFileEntry = class(TObject)
- private
- FAttributes: longword;
- FEntryType: TFileEntryType;
- FExtention: string;
- FGroupID: integer;
- FIsLink: boolean;
- FLinkTarget: string;
- FMode: longword;
- FModTime: TDateTime;
- FName: string;
- FOwnerID: integer;
- FSize: int64;
- public
- constructor Create;
- property Name: string read FName write FName;
- property Extention: string read FExtention write FExtention;
- property Size: int64 read FSize write FSize;
- property EntryType: TFileEntryType read FEntryType write FEntryType;
- property IsLink: boolean read FIsLink write FIsLink;
- property Attributes: longword read FAttributes write FAttributes;
- property Mode: longword read FMode write FMode; // only used by unix OS's
- property ModTime: TDateTime read FModTime write FModTime;
- property OwnerID: integer read FOwnerID write FOwnerID;
- property GroupID: integer read FGroupID write FGroupID;
- property LinkTarget: string read FLinkTarget write FLinkTarget;
- end;
-
-
- TFileList = class(TObject)
- private
- FEntries: TList;
- FDirectoryName: string;
- function GetEntry(i: integer): TFileEntry;
- public
- constructor Create;
- destructor Destroy; override;
- function Count: integer;
- function ReadDirectory(const AFilemask: string; AShowHidden: boolean): integer;
- procedure Clear;
- procedure Sort(AOrder: TFileListSortOrder);
- property Entry[i: integer]: TFileEntry read GetEntry;
- property DirectoryName: string read FDirectoryName;
- end;
-
TfpgFileGrid = class(TfpgCustomGrid)
private
- FFileList: TFileList;
+ FFileList: TfpgFileList;
FFixedFont: TfpgFont;
protected
function GetRowCount: integer; override;
@@ -130,7 +79,7 @@ type
destructor Destroy; override;
function CurrentEntry: TFileEntry;
property FixedFont: TfpgFont read FFixedFont;
- property FileList: TFileList read FFileList;
+ property FileList: TfpgFileList read FFileList;
property DefaultRowHeight;
property Font;
property HeaderFont;
@@ -243,77 +192,6 @@ begin
Result.ColumnCount := AColumnCount;
end;
-
-// ***** These two functions will be moving out of this unit soon!
-
-function StringMatches(const astr, apat: string): boolean;
-var
- pati, si: longint;
-begin
- result := True;
- pati := 1;
- si := 1;
- while result and (si <= length(astr)) and (pati <= length(apat)) do
- begin
- if (apat[pati] = '?') or (apat[pati] = astr[si]) then
- begin
- inc(si);
- inc(pati);
- end
- else if (apat[pati] = '*') then
- begin
- while (pati <= length(apat)) and (apat[pati] in ['?','*']) do
- inc(pati);
- if pati > length(apat) then
- begin
- si := length(astr)+1;
- Break; // * at the end
- end;
-
- while (si <= length(astr)) and (astr[si] <> apat[pati]) do
- inc(si);
- if si > length(astr) then
- result := False;
- end
- else
- begin
- result := False;
- end;
- end;
-
- result := result and (si > length(astr));
-end;
-
-// multiple patterns separated with ;
-function FileNameMatches(const astr, apats: string): boolean;
-var
- cpat: string;
- p: integer;
- s: string;
- astrupper: string;
-begin
- astrupper := UpperCase(astr);
- result := False;
- s := apats;
- repeat
- cpat := '';
- p := pos(';',s);
- if p > 0 then
- begin
- cpat := copy(s, 1, p-1);
- delete(s, 1, p);
- end
- else
- begin
- cpat := s;
- s := '';
- end; { if/else }
- cpat := UpperCase(trim(cpat));
- if cpat <> '' then
- result := StringMatches(astrupper, cpat);
- until result or (cpat = '');
-end;
-
{$IFDEF UNIX}
{$if defined(linux) and defined(cpu386)}
function GetGroupName(gid: integer): string;
@@ -352,187 +230,6 @@ end;
{$endif}
{$ENDIF UNIX}
-
-{ TFileEntry }
-
-constructor TFileEntry.Create;
-begin
- FAttributes := 0;
- FMode := 0;
- FSize := 0;
- FIsLink := False;
- FEntryType := etFile;
-end;
-
-{ TFileList }
-
-function TFileList.GetEntry(i: integer): TFileEntry;
-begin
- if (i < 1) or (i > FEntries.Count) then
- Result := nil
- else
- Result := TFileEntry(FEntries[i-1]);
-end;
-
-constructor TFileList.Create;
-begin
- FEntries := TList.Create;
- FDirectoryName := '';
-end;
-
-destructor TFileList.Destroy;
-begin
- Clear;
- FEntries.Free;
- inherited Destroy;
-end;
-
-function TFileList.Count: integer;
-begin
- Result := FEntries.Count;
-end;
-
-function TFileList.ReadDirectory(const AFilemask: string; AShowHidden: boolean): integer;
-
- { HasAttrib() tests whether or not a file (with attributes fileAttrib) has the
- testAttrib attribute bit set. }
- function HasAttrib(fileAttrib, testAttrib: Integer): Boolean;
- begin
- Result := (fileAttrib and testAttrib) <> 0;
- end;
-
- // locally visible proc
- procedure AddEntry(sr: TSearchRec);
- var
- e: TFileEntry;
- fullname: string;
- {$IFDEF UNIX}
- info: Tstat;
- {$ENDIF}
- begin
- e := TFileEntry.Create;
- e.Name := sr.Name;
- e.Extention := ExtractFileExt(e.Name);
- e.Size := sr.Size;
- e.Attributes := sr.Attr; // this is incorrect and needs to improve!
- e.EntryType := etFile;
- fullname := FDirectoryName + e.Name;
- {$IFDEF UNIX}
- e.mode := sr.Mode;
- Fpstat(PChar(fullname), info);
- e.GroupID := info.st_gid;
- e.OwnerID := info.st_uid;
- {$ENDIF}
- e.IsLink := FileIsSymlink(fullname);
- e.LinkTarget := ExtractTargetSymLinkPath(fullname);
- e.ModTime := FileDateToDateTime(sr.Time);
-
- if HasAttrib(sr.Attr, faDirectory) then
- e.EntryType := etDir
- else
- e.EntryType := etFile;
-
- if (e.Name = '.') or
- ((e.Name = '..') and (FDirectoryName = '/')) or
- (not AShowHidden and (Copy(e.Name, 1, 1) = '.') and (Copy(e.Name, 2, 1) <> '.')) or
-// (not AShowHidden and HasAttrib(sr.Attr, faHidden)) or
- ((e.EntryType = etFile) and not FileNameMatches(e.Name, AFilemask)) then
- begin
- // do not add this entry
- e.Free;
- end
- else
- FEntries.Add(e)
- end;
-
-var
- SearchRec: TSearchRec;
-begin
- Clear;
- GetDir(0, FDirectoryName);
-
- // Add PathDelim to end if it doesn't yet exist
- if Copy(FDirectoryName, Length(FDirectoryName), 1) <> PathDelim then
- FDirectoryName := FDirectoryName + PathDelim;
-
- try
- // The extra 'or' includes Normal attribute files under Windows. faAnyFile doesn't return those.
- // Reported to FPC as bug 9440 in Mantis.
- if SysUtils.FindFirst(FDirectoryName + '*', faAnyFile or $00000080, SearchRec) = 0 then
- begin
- AddEntry(SearchRec);
- while SysUtils.FindNext(SearchRec) = 0 do
- begin
- AddEntry(SearchRec);
- end;
- end;
- finally
- SysUtils.FindClose(SearchRec);
- end;
-
- Result := FEntries.Count;
-end;
-
-procedure TFileList.Clear;
-var
- n: integer;
-begin
- for n := 0 to FEntries.Count-1 do
- TFileEntry(FEntries[n]).Free;
- FEntries.Clear;
-end;
-
-procedure TFileList.Sort(AOrder: TFileListSortOrder);
-var
- newl: TList;
- n: integer;
- i: integer;
- e: TFileEntry;
-
- function IsBefore(newitem, item: TFileEntry): boolean;
- begin
- //if newitem.etype = etDir then writeln('dir: ',newitem.name,' (',item.name,')');
- if (newitem.EntryType = etDir) and (item.EntryType <> etDir) then
- begin
- result := true;
- end
- else if (newitem.EntryType <> etDir) and (item.EntryType = etDir) then
- begin
- result := false;
- end
- else if (newitem.EntryType = etDir) and (newitem.Name = '..') then
- begin
- result := true;
- end
- else if (item.EntryType = etDir) and (item.Name = '..') then
- begin
- result := false;
- end
- else
- case AOrder of
- soFileName : result := UpperCase(newitem.Name) < UpperCase(item.Name);
- soCSFileName : result := newitem.Name < item.Name;
- soFileExt : result := UpperCase(newitem.Extention+' '+newitem.Name) < UpperCase(item.Extention+' '+item.Name);
- soSize : result := newitem.size < item.size;
- soTime : result := newitem.modtime < item.modtime;
- else
- result := False;
- end;
- end;
-
-begin
- newl := TList.Create;
- for n := 0 to FEntries.Count-1 do
- begin
- e := TFileEntry(FEntries[n]);
- i := 0;
- while (i < newl.Count) and not IsBefore(e,TFileEntry(newl[i])) do inc(i);
- newl.Insert(i,e);
- end;
- FEntries.Free;
- FEntries := newl;
-end;
-
{ TfpgFileGrid }
function TfpgFileGrid.GetRowCount: integer;
@@ -645,7 +342,7 @@ end;
constructor TfpgFileGrid.Create(AOwner: TComponent);
begin
- FFileList := TFileList.Create;
+ FFileList := TfpgFileList.Create;
inherited Create(AOwner);
ColumnCount := 0;
RowCount := 0;
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-29 11:34:33 +0000