paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-12 16:09:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

Merged revision(s) 65355 #8b6e1655ea, 65362 #6271182f5d, 65366 #89b30a58de, 65454-65455 #ee25f78baf-#ee25f78baf from trunk:

Browse Source 
LCL/TPageControl: Add new method "Clear" to remove all pages.
........
docs/lcl: Add documentation for the new method TPageControl.Clear.
........
docs/lcl: Merge the two TPageControl.Clear doc versions from r65362 #6271182f5d and 65358.
........
LCL/ShellTreeView: Speed-up of populating a folder with many subfolders (example: c:\Windows\WinSxS)
........
LCL/ShellTreeView: Speedup when opening a node with many subfolders a second time.
........

git-svn-id: branches/fixes_2_2@65458 -
This commit is contained in:
maxim 2021-07-15 21:05:08 +00:00
parent 141212d457
commit 01cacbd6d1
5 changed files with 125 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
docs/xml/lcl/comctrls.xml
View File

@ -3549,6 +3549,23 @@
<element name="TPageControl.FPageToUndock"/>
<element name="TPageControl.Clear">
<short>
Clears the list of tab names of the control, and causes the associated tab sheets or pages to be freed.
</short>
<descr>
<p>
By calling the <var>Clear</var> method of the protected <var>Tabs</var> property in the <var>TCustomTabControl</var> ancestor, this method removes all tab sheets from the PageControl. The <var>TPageControl.PageCount</var> is <var>0</var> afterwards.
</p>
<p>
Note, however, that the controls on the tab sheets are only destroyed when their <var>Owner</var> is one of the tabsheets. Otherwise they still exist on the form, but their <var>Parent</var> has been set to <var>nil</var>.
</p>
</descr>
<seealso>
<link id="TCustomTabControl.Tabs"/>
</seealso>
</element>
<element name="TPageControl.GetActivePageIndex">
<short>Gets the value for the ActivePageIndex property.</short>
<descr/>
@ -3691,20 +3708,6 @@
<short/>
</element>
<element name="TPageControl.Clear">
<short>
Clears the list of tab names for the control, and causes the associated tab sheets or pages to be freed.
</short>
<descr>
<p>
Calls the Clear method for the protected Tabs property in the TCustomTabControl ancestor.
</p>
</descr>
<seealso>
<link id="TCustomTabControl.Tabs"/>
</seealso>
</element>
<element name="TPageControl.FindNextPage">
<short>
<var>FindNextPage</var> - returns the next page (<var>TTabSheet</var>) in the sequence.
@ -5325,7 +5328,7 @@
<seealso/>
</element>
<element name="TTabControl.RowCount.Result">
<short></short>
<short/>
</element>
<element name="TTabControl.ScrollTabs">
@ -7206,7 +7209,7 @@
</element>
<element name="TSortIndicator">
<short></short>
<short/>
<descr>
<p>
<var>TSortIndicator</var> is an enumerated type with values that represent the sort indicators available in the <var>TListColumn</var> class. TSortIndicator is the type used to implement the <var>SortIndicator</var> property in <var>TListColumn</var>.
@ -14425,7 +14428,7 @@ AToolbar.ButtonHeight := 30;
Indent is used in the <var>AdjustClientRect</var> method to increment the left edge of the display area for tool buttons on the control.
</p>
</descr>
<seealso></seealso>
<seealso/>
</element>
<element name="TToolBar.List">
@ -14446,7 +14449,7 @@ AToolbar.ButtonHeight := 30;
Set <var>ShowCaptions</var> to <b>True</b> to enable Caption text on the tool bar buttons.
</p>
</descr>
<seealso></seealso>
<seealso/>
</element>
<element name="TToolBar.ParentColor" link="#lcl.controls.TControl.ParentColor"/>
@ -21098,16 +21101,16 @@ AToolbar.ButtonHeight := 30;
</element>
<element name="TCustomTreeView.TripleClick" link="#lcl.controls.TControl.TripleClick">
<short></short>
<descr></descr>
<short/>
<descr/>
<seealso>
<link id="#lcl.controls.TControl.TripleClick">TControl.TripleClick</link>
</seealso>
</element>
<element name="TCustomTreeView.QuadClick" link="#lcl.controls.TControl.QuadClick">
<short></short>
<descr></descr>
<short/>
<descr/>
<seealso>
<link id="#lcl.controls.TControl.QuadClick">TControl.QuadClick</link>
</seealso>
@ -23627,7 +23630,7 @@ OldExpanded.Free;
</seealso>
</element>
<element name="THeaderSection.Assign.Source">
<short></short>
<short/>
</element>
<element name="THeaderSection.Left">
@ -23884,16 +23887,16 @@ OldExpanded.Free;
</short>
</element>
<element name="TCustomSectionTrackEvent.HeaderControl">
<short></short>
<short/>
</element>
<element name="TCustomSectionTrackEvent.Section">
<short></short>
<short/>
</element>
<element name="TCustomSectionTrackEvent.Width">
<short></short>
<short/>
</element>
<element name="TCustomSectionTrackEvent.State">
<short></short>
<short/>
</element>
<element name="TSectionDragEvent">
@ -24593,7 +24596,8 @@ OldExpanded.Free;
<p>
Register is a procedure used to register components in the <file>comctrls.pp</file> unit in the Lazarus IDE. Register adds the following components:
</p>
<p><b>Common Controls Tab</b></p>
<p><b>Common Controls Tab</b>
</p>
<ul>
<li>TTrackbar</li>
<li>TProgressBar</li>

