From 1991b86c925074dd7f2d7dd93f5fbd0c4aabcc0e Mon Sep 17 00:00:00 2001 From: graemeg Date: Mon, 12 Jan 2009 15:08:53 +0000 Subject: * Added two new functions to fpg_utils unit. * More work on the Select Directory dialog. --- src/corelib/fpg_utils.pas | 49 +++++++++- src/corelib/x11/fpgui_toolkit.lpk | 24 +++-- src/gui/fpg_tree.pas | 14 +-- src/gui/selectdirdialog.inc | 190 +++++++++++++++++++++++++++++++++++--- 4 files changed, 244 insertions(+), 33 deletions(-) diff --git a/src/corelib/fpg_utils.pas b/src/corelib/fpg_utils.pas index 2edd1eab..7d5871c9 100644 --- a/src/corelib/fpg_utils.pas +++ b/src/corelib/fpg_utils.pas @@ -45,7 +45,8 @@ function fpgGetCurrentDir: TfpgString; function fpgSetCurrentDir(const NewDir: TfpgString): Boolean; function fpgExpandFileName(const FileName: TfpgString): TfpgString; function fpgFileExists(const FileName: TfpgString): Boolean; - +function fpgAppendPathDelim(const Path: TfpgString): TfpgString; +function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean; implementation @@ -111,6 +112,52 @@ begin Result := FileExists(fpgToOSEncoding(FileName)); end; +function fpgAppendPathDelim(const Path: TfpgString): TfpgString; +begin + if (Path <> '') and (Path[length(Path)] <> PathDelim) then + Result := Path + PathDelim + else + Result := Path; +end; + +{function fpgHasSubDirs returns True if the directory passed has subdirectories} +function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean; +var + FileInfo: TSearchRec; + FCurrentDir: TfpgString; +begin + //Assume No + Result := False; + if Dir <> '' then + begin + FCurrentDir := fpgAppendPathDelim(Dir); + FCurrentDir := FCurrentDir + AllFilesMask; + try + if fpgFindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then + repeat + if FileInfo.Name = '' then + Continue; + + // check if special file + if ((FileInfo.Name = '.') or (FileInfo.Name = '..')) or + // unix dot directories (aka hidden directories) + ((FileInfo.Name[1] in ['.']) and AShowHidden) or + // check Hidden attribute + (((faHidden and FileInfo.Attr) > 0) and AShowHidden) then + Continue; + + Result := ((faDirectory and FileInfo.Attr) > 0); + + //We found at least one non special dir, that's all we need. + if Result then + break; + until fpgFindNext(FileInfo) <> 0; + finally + FindClose(FileInfo); + end; + end; +end; + end. diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk index 55614af2..01283a1e 100644 --- a/src/corelib/x11/fpgui_toolkit.lpk +++ b/src/corelib/x11/fpgui_toolkit.lpk @@ -29,7 +29,7 @@ - + @@ -303,25 +303,29 @@ - - + + - - + + - - + + - - + + + + + + - + diff --git a/src/gui/fpg_tree.pas b/src/gui/fpg_tree.pas index 2a13c803..3bb86c64 100644 --- a/src/gui/fpg_tree.pas +++ b/src/gui/fpg_tree.pas @@ -74,7 +74,7 @@ type FPrev: TfpgTreeNode; FSelColor: TfpgColor; FSelTextColor: TfpgColor; - FText: string; + FText: TfpgString; FTextColor: TfpgColor; procedure SetCollapsed(const AValue: boolean); procedure SetInactSelColor(const AValue: TfpgColor); @@ -82,14 +82,14 @@ type procedure SetParent(const AValue: TfpgTreeNode); procedure SetSelColor(const AValue: TfpgColor); procedure SetSelTextColor(const AValue: TfpgColor); - procedure SetText(const AValue: string); + procedure SetText(const AValue: TfpgString); procedure SetTextColor(const AValue: TfpgColor); procedure DoRePaint; public constructor Create; destructor Destroy; override; // node related - function AppendText(AText: string): TfpgTreeNode; + function AppendText(AText: TfpgString): TfpgTreeNode; function Count: integer; function CountRecursive: integer; function FindSubNode(AText: string; ARecursive: Boolean): TfpgTreeNode; overload; @@ -117,7 +117,7 @@ type property Next: TfpgTreeNode read FNext write FNext; property Parent: TfpgTreeNode read FParent write SetParent; property Prev: TfpgTreeNode read FPrev write FPrev; - property Text: string read FText write SetText; + property Text: TfpgString read FText write SetText; // color settings property InactSelColor: TfpgColor read FInactSelColor write SetInactSelColor; property InactSelTextColor: TfpgColor read FInactSelTextColor write SetInactSelTextColor; @@ -302,9 +302,9 @@ begin end; end; -procedure TfpgTreeNode.SetText(const AValue: string); +procedure TfpgTreeNode.SetText(const AValue: TfpgString); begin - if aValue <> FText then + if AValue <> FText then begin FText := aValue; DoRePaint; @@ -465,7 +465,7 @@ begin end; end; -function TfpgTreeNode.AppendText(AText: string): TfpgTreeNode; +function TfpgTreeNode.AppendText(AText: TfpgString): TfpgTreeNode; var h: TfpgTreeNode; begin diff --git a/src/gui/selectdirdialog.inc b/src/gui/selectdirdialog.inc index 3541a935..7ce452b1 100644 --- a/src/gui/selectdirdialog.inc +++ b/src/gui/selectdirdialog.inc @@ -8,12 +8,23 @@ TfpgSelectDirDialog = class(TfpgBaseDialog) private lblTitle: TfpgLabel; - edDirectory: TfpgEdit; tv: TfpgTreeView; - function GetDirectory: TfpgString; + FDir: TfpgString; + FRootDir: TfpgString; + procedure lblTitleDblClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); + function GetAbsolutePath(Node: TfpgTreeNode): TfpgString; + procedure InitializeTreeview; + procedure SetDir(const AValue: TfpgString); + procedure SetRootDir(const AValue: TfpgString); + procedure AddDirectories(Node: TfpgTreeNode; Dir: TfpgString); public - constructor Create(AOwner: TComponent); override; - property Directory: TfpgString read GetDirectory; + procedure AfterCreate; override; + { return the selected directory } + function SelectedDir: TfpgString; + { The selected/opened directory } + property Directory: TfpgString read FDir write SetDir; + { Directory the treeview starts from } + property RootDirectory: TfpgString read FRootDir write SetRootDir; end; @@ -23,23 +34,165 @@ {$IFDEF read_implementation} -function TfpgSelectDirDialog.GetDirectory: TfpgString; +procedure TfpgSelectDirDialog.lblTitleDblClicked(Sender: TObject; + AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint); begin - // + InitializeTreeview; end; -constructor TfpgSelectDirDialog.Create(AOwner: TComponent); +function TfpgSelectDirDialog.GetAbsolutePath(Node: TfpgTreeNode): TfpgString; begin - inherited Create(AOwner); - lblTitle := CreateLabel(self, 8, 8, rsEnterNewDirectory); - edDirectory := CreateEdit(self, 8, 28, 270, 0); - edDirectory.Anchors := [anLeft, anTop, anRight]; + Result := ''; + while Node <> nil do + begin + if Node.Text = PathDelim then + Result := Node.Text + Result + else + Result := Node.Text + PathDelim + Result; + Node := Node.Parent; + end; +end; + +procedure TfpgSelectDirDialog.InitializeTreeview; +begin + { I'm not sure what we should set these to. Maybe another Config option? } + {$IFDEF UNIX} + RootDirectory := '/'; + {$ENDIF} + {$IFDEF MSWINDOWS} + RootDirectory := 'C:\'; + {$ENDIF} +end; + +procedure TfpgSelectDirDialog.SetDir(const AValue: TfpgString); +begin + if FDir=AValue then exit; + FDir:=AValue; +end; + +procedure TfpgSelectDirDialog.SetRootDir(const AValue: TfpgString); +var + RootNode: TfpgTreeNode; + lNode: TfpgTreeNode; +begin + { Clear the list } + tv.RootNode.Clear; + FRootDir := AValue; + + {$IFDEF MSWINDOWS} + { Add Windows drive letters } + AddWindowsDriveLetters; + {$ENDIF} + + { Remove the path delimeter unless this is root. } + if FRootDir = '' then + FRootDir := PathDelim; + if (FRootDir <> PathDelim) and (FRootDir[length(FRootDir)] = PathDelim) then + FRootDir := copy(FRootDir, 1, length(FRootDir) - 1); + { Find or Create the root node and add it to the Tree View. } + RootNode := tv.RootNode.FindSubNode(FRootDir + PathDelim, False); +// RootNode := TV.Items.FindTopLvlNode(FRootDir + PathDelim); + if RootNode = nil then +// RootNode := TV.Items.Add(nil, FRootDir); + RootNode := tv.RootNode.AppendText(FRootDir); + + { Add the Subdirectories to Root nodes } +// lNode := TV.Items.GetFirstNode; + lNode := RootNode; + writeln('Directories found:'); + while lNode <> nil do + begin + write('.'); + AddDirectories(lNode, lNode.Text); + lNode := lNode.Next; +// lNode := lNode.GetNextSibling; + end; + writeln(' '); + + { Set the original root node as the selected node. } + tv.Selection := RootNode; +// TV.Selected := RootNode; +end; + +{ Adds Subdirectories to a passed node if they exist } +procedure TfpgSelectDirDialog.AddDirectories(Node: TfpgTreeNode; Dir: TfpgString); +var + FileInfo: TSearchRec; + NewNode: TfpgTreeNode; + i: integer; + FCurrentDir: TfpgString; + //used to sort the directories. + SortList: TStringList; +begin + if Dir <> '' then + begin + FCurrentDir := Dir; + FCurrentDir := fpgAppendPathDelim(FCurrentDir); + i := length(FCurrentDir); + FCurrentDir := FCurrentDir + AllFilesMask; + try + if fpgFindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then + begin + try + SortList := TStringList.Create; + SortList.Sorted := True; + repeat + // check if special file + if (FileInfo.Name = '.') or (FileInfo.Name = '..') or (FileInfo.Name = '') then + Continue; + { If hidden files or directories must be filtered, we test for + dot files, considered hidden under unix type OS's. } + //if not FShowHidden then + //if (FileInfo.Name[1] in ['.']) then + //Continue; + + { if this is a directory then add it to the tree. } + if ((faDirectory and FileInfo.Attr) > 0) then + begin + { If this is a hidden file and we have not been requested to show + hidden files then do not add it to the list. } + //if ((faHidden and FileInfo.Attr) > 0) and not FShowHidden then + //continue; + + SortList.Add(FileInfo.Name); + end; + until fpgFindNext(FileInfo) <> 0; + for i := 0 to SortList.Count - 1 do + begin + NewNode := Node.AppendText(SortList[i]); +// NewNode := TV.Items.AddChild(Node, SortList[i]); + // if subdirectories then indicate so. +{ Todo: Fix this by adding HasChildren to Treeview } +// NewNode.HasChildren := fpgHasSubDirs(fpgAppendPathDelim(Dir) + NewNode.Text, FShowHidden); + end; + finally + SortList.Free; + end; + end; { if FindFirst... } + finally + FindClose(FileInfo); + end; + end; { if Dir... } + //if Node.Level = 0 then + //Node.Text := Dir; +end; + +procedure TfpgSelectDirDialog.AfterCreate; +begin + inherited AfterCreate; + Name := 'fpgSelectDirDialog'; + SetPosition(20, 20, 300, 370); + WindowTitle := 'Select a Directory'; { TODO : Localize this!! } + WindowPosition := wpScreenCenter; + + lblTitle := CreateLabel(self, FSpacing, FSpacing, rsEnterNewDirectory); + lblTitle.OnDoubleClick :=@lblTitleDblClicked; tv := TfpgTreeView.Create(self); with tv do begin Name := 'tv'; - SetPosition(8, 28, 270, 250); + SetPosition(FSpacing, 28, 288, 300); end; // reposition buttons @@ -49,9 +202,16 @@ begin btnOK.Top := btnCancel.Top; // now reset tab order - edDirectory.TabOrder := 1; - btnOK.TabOrder := 2; - btnCancel.TabOrder := 3; + tv.TabOrder := 1; + btnOK.TabOrder := 2; + btnCancel.TabOrder := 3; +end; + +function TfpgSelectDirDialog.SelectedDir: TfpgString; +begin + Result := ''; + if tv.Selection <> nil then + Result := GetAbsolutePath(tv.Selection); end; {$ENDIF read_implementation} -- cgit v1.2.3-70-g09d2