paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 09:37:56 +02:00
Code Issues Packages Projects Releases Wiki Activity
main
lazarus/components/ideintf/componenttreeview.pas

927 lines
31 KiB
ObjectPascal
Raw Permalink Blame History

{
*****************************************************************************
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
Author: Mattias Gaertner
Abstract:
TComponentTreeView is a component to show the child components of a
TComponent. TControls are shown in a hierachic view.
It supports
- multi selecting components
- editing the creation order
- editing the TControl.Parent hierachy
For an usage example, see the object inspector.
}
unit ComponentTreeView;
{$mode objfpc}{$H+}
{off $DEFINE VerboseComponentTVWalker}
interface
uses
Classes, SysUtils, TypInfo, AVL_Tree,
// LazUtils
LazUtilities, LazLoggerBase, LazTracer, AvgLvlTree,
// LCL
Dialogs, Forms, Controls, ComCtrls,
// IdeIntf
ObjInspStrConsts, PropEdits, PropEditUtils, ComponentEditors, IDEImagesIntf;
type
TCTVGetImageIndexEvent = procedure(APersistent: TPersistent;
var AIndex: integer) of object;
TCTVParentAcceptsChildEvent = function(aParent, aChild, aLookupRoot: TPersistent): boolean of object;
TCTVSetParentEvent = procedure(aChild, aParent, aLookupRoot: TPersistent) of object;
// First 4 are ways to change ZOrder, zoDelete deletes a component.
TZOrderDelete = (zoToFront, zoToBack, zoForward, zoBackward, zoDelete);
{ TComponentTreeView }
TComponentTreeView = class(TCustomTreeView)
private
FComponentList: TBackupComponentList;
FOnParentAcceptsChild: TCTVParentAcceptsChildEvent;
FOnSetParent: TCTVSetParentEvent;
FPropertyEditorHook: TPropertyEditorHook;
// Map of Root component -> TAVLTree of collapsed components.
FRoot2CollapasedMap: TPointerToPointerTree;
FCollapsedComps: TAVLTree; // The current list of collapsed components.
FDrawWholeTree: Boolean;
FZOrderDelCommand: TZOrderDelete;
FPreviousDeleted: TPersistent; // Delete command can be called twice. Keep track.
// Events
FOnComponentGetImageIndex: TCTVGetImageIndexEvent;
FOnModified: TNotifyEvent;
function AddOrGetPersNode(AParentNode: TTreeNode; APers: TPersistent;
ACapt: String): TTreeNode;
procedure AddChildren(AComponent: TComponent; ARootNode: TTreeNode);
procedure ChangeNode(ANode: TTreeNode);
function FindAndChange(APers: TPersistent; AZOrderDel: TZOrderDelete): Boolean;
function GetRootObject: TPersistent;
function GetSelection: TPersistentSelectionList;
function IterateTree(ANode: TTreeNode; APers: TPersistent): TTreeNode;
procedure NodeCollapsed(Sender: TObject; Node: TTreeNode);
procedure NodeExpanded(Sender: TObject; Node: TTreeNode);
procedure RestoreExpand(ANode: TTreeNode);
procedure SetPropertyEditorHook(AValue: TPropertyEditorHook);
procedure SetSelection(NewSelection: TPersistentSelectionList);
procedure UpdateCompNode(ANode: TTreeNode);
procedure UpdateSelNode(ANode: TTreeNode);
procedure UpdateSelected;
protected
procedure DoSelectionChanged; override;
function GetImageFor(APersistent: TPersistent):integer;
procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
var Accept: Boolean); override;
procedure DragCanceled; override;
procedure MouseLeave; override;
procedure GetComponentInsertMarkAt(X, Y: Integer;
out AnInsertMarkNode: TTreeNode;
out AnInsertMarkType: TTreeViewInsertMarkType);
procedure DoModified;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure DragDrop(Source: TObject; X, Y: Integer); override;
procedure BuildComponentNodes(AWholeTree: Boolean);
procedure ChangeCompZOrder(APersistent: TPersistent; AZOrder: TZOrderDelete);
procedure DeleteComponentNode(APersistent: TPersistent);
procedure UpdateComponentNodesValues;
public
ImgIndexForm: Integer;
ImgIndexComponent: Integer;
ImgIndexControl: Integer;
ImgIndexBox: Integer;
ImgIndexCollection: Integer;
ImgIndexItem: Integer;
property Selection: TPersistentSelectionList read GetSelection
write SetSelection;
property HideSelection default false;
property PropertyEditorHook: TPropertyEditorHook
read FPropertyEditorHook write SetPropertyEditorHook;
property OnSelectionChanged;
property OnModified: TNotifyEvent read FOnModified write FOnModified;
property OnComponentGetImageIndex : TCTVGetImageIndexEvent
read FOnComponentGetImageIndex write FOnComponentGetImageIndex;
property OnParentAcceptsChild: TCTVParentAcceptsChildEvent read FOnParentAcceptsChild write FOnParentAcceptsChild;
property OnSetParent: TCTVSetParentEvent read FOnSetParent write FOnSetParent;
end;
implementation
{$R ../../images/componenttreeview.res}
type
TCollectionAccess = class(TCollection);
TComponentAccessor = class(TComponent);
{ TComponentWalker }
TComponentWalker = class
private
FCompTV: TComponentTreeView;
FLookupRoot: TComponent;
FNode: TTreeNode;
procedure AddCollection(AColl: TCollection; AParentNode: TTreeNode);
procedure AddOwnedPersistent(APers: TPersistent; const APropName: String;
AParentNode: TTreeNode);
procedure GetOwnedPersistents(APers: TPersistent; AParentNode: TTreeNode);
procedure Walk(AComponent: TComponent);
public
constructor Create(ACompTV: TComponentTreeView; ALookupRoot: TComponent);
end;
function CollectionCaption(ACollection: TCollection; DefaultName: string): string;
var
PropList: PPropList;
i, PropCount: Integer;
begin
Result := '';
if Result <> '' then
Result := TCollectionAccess(ACollection).PropName
else if DefaultName<>'' then
Result := DefaultName // DefaultName is the property name.
else if ACollection.Owner <> nil then
begin
PropCount := GetPropList(ACollection.Owner, PropList);
try // Find the property name where ACollection can be found.
for i := 0 to PropCount - 1 do
if (PropList^[i]^.PropType^.Kind = tkClass) then
if GetObjectProp(ACollection.Owner, PropList^[i], ACollection.ClassType) = ACollection then
begin
Result := PropList^[i]^.Name;
Break;
end;
finally
FreeMem(PropList);
end;
end;
if Result = '' then
Result := '<unknown collection>';
Result := Result + ': ' + ACollection.ClassName;
end;
function CollectionItemCaption(ACollItem: TCollectionItem): string;
begin
Result := IntToStr(ACollItem.Index)+' - '+ACollItem.DisplayName+': '+ACollItem.ClassName;
end;
function ComponentCaption(AComponent: TComponent): String;
begin
Result := AComponent.Name + ': ' + AComponent.ClassName;
end;
function CreateNodeCaption(APersistent: TPersistent; DefaultName: string): string;
begin
Result := APersistent.ClassName;
if APersistent is TComponent then
Result := ComponentCaption(TComponent(APersistent))
else if APersistent is TCollection then
Result := CollectionCaption(TCollection(APersistent), DefaultName)
else if APersistent is TCollectionItem then
Result := CollectionItemCaption(TCollectionItem(APersistent))
else if DefaultName<>'' then
Result := DefaultName + ':' + Result;
end;
{ TComponentWalker }
constructor TComponentWalker.Create(ACompTV: TComponentTreeView; ALookupRoot: TComponent);
begin
{$IFDEF VerboseComponentTVWalker}
DebugLn(['TComponentWalker.Create ALookupRoot=',DbgSName(ALookupRoot)]);
{$ENDIF}
FCompTV := ACompTV;
FLookupRoot := ALookupRoot;
end;
procedure TComponentWalker.AddCollection(AColl: TCollection; AParentNode: TTreeNode);
var
ItemNode: TTreeNode;
Item: TCollectionItem;
i: integer;
begin
for i := 0 to AColl.Count - 1 do
begin
Item := AColl.Items[i];
{$IFDEF VerboseComponentTVWalker}
DebugLn(['TComponentWalker.AddCollection, Adding CollectionItem ',
Item.DisplayName, ':', Item.ClassName]);
{$ENDIF}
ItemNode := FCompTV.AddOrGetPersNode(AParentNode, Item, CollectionItemCaption(Item));
// Collections can be nested. Add possible Collections under a CollectionItem.
GetOwnedPersistents(Item, ItemNode);
end;
end;
procedure TComponentWalker.AddOwnedPersistent(APers: TPersistent;
const APropName: String; AParentNode: TTreeNode);
var
TVNode: TTreeNode;
TheRoot: TPersistent;
begin
if (APers is TComponent) then
Assert(not (csDestroying in TComponent(APers).ComponentState), 'TComponentWalker: Comp is Destroying.');
TheRoot := GetLookupRootForComponent(APers);
{$IFDEF VerboseComponentTVWalker}
DebugLn(['TComponentWalker.AddOwnedPersistent'+
' PropName=',APropName,' Persistent=',DbgSName(APers),
' its root=',DbgSName(TheRoot),' FLookupRoot=',DbgSName(FLookupRoot)]);
{$ENDIF}
if TheRoot <> FLookupRoot then begin
DebugLn(['TComponentWalker.AddOwnedPersistent: TheRoot "', TheRoot, '" <> FLookupRoot "', FLookupRoot, '"']);
Exit;
end;
TVNode := FCompTV.AddOrGetPersNode(AParentNode, APers, CreateNodeCaption(APers, APropName));
if APers is TCollection then
AddCollection(TCollection(APers), TVNode);
end;
procedure TComponentWalker.GetOwnedPersistents(APers: TPersistent; AParentNode: TTreeNode);
var
PropList: PPropList;
PropCount, i: Integer;
PropInfo: PPropInfo;
PropPers: TPersistent;
begin
PropCount := GetPropList(APers, PropList);
try
for i := 0 to PropCount - 1 do begin
PropInfo:=PropList^[i];
if (PropInfo^.PropType^.Kind <> tkClass) then Continue;
{$IFDEF ShowOwnedObjectsOI}
PropPers := TPersistent(GetObjectProp(APers, PropInfo, TPersistent));
{$ELSE}
PropPers := TPersistent(GetObjectProp(APers, PropInfo, TCollection));
{$ENDIF}
if PropPers=nil then Continue;
if GetEditorClass(PropInfo, APers)=nil then Continue;
{$IFDEF VerboseComponentTVWalker}
DebugLn(['TComponentWalker.GetOwnedPersistents Persistent=',DbgSName(APers),
' PropName=',PropInfo^.Name,' FLookupRoot=',DbgSName(FLookupRoot)]);
{$ENDIF}
AddOwnedPersistent(PropPers, PropInfo^.Name, AParentNode);
end;
finally
FreeMem(PropList);
end;
end;
procedure TComponentWalker.Walk(AComponent: TComponent);
var
OldNode: TTreeNode;
Root: TComponent;
begin
if csDestroying in AComponent.ComponentState then begin
DebugLn(['TComponentWalker.Walk: ', AComponent, ' is Destroying.']);
Exit;
end;
if GetLookupRootForComponent(AComponent) <> FLookupRoot then begin
DebugLn(['TComponentWalker.Walk: "', AComponent, '" LookupRoot <> FLookupRoot "', FLookupRoot, '"']);
Exit;
end;
OldNode := FNode;
FNode := FCompTV.AddOrGetPersNode(FNode, AComponent, ComponentCaption(AComponent));
GetOwnedPersistents(AComponent, FNode);
if (csInline in AComponent.ComponentState) or (AComponent.Owner = nil) then
Root := AComponent
else
Root := AComponent.Owner;
if not ( (Root is TControl)
and (csOwnedChildrenNotSelectable in TControl(Root).ControlStyle) )
then
TComponentAccessor(AComponent).GetChildren(@Walk, Root);
FNode := OldNode;
end;
{ TComponentTreeView }
procedure TComponentTreeView.SetSelection(NewSelection: TPersistentSelectionList);
begin
if (PropertyEditorHook = nil) then
begin
if (FComponentList.LookupRoot = nil) then Exit;
FComponentList.Clear;
end
else if not NewSelection.ForceUpdate
and FComponentList.IsEqual(PropertyEditorHook.LookupRoot, NewSelection) then
begin
// nodes ok, but maybe node values need update
UpdateComponentNodesValues;
Exit;
end;
FComponentList.LookupRoot := PropertyEditorHook.LookupRoot;
FComponentList.Selection.Assign(NewSelection);
NewSelection.ForceUpdate:=false;
UpdateSelected;
end;
procedure TComponentTreeView.DoSelectionChanged;
var
ANode: TTreeNode;
APersistent: TPersistent;
NewSelection: TPersistentSelectionList;
begin
NewSelection := TPersistentSelectionList.Create;
try
if (PropertyEditorHook<>nil) and
(PropertyEditorHook.LookupRoot<>nil) and
(not (csDestroying in ComponentState)) then
begin
ANode := GetFirstMultiSelected;
while ANode <> nil do
begin
APersistent := TPersistent(ANode.Data);
if APersistent = nil then
RaiseGDBException('TComponentTreeView.DoSelectionChanged ANode.Data=nil');
if GetLookupRootForComponent(APersistent) = PropertyEditorHook.LookupRoot then
NewSelection.Add(APersistent);
ANode := ANode.GetNextMultiSelected;
end;
NewSelection.SortLike(FComponentList.Selection);
end;
if NewSelection.IsEqual(FComponentList.Selection) then
Exit;
FComponentList.Selection.Assign(NewSelection);
inherited DoSelectionChanged;
finally
NewSelection.Free;
end;
end;
procedure TComponentTreeView.DragDrop(Source: TObject; X, Y: Integer);
var
Node, ParentNode, SelNode: TTreeNode;
ACollection: TCollection;
AContainer, OldContainer: TWinControl;
AControl: TControl;
InsertType: TTreeViewInsertMarkType;
RootDesigner: TIDesigner;
CompEditDsg: TComponentEditorDesigner;
NewIndex, AIndex: Integer;
ok: Boolean;
ParentObj: TObject;
aLookupRoot, aParent, aChild: TPersistent;
begin
if PropertyEditorHook<>nil then
aLookupRoot := PropertyEditorHook.LookupRoot
else
aLookupRoot := nil;
GetComponentInsertMarkAt(X, Y, Node, InsertType);
SetInsertMark(nil, tvimNone);
if InsertType in [tvimAsNextSibling, tvimAsPrevSibling] then
ParentNode := Node.Parent
else
ParentNode := Node;
if Assigned(ParentNode) then
begin
// Find designer for Undo actions.
Assert(Assigned(FPropertyEditorHook), 'TComponentTreeView.DragDrop: PropertyEditorHook=Nil.');
RootDesigner := FindRootDesigner(FPropertyEditorHook.LookupRoot);
if (RootDesigner is TComponentEditorDesigner) then
CompEditDsg := TComponentEditorDesigner(RootDesigner) //if CompEditDsg.IsUndoLocked then Exit;
else
CompEditDsg := nil;
ParentObj:=TObject(ParentNode.Data);
if ParentObj is TWinControl then
begin
// reparent lcl TControl(s)
AContainer := TWinControl(ParentObj);
SelNode := GetFirstMultiSelected;
while Assigned(SelNode) do
begin
if TObject(SelNode.Data) is TControl then
begin
AControl := TControl(SelNode.Data);
ok:=false;
try
OldContainer := AControl.Parent;
AControl.Parent := AContainer;
if Assigned(CompEditDsg) then
CompEditDsg.AddUndoAction(AControl, uopChange, True, 'Parent',
OldContainer.Name, AContainer.Name);
ok:=true;
DoModified;
except
on E: Exception do
MessageDlg(oisError,
Format(oisUnableToChangeParentOfControlToNewParent,
[DbgSName(AControl), DbgSName(AContainer), LineEnding, E.Message]),
mtError, [mbOk], 0);
end;
if not ok then break;
end;
SelNode := SelNode.GetNextMultiSelected;
end;
end
else
if TObject(Node.Data) is TCollectionItem then
begin
// reorder collection item
ACollection := TCollectionItem(Node.Data).Collection;
ACollection.BeginUpdate;
case InsertType of
tvimAsNextSibling:
NewIndex := TCollectionItem(Node.Data).Index + 1;
tvimAsPrevSibling:
NewIndex := TCollectionItem(Node.Data).Index;
end;
SelNode := GetLastMultiSelected;
while Assigned(SelNode) do
begin
if (TObject(SelNode.Data) is TCollectionItem) and
(TCollectionItem(SelNode.Data).Collection = ACollection) then
begin
ok := False;
try
AIndex := TCollectionItem(SelNode.Data).Index;
if AIndex < NewIndex then
TCollectionItem(SelNode.Data).Index := NewIndex - 1
else
TCollectionItem(SelNode.Data).Index := NewIndex;
ok := True;
DoModified;
except
on E: Exception do
MessageDlg(E.Message, mtError, [mbOk], 0);
end;
if not ok then break;
end;
SelNode := SelNode.GetPrevMultiSelected;
end;
ACollection.EndUpdate;
end else if Assigned(OnSetParent) and (ParentObj is TPersistent) then begin
// default: reparent
aParent:=TPersistent(ParentObj);
SelNode := GetLastMultiSelected;
while Assigned(SelNode) do
begin
if (TObject(SelNode.Data) is TPersistent) then
begin
aChild:=TPersistent(TObject(SelNode.Data));
OnSetParent(aChild,aParent,aLookupRoot);
end;
SelNode := SelNode.GetPrevMultiSelected;
end;
end;
BuildComponentNodes(True);
end;
inherited DragDrop(Source, X, Y);
end;
procedure TComponentTreeView.DragOver(Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
var
Node: TTreeNode;
AnObject: TObject;
AControl: TControl absolute AnObject;
aLookupRoot, AContainer: TPersistent;
InsertType: TTreeViewInsertMarkType;
ParentNode: TTreeNode;
UserAccept: Boolean;
begin
//debugln('TComponentTreeView.DragOver START ',dbgs(Accept));
Accept:=false;
AContainer := nil;
GetComponentInsertMarkAt(X, Y, Node, InsertType);
SetInsertMark(Node, InsertType);
if PropertyEditorHook<>nil then
aLookupRoot := PropertyEditorHook.LookupRoot
else
aLookupRoot := nil;
// check new parent
ParentNode := Node;
if InsertType in [tvimAsNextSibling, tvimAsPrevSibling] then
ParentNode := ParentNode.Parent;
if Assigned(ParentNode) and Assigned(ParentNode.Data) then
begin
AnObject := TObject(ParentNode.Data);
if AnObject is TPersistent then
begin
AContainer:=TPersistent(AnObject);
end;
end;
//debugln(['TComponentTreeView.DragOver AContainer=',DbgSName(AContainer)]);
if AContainer<>nil then
begin
Node := GetFirstMultiSelected;
while Assigned(Node) do
begin
AnObject := TObject(Node.Data);
if Assigned(OnParentAcceptsChild) and (AnObject is TPersistent) then
begin
//debugln(['TComponentTreeView.DragOver Child=',DbgSName(AnObject),' AContainer=',DbgSName(AContainer)]);
if not OnParentAcceptsChild(AContainer,TPersistent(AnObject),aLookupRoot) then
break;
end else begin
// default rules for components:
// don't allow to move ancestor components
if (AnObject is TComponent) and
(csAncestor in TComponent(AnObject).ComponentState) then break;
if (AnObject is TControl) then
begin
if AnObject = AContainer then break;
if not (AContainer is TWinControl) then break;
//DebugLn(['TComponentTreeView.DragOver AControl=',DbgSName(AControl),' Parent=',DbgSName(AControl.Parent),' OldAccepts=',csAcceptsControls in AControl.Parent.ControlStyle]);
// check if new parent allows this control class
if not TWinControl(AContainer).CheckChildClassAllowed(AnObject.ClassType, False) then
break;
// check if one of the parents of the container is the control itself
if AControl.IsParentOf(TWinControl(AContainer)) then break;
// do not move children of a restricted parent to another parent
// e.g. TPage of TPageControl
if (AControl.Parent <> nil) and (AControl.Parent <> AContainer) and
(not (csAcceptsControls in AControl.Parent.ControlStyle)) then
break;
end;
end;
if (AnObject is TCollectionItem) then
begin
// allow to reorder collection items
if AnObject = AContainer then break;
if not (AContainer is TCollection) then
break;
if TCollectionItem(AnObject).Collection <> TCollection(AContainer) then
break;
end;
Node := Node.GetNextMultiSelected;
end;
Accept := (Node = nil);
end;
//debugln('TComponentTreeView.DragOver A ',dbgs(Accept));
UserAccept:=Accept;
inherited DragOver(Source, X, Y, State, UserAccept);
if Assigned(OnDragOver) then
Accept:=UserAccept;
//debugln('TComponentTreeView.DragOver B ',dbgs(Accept));
end;
procedure TComponentTreeView.DragCanceled;
begin
SetInsertMark(nil, tvimNone);
inherited DragCanceled;
end;
procedure TComponentTreeView.MouseLeave;
begin
SetInsertMark(nil,tvimNone);
inherited MouseLeave;
end;
procedure TComponentTreeView.GetComponentInsertMarkAt(X, Y: Integer; out
AnInsertMarkNode: TTreeNode; out AnInsertMarkType: TTreeViewInsertMarkType);
var
Node: TTreeNode;
begin
Node := GetFirstMultiSelected;
if (Node <> nil) and (TObject(Node.Data) is TControl) then
begin
// TWinControl allows only to add/remove children, but not at a specific position
AnInsertMarkNode := GetNodeAt(X,Y);
AnInsertMarkType := tvimAsFirstChild;
end
else
begin
GetInsertMarkAt(X, Y, AnInsertMarkNode, AnInsertMarkType);
if (Node <> nil) and (TObject(Node.Data) is TCollectionItem) then
if AnInsertMarkType = tvimAsFirstChild then
AnInsertMarkType := tvimAsPrevSibling;
end;
end;
procedure TComponentTreeView.DoModified;
begin
if Assigned(PropertyEditorHook) then
PropertyEditorHook.RefreshPropertyValues;
if Assigned(FOnModified) then
OnModified(Self);
end;
function TComponentTreeView.GetImageFor(APersistent: TPersistent): integer;
begin
Result := -1;
if Assigned(APersistent) then
begin
if (APersistent is TControl) then begin
if (csAcceptsControls in TControl(APersistent).ControlStyle) then
Result := ImgIndexBox
else
Result := ImgIndexControl;
end
else
if (APersistent is TComponent) then
Result := ImgIndexComponent
else
if (APersistent is TCollection) then
Result := ImgIndexCollection
else
if (APersistent is TCollectionItem) then
Result := ImgIndexItem;
end;
// finally, ask the designer such as TDesignerMediator to override it, if any
if Assigned(OnComponentGetImageIndex) then
OnComponentGetImageIndex(APersistent, Result);
end;
procedure TComponentTreeView.SetPropertyEditorHook(AValue: TPropertyEditorHook);
begin
if FPropertyEditorHook=AValue then exit;
FPropertyEditorHook:=AValue;
end;
function TComponentTreeView.GetSelection: TPersistentSelectionList;
begin
Result:=FComponentList.Selection;
end;
constructor TComponentTreeView.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
DragMode := dmAutomatic;
FComponentList:=TBackupComponentList.Create;
FRoot2CollapasedMap:=TPointerToPointerTree.Create;
Options := Options + [tvoAllowMultiselect, tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly];
MultiSelectStyle := MultiSelectStyle + [msShiftSelect];
ImgIndexForm := IDEImages.GetImageIndex('oi_form');
ImgIndexComponent := IDEImages.GetImageIndex('oi_comp');
ImgIndexControl := IDEImages.GetImageIndex('oi_control');
ImgIndexBox := IDEImages.GetImageIndex('oi_box');
ImgIndexCollection := IDEImages.GetImageIndex('oi_collection');
ImgIndexItem := IDEImages.GetImageIndex('oi_item');
Images := IDEImages.Images_16;
HideSelection := false;
end;
destructor TComponentTreeView.Destroy;
var
Enumer: TPointerToPointerEnumerator;
begin
Enumer := FRoot2CollapasedMap.GetEnumerator;
while Enumer.MoveNext do
FreeAndNil(TObject(Enumer.Current^.Value)); // Free the CollapsedComp TAVLTrees.
Enumer.Free;
FreeThenNil(FRoot2CollapasedMap);
FreeThenNil(FComponentList);
inherited Destroy;
end;
procedure TComponentTreeView.NodeCollapsed(Sender: TObject; Node: TTreeNode);
begin
Assert(Assigned(FCollapsedComps), 'TComponentTreeView.NodeCollapsed: FCollapsedComps=Nil.');
FCollapsedComps.Add(Node.Data);
end;
procedure TComponentTreeView.NodeExpanded(Sender: TObject; Node: TTreeNode);
begin
Assert(Assigned(FCollapsedComps), 'TComponentTreeView.NodeExpanded: FCollapsedComps=Nil.');
if not FCollapsedComps.Remove(Node.Data) then
DebugLn(['TComponentTreeView.NodeExpanded: Removing node ', TPersistent(Node.Data), ' failed.']);
end;
function TComponentTreeView.AddOrGetPersNode(AParentNode: TTreeNode;
APers: TPersistent; ACapt: String): TTreeNode;
var
xNode: TTreeNode;
begin
if not FDrawWholeTree then
begin
if AParentNode = nil then
Exit(Items.GetFirstNode); // Return existing root node.
// Search for an existing valid node.
xNode := AParentNode.GetFirstChild;
while (xNode<>nil) and (TObject(xNode.Data)<>APers) do
xNode := xNode.GetNextSibling;
if Assigned(xNode) then
Exit(xNode); // Return existing node if there is one.
end;
// Add a new node and set its properties.
Result := Items.AddChildObject(AParentNode, ACapt, APers);
if AParentNode = nil then
Result.ImageIndex := ImgIndexForm
else
Result.ImageIndex := GetImageFor(APers);
Result.SelectedIndex := Result.ImageIndex;
Result.MultiSelected := Selection.IndexOf(APers) >= 0;
end;
procedure TComponentTreeView.AddChildren(AComponent: TComponent; ARootNode: TTreeNode);
var
Walker: TComponentWalker;
begin
if csDestroying in AComponent.ComponentState then exit;
Walker := TComponentWalker.Create(Self, AComponent);
Walker.FNode := ARootNode;
try // add inline components children
TComponentAccessor(AComponent).GetChildren(@Walker.Walk, AComponent);
finally
Walker.Free;
end;
end;
function TComponentTreeView.GetRootObject: TPersistent;
// Get root object / component
begin
if PropertyEditorHook = nil then Exit(nil);
Result := PropertyEditorHook.LookupRoot;
if (Result is TComponent) and (csDestroying in TComponent(Result).ComponentState) then
Result := nil;
end;
procedure TComponentTreeView.BuildComponentNodes(AWholeTree: Boolean);
// Add all components to the tree.
// AWholeTree=True means clearing and refilling all,
// False means existing tree is used and only missing components are added.
var
RootObject: TPersistent;
RootNode: TTreeNode;
begin
OnCollapsed:=nil; // Don't handle these events while the tree builds.
OnExpanded:=nil;
BeginUpdate;
RootObject := GetRootObject;
if AWholeTree then
Items.Clear;
if RootObject <> nil then
begin
//DebugLn(['TComponentTreeView.BuildComponentNodes: RootObj=', RootObject, ', AWholeTree=', AWholeTree]);
FDrawWholeTree := AWholeTree;
// first add the lookup root
RootNode := AddOrGetPersNode(nil, RootObject, CreateNodeCaption(RootObject,''));
// add components in creation order and TControl.Parent relationship
if RootObject is TComponent then
AddChildren(TComponent(RootObject), RootNode);
if AWholeTree then
begin
// Get the right list of collapsed nodes based on LookupRoot
FCollapsedComps := TAVLTree(FRoot2CollapasedMap[RootObject]);
if FCollapsedComps = nil then
begin
FCollapsedComps := TAVLTree.Create;
FRoot2CollapasedMap[RootObject] := FCollapsedComps;
end;
end;
RestoreExpand(RootNode); // then restore the Expanded/Collapsed state.
MakeSelectionVisible;
end;
EndUpdate;
OnCollapsed:=@NodeCollapsed;
OnExpanded:=@NodeExpanded;
end;
procedure TComponentTreeView.RestoreExpand(ANode: TTreeNode);
// Restore Expanded/Collapsed state based on user's choice from last time.
begin
ANode.Expanded := FCollapsedComps.Find(ANode.Data) = Nil; // Nil means a user
ANode := ANode.GetFirstChild; // did not collapse the node last time.
while ANode<>nil do begin
RestoreExpand(ANode); // Recursive call.
ANode := ANode.GetNextSibling;
end;
end;
procedure TComponentTreeView.ChangeNode(ANode: TTreeNode);
// Change ZOrder of the given node or delete it.
var
Neighbor: TTreeNode;
begin
case FZOrderDelCommand of
zoToFront: begin // Front means the last sibling.
Neighbor := ANode.GetLastSibling;
if Assigned(Neighbor) then
ANode.MoveTo(Neighbor, naInsertBehind);
end;
zoToBack: begin // Back means the first sibling.
Neighbor := ANode.GetFirstSibling;
if Assigned(Neighbor) then
ANode.MoveTo(Neighbor, naInsert);
end;
zoForward: begin // Towards the end.
Neighbor := ANode.GetNextSibling;
if Assigned(Neighbor) then
ANode.MoveTo(Neighbor, naInsertBehind);
end;
zoBackward: begin // Towards the beginning.
Neighbor := ANode.GetPrevSibling;
if Assigned(Neighbor) then
ANode.MoveTo(Neighbor, naInsert);
end;
zoDelete: ANode.Delete; // Delete the node
end;
end;
function TComponentTreeView.IterateTree(ANode: TTreeNode; APers: TPersistent): TTreeNode;
// Returns the node that was changed.
begin
Result := Nil;
if TObject(ANode.Data)=APers then
begin
ChangeNode(ANode);
Exit(ANode); // Found and changed.
end;
// Iterate subnodes.
ANode := ANode.GetFirstChild;
while Assigned(ANode) and (Result=Nil) do
begin
Result := IterateTree(ANode, APers); // Recursive call.
ANode := ANode.GetNextSibling;
end;
end;
function TComponentTreeView.FindAndChange(APers: TPersistent;
AZOrderDel: TZOrderDelete): Boolean;
// APers is Component to be moved or deleted based on AZOrderDel value.
var
ChangedNode: TTreeNode;
begin
// Search for a node to change.
Assert(Assigned(APers), 'TComponentTreeView.FindAndChangeItem: APers=Nil.');
Assert(Items.GetFirstNode.GetNextSibling=Nil,
'TComponentTreeView.FindAndChange: Top node has siblings.');
FZOrderDelCommand := AZOrderDel;
ChangedNode := IterateTree(Items.GetFirstNode, APers);
Result := Assigned(ChangedNode);
end;
procedure TComponentTreeView.ChangeCompZOrder(APersistent: TPersistent;
AZOrder: TZOrderDelete);
begin
if not FindAndChange(APersistent, AZOrder) then
DebugLn(['TComponentTreeView.ChangeCompZOrder failed.']);
end;
procedure TComponentTreeView.DeleteComponentNode(APersistent: TPersistent);
begin
if FPreviousDeleted = APersistent then
FPreviousDeleted := Nil // Don't try to delete the same component twice.
else begin
FPreviousDeleted := APersistent;
//FindAndChange(APersistent, zoDelete); // Does not work with CollectionItems.
// Now rebuild the tree. ToDo: use TCollectionObserver, IFPObserver interface.
BuildComponentNodes(True);
end;
end;
procedure TComponentTreeView.UpdateCompNode(ANode: TTreeNode);
var
APersistent: TPersistent;
begin
if ANode = nil then Exit;
APersistent := TPersistent(ANode.Data);
if APersistent is TComponent then
ANode.Text := ComponentCaption(TComponent(APersistent))
else if APersistent is TCollectionItem then
ANode.Text := CollectionItemCaption(TCollectionItem(APersistent));
// Note: Collection name does not change, don't update.
UpdateCompNode(ANode.GetFirstChild); // Recursive call.
UpdateCompNode(ANode.GetNextSibling);
end;
procedure TComponentTreeView.UpdateComponentNodesValues;
// Could be optimised by adding a PropName parameter and searching a node by name.
begin
BeginUpdate;
UpdateCompNode(Items.GetFirstNode);
EndUpdate;
end;
procedure TComponentTreeView.UpdateSelNode(ANode: TTreeNode);
var
APersistent: TPersistent;
begin
if ANode = nil then Exit;
APersistent := TPersistent(ANode.Data);
ANode.MultiSelected := Selection.IndexOf(APersistent) >= 0;
UpdateSelNode(ANode.GetFirstChild); // Recursive call.
UpdateSelNode(ANode.GetNextSibling);
end;
procedure TComponentTreeView.UpdateSelected;
begin
BeginUpdate;
Selected := Nil;
UpdateSelNode(Items.GetFirstNode);
EndUpdate;
end;
end.
Reference in New Issue View Git Blame Copy Permalink