13
lcl/comctrls.pp
View File

@ -589,6 +589,7 @@ type
function DoUndockClientMsg(NewTarget, Client: TControl):boolean; override;
function ChildClassAllowed(ChildClass: TClass): boolean; override;
public
procedure Clear;
function FindNextPage(CurPage: TTabSheet;
GoForward, CheckTabVisible: Boolean): TTabSheet;
procedure SelectNextPage(GoForward: Boolean);
@ -2844,7 +2845,8 @@ type
nsHasChildren, // = Node.HasChildren
nsDeleting, // = Node.Deleting, set on Destroy
nsVisible, // = Node.Visible
nsBound // bound to a tree, e.g. has Parent or is top lvl node
nsBound, // bound to a tree, e.g. has Parent or is top lvl node
nsValidHasChildren// Node.HasChildren has been assigned
);
TNodeStates = set of TNodeState;
@ -2918,6 +2920,8 @@ type
var ATreeNode: TTreenode) of object;
TTVCreateNodeClassEvent = procedure(Sender: TCustomTreeView;
var NodeClass: TTreeNodeClass) of object;
TTVHasChildrenEvent = function(Sender: TCustomTreeView;
ANode: TTreeNode): Boolean of object;
TTreeNodeCompare = function(Node1, Node2: TTreeNode): integer of object;
@ -2991,12 +2995,12 @@ type
procedure ExpandItem(ExpandIt, Recurse: Boolean);
function GetAbsoluteIndex: Integer;
function GetDeleting: Boolean;
function GetHasChildren: Boolean;
function GetCount: Integer;
function GetCut: boolean;
function GetDropTarget: Boolean;
function GetExpanded: Boolean;
function GetFocused: Boolean;
function GetHasChildren: Boolean;
function GetHeight: integer;
function GetIndex: Integer;
function GetItems(AnIndex: Integer): TTreeNode;
@ -3378,6 +3382,7 @@ type
FOnExpanding: TTVExpandingEvent;
FOnGetImageIndex: TTVExpandedEvent;
FOnGetSelectedIndex: TTVExpandedEvent;
FOnHasChildren: TTVHasChildrenEvent;
FOnNodeChanged: TTVNodeChangedEvent;
FOnSelectionChanged: TNotifyEvent;
FOptions: TTreeViewOptions;
@ -3564,6 +3569,7 @@ type
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
procedure MouseLeave; override;
procedure NodeChanged(Node: TTreeNode; ChangeReason: TTreeNodeChangeReason); virtual;
function NodeHasChildren(Node: TTreeNode): Boolean; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Paint; override;
procedure ScrollView(DeltaX, DeltaY: Integer);
@ -3623,6 +3629,8 @@ type
read FOnGetImageIndex write FOnGetImageIndex;
property OnGetSelectedIndex: TTVExpandedEvent
read FOnGetSelectedIndex write FOnGetSelectedIndex;
property OnHasChildren: TTVHasChildrenEvent
read FOnHasChildren write FOnHasChildren;
property OnNodeChanged: TTVNodeChangedEvent read FOnNodeChanged write FOnNodeChanged;
property OnSelectionChanged: TNotifyEvent
read FOnSelectionChanged write FOnSelectionChanged;
@ -3806,6 +3814,7 @@ type
property OnExpanding;
property OnGetImageIndex;
property OnGetSelectedIndex;
property OnHasChildren;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;

4
lcl/include/pagecontrol.inc
View File

@ -193,5 +193,9 @@ begin
Result.PageControl := Self;
end;
procedure TPageControl.Clear;
begin
Tabs.Clear;
end;
// included by comctrls.pp

19
lcl/include/treeview.inc
View File

@ -854,6 +854,14 @@ end;
function TTreeNode.GetHasChildren: Boolean;
begin
if not GetState(nsValidHasChildren) then
begin
if Owner.Owner.NodeHasChildren(Self) then
Include(FStates, nsHasChildren)
else
Exclude(FStates, nsHasChildren);
Include(FStates, nsValidHasChildren);
end;
Result := GetState(nsHasChildren);
end;
@ -895,7 +903,7 @@ end;
procedure TTreeNode.SetHasChildren(AValue: Boolean);
begin
if AValue=HasChildren then exit;
if GetState(nsValidHasChildren) and (AValue=HasChildren) then exit;
//DebugLn('[TTreeNode.SetHasChildren] Self=',DbgS(Self),' Self.Text=',Text,' AValue=',AValue);
if AValue then
Include(FStates,nsHasChildren)
@ -904,6 +912,7 @@ begin
GetLastChild.Free;
Exclude(FStates,nsHasChildren)
end;
Include(FStates, nsValidHasChildren);
Update;
end;
@ -5943,6 +5952,14 @@ begin
OnNodeChanged(self,Node,ChangeReason);
end;
function TCustomTreeView.NodeHasChildren(Node: TTreeNode): Boolean;
begin
if Assigned(FOnHasChildren) then
Result := FOnHasChildren(Self, Node)
else
Result := false;
end;
procedure TCustomTreeView.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited Notification(AComponent, Operation);

