summaryrefslogtreecommitdiff
path: root/src/gui/gui_grid.pas
diff options
context:
space:
mode:
Diffstat (limited to 'src/gui/gui_grid.pas')
-rw-r--r--src/gui/gui_grid.pas309
1 files changed, 3 insertions, 306 deletions
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 12:22:06 +0000