summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/corelib/fpg_utils.pas16
-rw-r--r--src/gui/fpg_dialogs.pas8
-rw-r--r--src/gui/fpg_tree.pas37
-rw-r--r--src/gui/selectdirdialog.inc73
4 files changed, 88 insertions, 46 deletions
diff --git a/src/corelib/fpg_utils.pas b/src/corelib/fpg_utils.pas
index 7d5871c9..603ecca9 100644
--- a/src/corelib/fpg_utils.pas
+++ b/src/corelib/fpg_utils.pas
@@ -34,6 +34,9 @@ procedure fpgOpenURL(const aURL: TfpgString);
// *** Common functions for all platforms ***
function fpgAddTrailingValue(const ALine, AValue: TfpgString; ADuplicates: boolean = true): TfpgString;
+function fpgAppendPathDelim(const Path: TfpgString): TfpgString;
+function fpgHasSubDirs(const Dir: TfpgString; AShowHidden: Boolean): Boolean;
+function fpgAllFilesMask: TfpgString;
// RTL wrapper filesystem functions with platform independant encoding
@@ -45,8 +48,6 @@ 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
@@ -131,7 +132,7 @@ begin
if Dir <> '' then
begin
FCurrentDir := fpgAppendPathDelim(Dir);
- FCurrentDir := FCurrentDir + AllFilesMask;
+ FCurrentDir := FCurrentDir + fpgAllFilesMask;
try
if fpgFindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then
repeat
@@ -158,6 +159,15 @@ begin
end;
end;
+function fpgAllFilesMask: TfpgString;
+begin
+ {$Note In FPC 2.2.2 onwards we can use AllFilesMask which is part of RTL }
+ {$IFDEF WINDOWS}
+ Result := '*.*';
+ {$ELSE}
+ Result := '*';
+ {$ENDIF}
+end;
end.
diff --git a/src/gui/fpg_dialogs.pas b/src/gui/fpg_dialogs.pas
index 36be0454..d7cd8107 100644
--- a/src/gui/fpg_dialogs.pas
+++ b/src/gui/fpg_dialogs.pas
@@ -219,7 +219,7 @@ uses
fpg_utils,
fpg_stringutils
{$IFDEF MSWINDOWS}
- ,Windows // used by File Dialog
+ ,Windows // used by File Dialog & Select Dir Dialog
{$ENDIF}
,DateUtils
;
@@ -379,8 +379,10 @@ var
begin
dlg := TfpgSelectDirDialog.Create(nil);
try
- dlg.ShowModal;
- Result := '';
+ if dlg.ShowModal = mrOK then
+ Result := dlg.SelectedDir
+ else
+ Result := '';
finally
dlg.Free;
end;
diff --git a/src/gui/fpg_tree.pas b/src/gui/fpg_tree.pas
index 3bb86c64..21a60f2a 100644
--- a/src/gui/fpg_tree.pas
+++ b/src/gui/fpg_tree.pas
@@ -76,6 +76,7 @@ type
FSelTextColor: TfpgColor;
FText: TfpgString;
FTextColor: TfpgColor;
+ FHasChildren: Boolean;
procedure SetCollapsed(const AValue: boolean);
procedure SetInactSelColor(const AValue: TfpgColor);
procedure SetInactSelTextColor(const AValue: TfpgColor);
@@ -85,6 +86,7 @@ type
procedure SetText(const AValue: TfpgString);
procedure SetTextColor(const AValue: TfpgColor);
procedure DoRePaint;
+ procedure SetHasChildren(const AValue: Boolean);
public
constructor Create;
destructor Destroy; override;
@@ -118,6 +120,8 @@ type
property Parent: TfpgTreeNode read FParent write SetParent;
property Prev: TfpgTreeNode read FPrev write FPrev;
property Text: TfpgString read FText write SetText;
+ { determines the + or - image in the treeview }
+ property HasChildren: Boolean read FHasChildren write SetHasChildren;
// color settings
property InactSelColor: TfpgColor read FInactSelColor write SetInactSelColor;
property InactSelTextColor: TfpgColor read FInactSelTextColor write SetInactSelTextColor;
@@ -130,8 +134,6 @@ type
TfpgTreeExpandEvent = procedure(Sender: TObject; ANode: TfpgTreeNode) of object;
- { TfpgTreeView }
-
TfpgTreeView = class(TfpgWidget)
private
FImageList: TfpgImageList;
@@ -325,6 +327,15 @@ begin
// todo
end;
+procedure TfpgTreeNode.SetHasChildren(const AValue: Boolean);
+begin
+ if FHasChildren <> AValue then
+ begin
+ FHasChildren := AValue;
+ DoRePaint;
+ end;
+end;
+
constructor TfpgTreeNode.Create;
begin
FData := nil;
@@ -332,11 +343,13 @@ begin
FLastSubNode := nil;
FText := '';
FImageIndex := -1;
-
+ FCollapsed := True;
+ FHasChildren := False;
+
FParent := nil;
FNext := nil;
FPrev := nil;
-
+
FSelColor := clUnset;
FSelTextColor := clUnset;
FTextColor := clUnset;
@@ -1161,7 +1174,7 @@ begin
if (x >= w - GetColumnWidth(i1) div 2 - 3) and (x <= w - GetColumnWidth(i1) div 2 + 6) then
// collapse or expand?
begin // yes
- if node.Count > 0 then
+ if (node.Count > 0) or node.HasChildren then
begin
if node.Collapsed then
begin
@@ -1389,7 +1402,7 @@ begin
end; { if/else }
Canvas.SetLineStyle(1, FTreeLineStyle);
- if h.Count > 0 then // do we have subnodes?
+ if (h.Count > 0) or h.HasChildren then // do we have subnodes?
begin
// small horizontal line above rectangle for first subnode (with children) only
if (h <> RootNode.FirstSubNode) then
@@ -1408,7 +1421,7 @@ begin
Canvas.SetColor(clText1);
- if h.Collapsed then
+ if h.Collapsed {or h.HasChildren} then
begin
// draw a "+"
Canvas.DrawLine(w - FXOffset - GetColumnWidth(i1) div 2 - 1, ACenterPos + 1, w - FXOffset - GetColumnWidth(i1) div 2 + 4, ACenterPos + 1);
@@ -1433,10 +1446,10 @@ begin
if h.prev <> nil then
begin
// line up to the previous node
- if h.prev.count > 0 then
+ if (h.prev.count > 0) {or h.prev.HasChildren} then
begin
// take the previous subnode rectangle in account
- if h.count > 0 then
+ if (h.count > 0) or h.HasChildren then
// we have a subnode rectangle
Canvas.DrawLine(w - FXOffset - GetColumnWidth(i1) div 2 + 1, ACenterPos - 4, w - FXOffset - GetColumnWidth(i1) div 2 + 1, ACenterPos - (SpaceToVisibleNext(h.prev) * GetNodeHeight) + 5)
else
@@ -1445,7 +1458,7 @@ begin
else
begin
// previous node has no subnodes
- if h.count > 0 then
+ if (h.count > 0) or h.HasChildren then
// we have a subnode rectangle
Canvas.DrawLine(w - FXOffset - GetColumnWidth(i1) div 2 + 1, ACenterPos - 3, w - FXOffset - GetColumnWidth(i1) div 2 + 1, ACenterPos - SpaceToVisibleNext(h.prev) * GetNodeHeight + 1)
else
@@ -1454,7 +1467,7 @@ begin
end
else
begin
- if h.count > 0 then
+ if (h.count > 0) or h.HasChildren then
// take the subnode rectangle in account
Canvas.DrawLine(w - FXOffset - GetColumnWidth(i1) div 2 + 1,ACenterPos - 3, w - FXOffset - GetColumnWidth(i1) div 2 + 1, ACenterPos - GetNodeHeight div 2 + 3)
else
@@ -1500,7 +1513,7 @@ begin
if h.next <> nil then
begin
h := h.next;
- if h.prev.count > 0 then
+ if (h.prev.count > 0) {or h.prev.HasChildren} then
begin
x := w - FXOffset - GetColumnWidth(i1) div 2 + 1;
y := GetAbsoluteNodeTop(h.prev) - FYOffset + 5 + (GetNodeHeight div 2);
diff --git a/src/gui/selectdirdialog.inc b/src/gui/selectdirdialog.inc
index 7ce452b1..75f04392 100644
--- a/src/gui/selectdirdialog.inc
+++ b/src/gui/selectdirdialog.inc
@@ -7,22 +7,22 @@
TfpgSelectDirDialog = class(TfpgBaseDialog)
private
- lblTitle: TfpgLabel;
tv: TfpgTreeView;
- FDir: TfpgString;
FRootDir: TfpgString;
- procedure lblTitleDblClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
+ FShowHidden: Boolean;
function GetAbsolutePath(Node: TfpgTreeNode): TfpgString;
procedure InitializeTreeview;
- procedure SetDir(const AValue: TfpgString);
procedure SetRootDir(const AValue: TfpgString);
procedure AddDirectories(Node: TfpgTreeNode; Dir: TfpgString);
+ procedure NodeExpanded(Sender: TObject; ANode: TfpgTreeNode);
+ {$IFDEF MSWINDOWS}
+ procedure AddWindowsDriveLetters;
+ {$ENDIF}
public
+ constructor Create(AOwner: TComponent); override;
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;
@@ -34,12 +34,6 @@
{$IFDEF read_implementation}
-procedure TfpgSelectDirDialog.lblTitleDblClicked(Sender: TObject;
- AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
-begin
- InitializeTreeview;
-end;
-
function TfpgSelectDirDialog.GetAbsolutePath(Node: TfpgTreeNode): TfpgString;
begin
Result := '';
@@ -62,12 +56,7 @@ begin
{$IFDEF MSWINDOWS}
RootDirectory := 'C:\';
{$ENDIF}
-end;
-
-procedure TfpgSelectDirDialog.SetDir(const AValue: TfpgString);
-begin
- if FDir=AValue then exit;
- FDir:=AValue;
+ tv.RootNode.Expand;
end;
procedure TfpgSelectDirDialog.SetRootDir(const AValue: TfpgString);
@@ -99,19 +88,15 @@ begin
{ 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 }
@@ -163,20 +148,52 @@ begin
// 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);
+ NewNode.HasChildren := fpgHasSubDirs(fpgAppendPathDelim(Dir) + NewNode.Text, FShowHidden);
end;
finally
SortList.Free;
end;
end; { if FindFirst... }
finally
- FindClose(FileInfo);
+ SysUtils.FindClose(FileInfo);
end;
end; { if Dir... }
//if Node.Level = 0 then
//Node.Text := Dir;
end;
+procedure TfpgSelectDirDialog.NodeExpanded(Sender: TObject; ANode: TfpgTreeNode);
+begin
+ if ANode.Count = 0 then
+ AddDirectories(ANode, GetAbsolutePath(ANode));
+end;
+
+{$IFDEF MSWINDOWS}
+procedure TfpgSelectDirDialog.AddWindowsDriveLetters;
+const
+ MAX_DRIVES = 25;
+var
+ n: integer;
+ drvs: string;
+begin
+ // making drive list, skipping drives A: and B:
+ n := 2;
+ while n <= MAX_DRIVES do
+ begin
+ drvs := chr(n + Ord('A')) + ':\';
+ if Windows.GetDriveType(PChar(drvs)) <> 1 then
+ TV.RootNode.AppendText(drvs);
+ Inc(n);
+ end;
+end;
+{$ENDIF}
+
+constructor TfpgSelectDirDialog.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FShowHidden := False;
+end;
+
procedure TfpgSelectDirDialog.AfterCreate;
begin
inherited AfterCreate;
@@ -185,14 +202,12 @@ begin
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(FSpacing, 28, 288, 300);
+ SetPosition(FSpacing, FSpacing, 288, 322);
+ OnExpand :=@NodeExpanded;
end;
// reposition buttons
@@ -205,6 +220,8 @@ begin
tv.TabOrder := 1;
btnOK.TabOrder := 2;
btnCancel.TabOrder := 3;
+
+ InitializeTreeview;
end;
function TfpgSelectDirDialog.SelectedDir: TfpgString;
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-29 13:08:15 +0000