101
lcl/shellctrls.pas
View File

@ -87,6 +87,7 @@ type
function CanExpand(Node: TTreeNode): Boolean; override;
function DrawBuiltInIcon(ANode: TTreeNode; ARect: TRect): TSize; override;
function GetBuiltinIconSize: TSize; override;
function NodeHasChildren(Node: TTreeNode): Boolean; override;
public
{ Basic methods }
constructor Create(AOwner: TComponent); override;
@ -176,6 +177,7 @@ type
property OnExpanding;
property OnGetImageIndex;
property OnGetSelectedIndex;
property OnHasChildren;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
@ -615,9 +617,14 @@ begin
if not Result then exit;
OldAutoExpand:=AutoExpand;
AutoExpand:=False;
Node.DeleteChildren;
Result := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node));
AutoExpand:=OldAutoExpand;
BeginUpdate;
try
Node.DeleteChildren;
Result := PopulateTreeNodeWithFiles(Node, GetPathFromNode(Node));
AutoExpand:=OldAutoExpand;
finally
EndUpdate;
end;
end;
constructor TCustomShellTreeView.Create(AOwner: TComponent);
@ -829,6 +836,54 @@ begin
Result := IncludeTrailingPathDelimiter(Result);
end;
function TCustomShellTreeView.NodeHasChildren(Node: TTreeNode): Boolean;
function HasSubDir(Const ADir: String): Boolean;
var
SR: TSearchRec;
FindRes: LongInt;
Attr: Longint;
IsHidden: Boolean;
begin
Result:=False;
try
Attr := faDirectory;
if (otHidden in fObjectTypes) then Attr := Attr or faHidden{%H-};
FindRes := FindFirstUTF8(AppendPathDelim(ADir) + AllFilesMask, Attr , SR);
while (FindRes = 0) do
begin
if ((SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and
(SR.Name <> '..')) then
begin
IsHidden := ((Attr and faHidden{%H-}) > 0);
if not (IsHidden and (not ((otHidden in fObjectTypes)))) then
begin
Result := True;
Break;
end;
end;
FindRes := FindNextUtf8(SR);
end;
finally
FindCloseUTF8(SR);
end; //try
end;
var
NodePath: String;
begin
if Assigned(OnHasChildren) then
Result := OnHasChildren(Self, Node)
else
begin
NodePath := GetPathFromNode(Node);
if (fObjectTypes * [otNonFolders] = []) then
Result := TShellTreeNode(Node).IsDirectory and HasSubDir(NodePath)
else
Result := TShellTreeNode(Node).IsDirectory;
end;
end;
{ Returns true if at least one item was added, false otherwise }
function TCustomShellTreeView.PopulateTreeNodeWithFiles(
ANode: TTreeNode; ANodePath: string): Boolean;
@ -837,38 +892,6 @@ var
Files: TStringList;
NewNode: TTreeNode;
CanAdd: Boolean;
function HasSubDir(Const ADir: String): Boolean;
var
SR: TSearchRec;
FindRes: LongInt;
Attr: Longint;
IsHidden: Boolean;
begin
Result:=False;
try
Attr := faDirectory;
if (otHidden in fObjectTypes) then Attr := Attr or faHidden{%H-};
FindRes := FindFirstUTF8(AppendPathDelim(ADir) + AllFilesMask, Attr , SR);
while (FindRes = 0) do
begin
if ((SR.Attr and faDirectory <> 0) and (SR.Name <> '.') and
(SR.Name <> '..')) then
begin
IsHidden := ((Attr and faHidden{%H-}) > 0);
if not (IsHidden and (not ((otHidden in fObjectTypes)))) then
begin
Result := True;
Break;
end;
end;
FindRes := FindNextUtf8(SR);
end;
finally
FindCloseUTF8(SR);
end; //try
end;
begin
Result := False;
// avoids crashes in the IDE by not populating during design
@ -890,12 +913,8 @@ begin
NewNode := Items.AddChildObject(ANode, Files[i], nil);
TShellTreeNode(NewNode).FFileInfo := TFileItem(Files.Objects[i]).FileInfo;
TShellTreeNode(NewNode).SetBasePath(TFileItem(Files.Objects[i]).FBasePath);
if (fObjectTypes * [otNonFolders] = []) then
NewNode.HasChildren := (TShellTreeNode(NewNode).IsDirectory and
HasSubDir(AppendpathDelim(ANodePath)+Files[i]))
else
NewNode.HasChildren := TShellTreeNode(NewNode).IsDirectory;
// NewNode.HasChildren will be set later when needed to avoid opening
// all subdirectories (--> NodeHasChildren).
end;
end;
finally