1 {
2 *****************************************************************************
3 See the file COPYING.modifiedLGPL.txt, included in this distribution,
4 for details about the license.
5 *****************************************************************************
6
7 Author: Mattias Gaertner
8
9 Abstract:
10 TComponentTreeView is a component to show the child components of a
11 TComponent. TControls are shown in a hierachic view.
12 It supports
13 - multi selecting components
14 - editing the creation order
15 - editing the TControl.Parent hierachy
16 For an usage example, see the object inspector.
17 }
18 unit ComponentTreeView;
19
20 {$mode objfpc}{$H+}
21
22 {off $DEFINE VerboseComponentTVWalker}
23
24 interface
25
26 uses
27 Classes, SysUtils, TypInfo, Laz_AVL_Tree,
28 // LazUtils
29 LazLoggerBase,
30 // LCL
31 LCLProc, Dialogs, Forms, Controls, ComCtrls, Graphics,
32 // IdeIntf
33 ObjInspStrConsts, PropEdits, PropEditUtils, ComponentEditors, IDEImagesIntf;
34
35 type
36 TCTVGetImageIndexEvent = procedure(APersistent: TPersistent;
37 var AIndex: integer) of object;
38
39 { TComponentTreeView }
40
41 TComponentTreeView = class(TCustomTreeView)
42 private
43 FComponentList: TBackupComponentList;
44 FOnComponentGetImageIndex: TCTVGetImageIndexEvent;
45 FOnModified: TNotifyEvent;
46 FPropertyEditorHook: TPropertyEditorHook;
CollectionCaptionnull47 function CollectionCaption(ACollection: TCollection; DefaultName: string): string;
CollectionItemCaptionnull48 function CollectionItemCaption(ACollItem: TCollectionItem): string;
ComponentCaptionnull49 function ComponentCaption(AComponent: TComponent): String;
GetSelectionnull50 function GetSelection: TPersistentSelectionList;
51 procedure SetPropertyEditorHook(AValue: TPropertyEditorHook);
52 procedure SetSelection(NewSelection: TPersistentSelectionList);
53 procedure UpdateSelected;
CreateNodeCaptionnull54 function CreateNodeCaption(APersistent: TPersistent; DefaultName: string = ''): string;
55 protected
56 procedure DoSelectionChanged; override;
GetImageFornull57 function GetImageFor(APersistent: TPersistent):integer;
58 procedure DragOver(Source: TObject; X, Y: Integer; State: TDragState;
59 var Accept: Boolean); override;
60 procedure DragCanceled; override;
61 procedure MouseLeave; override;
62 procedure GetComponentInsertMarkAt(X, Y: Integer;
63 out AnInsertMarkNode: TTreeNode;
64 out AnInsertMarkType: TTreeViewInsertMarkType);
65 procedure DoModified;
66 public
67 constructor Create(TheOwner: TComponent); override;
68 destructor Destroy; override;
69 procedure DragDrop(Source: TObject; X, Y: Integer); override;
70 procedure RebuildComponentNodes; virtual;
71 procedure UpdateComponentNodesValues; virtual;
72 public
73 ImgIndexForm: Integer;
74 ImgIndexComponent: Integer;
75 ImgIndexControl: Integer;
76 ImgIndexBox: Integer;
77 ImgIndexCollection: Integer;
78 ImgIndexItem: Integer;
79 property Selection: TPersistentSelectionList read GetSelection
80 write SetSelection;
81 property PropertyEditorHook: TPropertyEditorHook
82 read FPropertyEditorHook write SetPropertyEditorHook;
83 property OnSelectionChanged;
84 property OnModified: TNotifyEvent read FOnModified write FOnModified;
85 property OnComponentGetImageIndex : TCTVGetImageIndexEvent
86 read FOnComponentGetImageIndex write FOnComponentGetImageIndex;
87 end;
88
89 implementation
90
91 {$R ../../images/componenttreeview.res}
92
93 type
94 TCollectionAccess = class(TCollection);
95
96 TComponentCandidate = class
97 public
98 APersistent: TPersistent;
99 Parent: TComponent;
100 Added: boolean;
101 end;
102
103 { TComponentWalker }
104
105 TComponentWalker = class
106 private
107 FComponentTV: TComponentTreeView;
108 FCandidates: TAvlTree;
109 FLookupRoot: TComponent;
110 FNode: TTreeNode;
111 procedure AddCollection(AColl: TCollection; AParentNode: TTreeNode);
112 procedure AddOwnedPersistent(APers: TPersistent; APropName: String;
113 AParentNode: TTreeNode);
114 procedure GetOwnedPersistents(APers: TPersistent; AParentNode: TTreeNode);
PersistentFoundInNodenull115 function PersistentFoundInNode(APers: TPersistent): Boolean;
116 procedure Walk(AComponent: TComponent);
117 public
118 constructor Create(
119 ATreeView: TComponentTreeView; ACandidates: TAvlTree;
120 ALookupRoot: TComponent; ANode: TTreeNode);
121 end;
122
123 TComponentAccessor = class(TComponent);
124
CompareComponentCandidatesnull125 function CompareComponentCandidates(
126 Candidate1, Candidate2: TComponentCandidate): integer;
127 begin
128 Result := ComparePointers(Candidate1.APersistent, Candidate2.APersistent);
129 end;
130
ComparePersistentWithComponentCandidatenull131 function ComparePersistentWithComponentCandidate(
132 APersistent: TPersistent; Candidate: TComponentCandidate): integer;
133 begin
134 Result := ComparePointers(APersistent, Candidate.APersistent);
135 end;
136
137 { TComponentWalker }
138
139 constructor TComponentWalker.Create(ATreeView: TComponentTreeView;
140 ACandidates: TAvlTree; ALookupRoot: TComponent; ANode: TTreeNode);
141 begin
142 {$IFDEF VerboseComponentTVWalker}
143 DebugLn(['TComponentWalker.Create ALookupRoot=',DbgSName(ALookupRoot)]);
144 {$ENDIF}
145 FComponentTV := ATreeView;
146 FCandidates := ACandidates;
147 FLookupRoot := ALookupRoot;
148 FNode := ANode;
149 end;
150
151 procedure TComponentWalker.AddCollection(AColl: TCollection; AParentNode: TTreeNode);
152 var
153 ItemNode: TTreeNode;
154 Item: TCollectionItem;
155 i: integer;
156 begin
157 for i := 0 to AColl.Count - 1 do
158 begin
159 Item := AColl.Items[i];
160 {$IFDEF VerboseComponentTVWalker}
161 DebugLn(['TComponentWalker.AddCollection, Adding CollectionItem ',
162 Item.DisplayName, ':', Item.ClassName]);
163 {$ENDIF}
164 ItemNode := FComponentTV.Items.AddChild(AParentNode,
165 FComponentTV.CollectionItemCaption(Item));
166 ItemNode.Data := Item;
167 ItemNode.ImageIndex := FComponentTV.GetImageFor(Item);
168 ItemNode.SelectedIndex := ItemNode.ImageIndex;
169 ItemNode.MultiSelected := FComponentTV.Selection.IndexOf(Item) >= 0;
170 // Collections can be nested. Add possible Collections under a CollectionItem.
171 GetOwnedPersistents(Item, ItemNode);
172 end;
173 end;
174
175 procedure TComponentWalker.AddOwnedPersistent(APers: TPersistent;
176 APropName: String; AParentNode: TTreeNode);
177 var
178 TVNode: TTreeNode;
179 TheRoot: TPersistent;
180 begin
181 if (APers is TComponent)
182 and (csDestroying in TComponent(APers).ComponentState) then Exit;
183 TheRoot := GetLookupRootForComponent(APers);
184 {$IFDEF VerboseComponentTVWalker}
185 DebugLn(['TComponentWalker.AddOwnedPersistent'+
186 ' PropName=',APropName,' Persistent=',DbgSName(APers),
187 ' its root=',DbgSName(TheRoot),' FLookupRoot=',DbgSName(FLookupRoot)]);
188 {$ENDIF}
189 if TheRoot <> FLookupRoot then Exit;
190 if PersistentFoundInNode(APers) then Exit;
191 TVNode := FComponentTV.Items.AddChild(AParentNode,
192 FComponentTV.CreateNodeCaption(APers, APropName));
193 TVNode.Data := APers;
194 TVNode.ImageIndex := FComponentTV.GetImageFor(APers);
195 TVNode.SelectedIndex := TVNode.ImageIndex;
196 TVNode.MultiSelected := FComponentTV.Selection.IndexOf(APers) >= 0;
197 if APers is TCollection then
198 AddCollection(TCollection(APers), TVNode);
199 //AParentNode.Expanded := True;
200 end;
201
202 procedure TComponentWalker.GetOwnedPersistents(APers: TPersistent; AParentNode: TTreeNode);
203 var
204 PropList: PPropList;
205 PropCount, i: Integer;
206 PropInfo: PPropInfo;
207 PropPers: TPersistent;
208 begin
209 PropCount := GetPropList(APers, PropList);
210 try
211 for i := 0 to PropCount - 1 do begin
212 PropInfo:=PropList^[i];
213 if (PropInfo^.PropType^.Kind <> tkClass) then Continue;
214 {$IFDEF ShowOwnedObjectsOI}
215 PropPers := TPersistent(GetObjectProp(APers, PropInfo, TPersistent));
216 {$ELSE}
217 PropPers := TPersistent(GetObjectProp(APers, PropInfo, TCollection));
218 {$ENDIF}
219 if PropPers=nil then Continue;
220 if GetEditorClass(PropInfo, APers)=nil then Continue;
221 {$IFDEF VerboseComponentTVWalker}
222 DebugLn(['TComponentWalker.GetOwnedPersistents Persistent=',DbgSName(APers),
223 ' PropName=',PropInfo^.Name,' FLookupRoot=',DbgSName(FLookupRoot)]);
224 {$ENDIF}
225 AddOwnedPersistent(PropPers, PropInfo^.Name, AParentNode);
226 end;
227 finally
228 FreeMem(PropList);
229 end;
230 end;
231
PersistentFoundInNodenull232 function TComponentWalker.PersistentFoundInNode(APers: TPersistent): Boolean;
233 var
234 i: Integer;
235 begin
236 for i:=0 to FNode.Count-1 do
237 if TObject(FNode[i].Data) = APers then
238 Exit(True);
239 Result := False;
240 end;
241
242 procedure TComponentWalker.Walk(AComponent: TComponent);
243 var
244 OldNode: TTreeNode;
245 Candidate: TComponentCandidate;
246 AVLNode: TAvlTreeNode;
247 Root: TComponent;
248 begin
249 if csDestroying in AComponent.ComponentState then exit;
250 if GetLookupRootForComponent(AComponent) <> FLookupRoot then Exit;
251
252 AVLNode := FCandidates.FindKey(AComponent, TListSortCompare(@ComparePersistentWithComponentCandidate));
253 if AVLNode = nil then Exit;
254
255 Candidate := TComponentCandidate(AVLNode.Data);
256 if Candidate.Added then Exit;
257 Candidate.Added := True;
258
259 OldNode := FNode;
260 FNode := FComponentTV.Items.AddChild(FNode, FComponentTV.ComponentCaption(AComponent));
261 FNode.Data := AComponent;
262 FNode.ImageIndex := FComponentTV.GetImageFor(AComponent);
263 FNode.SelectedIndex := FNode.ImageIndex;
264 FNode.MultiSelected := FComponentTV.Selection.IndexOf(AComponent) >= 0;
265
266 GetOwnedPersistents(AComponent, FNode);
267
268 if (csInline in AComponent.ComponentState) or (AComponent.Owner = nil) then
269 Root := AComponent
270 else
271 Root := AComponent.Owner;
272
273 if not ( (Root is TControl)
274 and (csOwnedChildrenNotSelectable in TControl(Root).ControlStyle) )
275 then
276 TComponentAccessor(AComponent).GetChildren(@Walk, Root);
277 FNode := OldNode;
278 FNode.Expanded := True;
279 end;
280
281 { TComponentTreeView }
282
283 procedure TComponentTreeView.SetSelection(NewSelection: TPersistentSelectionList);
284 begin
285 if (PropertyEditorHook = nil) then
286 begin
287 if (FComponentList.LookupRoot = nil) then
288 Exit;
289 FComponentList.Clear;
290 end
291 else if not NewSelection.ForceUpdate
292 and FComponentList.IsEqual(PropertyEditorHook.LookupRoot, NewSelection) then
293 begin
294 // nodes ok, but maybe node values need update
295 //DebugLn('TComponentTreeView.SetSelection: Updating component node values.');
296 UpdateComponentNodesValues;
297 Exit;
298 end;
299 FComponentList.LookupRoot := PropertyEditorHook.LookupRoot;
300 FComponentList.Selection.Assign(NewSelection);
301 if NewSelection.ForceUpdate then
302 begin
303 //DebugLn('TComponentTreeView.SetSelection: Selection.ForceUpdate encountered.');
304 NewSelection.ForceUpdate:=false;
305 end;
306 UpdateSelected;
307 end;
308
309 procedure TComponentTreeView.DoSelectionChanged;
310 var
311 ANode: TTreeNode;
312 APersistent: TPersistent;
313 NewSelection: TPersistentSelectionList;
314 begin
315 NewSelection := TPersistentSelectionList.Create;
316 try
317 if (PropertyEditorHook<>nil) and
318 (PropertyEditorHook.LookupRoot<>nil) and
319 (not (csDestroying in ComponentState)) then
320 begin
321 ANode := GetFirstMultiSelected;
322 while ANode <> nil do
323 begin
324 APersistent := TPersistent(ANode.Data);
325 if APersistent = nil then
326 RaiseGDBException('TComponentTreeView.DoSelectionChanged ANode.Data=nil');
327 if GetLookupRootForComponent(APersistent) = PropertyEditorHook.LookupRoot then
328 NewSelection.Add(APersistent);
329 ANode := ANode.GetNextMultiSelected;
330 end;
331 NewSelection.SortLike(FComponentList.Selection);
332 end;
333 if NewSelection.IsEqual(FComponentList.Selection) then
334 Exit;
335 FComponentList.Selection.Assign(NewSelection);
336
337 inherited DoSelectionChanged;
338 finally
339 NewSelection.Free;
340 end;
341 end;
342
343 procedure TComponentTreeView.DragDrop(Source: TObject; X, Y: Integer);
344 var
345 Node, ParentNode, SelNode: TTreeNode;
346 ACollection: TCollection;
347 AContainer, OldContainer: TWinControl;
348 AControl: TControl;
349 InsertType: TTreeViewInsertMarkType;
350 RootDesigner: TIDesigner;
351 CompEditDsg: TComponentEditorDesigner;
352 NewIndex, AIndex: Integer;
353 ok: Boolean;
354 begin
355 GetComponentInsertMarkAt(X, Y, Node, InsertType);
356 SetInsertMark(nil, tvimNone);
357 if InsertType in [tvimAsNextSibling, tvimAsPrevSibling] then
358 ParentNode := Node.Parent
359 else
360 ParentNode := Node;
361 if Assigned(ParentNode) then
362 begin
363 // Find designer for Undo actions.
364 Assert(Assigned(FPropertyEditorHook), 'TComponentTreeView.DragDrop: PropertyEditorHook=Nil.');
365 RootDesigner := FindRootDesigner(FPropertyEditorHook.LookupRoot);
366 if (RootDesigner is TComponentEditorDesigner) then
367 CompEditDsg := TComponentEditorDesigner(RootDesigner) //if CompEditDsg.IsUndoLocked then Exit;
368 else
369 CompEditDsg := nil;
370
371 if TObject(ParentNode.Data) is TWinControl then
372 begin
373 AContainer := TWinControl(ParentNode.Data);
374 SelNode := GetFirstMultiSelected;
375 while Assigned(SelNode) do
376 begin
377 if TObject(SelNode.Data) is TControl then
378 begin
379 AControl := TControl(SelNode.Data);
380 ok:=false;
381 try
382 OldContainer := AControl.Parent;
383 AControl.Parent := AContainer;
384 if Assigned(CompEditDsg) then
385 CompEditDsg.AddUndoAction(AControl, uopChange, True, 'Parent',
386 OldContainer.Name, AContainer.Name);
387 ok:=true;
388 DoModified;
389 except
390 on E: Exception do
391 MessageDlg(oisError,
392 Format(oisUnableToChangeParentOfControlToNewParent,
393 [DbgSName(AControl), DbgSName(AContainer), LineEnding, E.Message]),
394 mtError, [mbOk], 0);
395 end;
396 if not ok then break;
397 end;
398 SelNode := SelNode.GetNextMultiSelected;
399 end;
400 end
401 else
402 if TObject(Node.Data) is TCollectionItem then
403 begin
404 ACollection := TCollectionItem(Node.Data).Collection;
405 ACollection.BeginUpdate;
406 case InsertType of
407 tvimAsNextSibling:
408 NewIndex := TCollectionItem(Node.Data).Index + 1;
409 tvimAsPrevSibling:
410 NewIndex := TCollectionItem(Node.Data).Index;
411 end;
412 SelNode := GetLastMultiSelected;
413 while Assigned(SelNode) do
414 begin
415 if (TObject(SelNode.Data) is TCollectionItem) and
416 (TCollectionItem(SelNode.Data).Collection = ACollection) then
417 begin
418 ok := False;
419 try
420 AIndex := TCollectionItem(SelNode.Data).Index;
421 if AIndex < NewIndex then
422 TCollectionItem(SelNode.Data).Index := NewIndex - 1
423 else
424 TCollectionItem(SelNode.Data).Index := NewIndex;
425 ok := True;
426 DoModified;
427 except
428 on E: Exception do
429 MessageDlg(E.Message, mtError, [mbOk], 0);
430 end;
431 if not ok then break;
432 end;
433 SelNode := SelNode.GetPrevMultiSelected;
434 end;
435 ACollection.EndUpdate;
436 end;
437 RebuildComponentNodes;
438 end;
439 inherited DragDrop(Source, X, Y);
440 end;
441
442 procedure TComponentTreeView.DragOver(Source: TObject; X, Y: Integer;
443 State: TDragState; var Accept: Boolean);
444 var
445 Node: TTreeNode;
446 AnObject: TObject;
447 AControl: TControl absolute AnObject;
448 AContainer: TPersistent;
449 AcceptControl, AcceptContainer: Boolean;
450 InsertType: TTreeViewInsertMarkType;
451 ParentNode: TTreeNode;
452 aLookupRoot: TPersistent;
453 begin
454 //debugln('TComponentTreeView.DragOver START ',dbgs(Accept));
455
456 AcceptContainer := False;
457 AcceptControl := True;
458
459 GetComponentInsertMarkAt(X, Y, Node, InsertType);
460 SetInsertMark(Node, InsertType);
461
462 if PropertyEditorHook<>nil then
463 aLookupRoot := PropertyEditorHook.LookupRoot
464 else
465 aLookupRoot := nil;
466
467 // check new parent
468 ParentNode := Node;
469 if InsertType in [tvimAsNextSibling, tvimAsPrevSibling] then
470 ParentNode := ParentNode.Parent;
471 if Assigned(ParentNode) and Assigned(ParentNode.Data) then
472 begin
473 AnObject := TObject(ParentNode.Data);
474 if (AnObject is TWinControl) then
475 begin
476 if ControlAcceptsStreamableChildComponent(TWinControl(AControl),
477 TComponentClass(AnObject.ClassType),aLookupRoot)
478 then begin
479 AContainer := TPersistent(AnObject);
480 //DebugLn(['TComponentTreeView.DragOver AContainer=',DbgSName(AContainer)]);
481 AcceptContainer := True;
482 end;
483 end
484 else
485 if (AnObject is TCollection) then
486 begin
487 // it is allowed to move container items inside the container
488 AContainer := TPersistent(AnObject);
489 AcceptContainer := True;
490 end;
491 end;
492
493 if AcceptContainer then
494 begin
495 Node := GetFirstMultiSelected;
496 while Assigned(Node) and AcceptControl do
497 begin
498 AnObject := TObject(Node.Data);
499 // don't allow to move ancestor components
500 if (AnObject is TComponent) and
501 (csAncestor in TComponent(AnObject).ComponentState) then break;
502 if (AnObject is TControl) then
503 begin
504 if AnObject = AContainer then break;
505 if not (AContainer is TWinControl) then break;
506 //DebugLn(['TComponentTreeView.DragOver AControl=',DbgSName(AControl),' Parent=',DbgSName(AControl.Parent),' OldAccepts=',csAcceptsControls in AControl.Parent.ControlStyle]);
507 // check if new parent allows this control class
508 if not TWinControl(AContainer).CheckChildClassAllowed(AnObject.ClassType, False) then
509 break;
510 // check if one of the parent of the container is the control itself
511 if AControl.IsParentOf(TWinControl(AContainer)) then break;
512 // do not move children of a restricted parent to another parent
513 // e.g. TPage of TPageControl
514 if (AControl.Parent <> nil) and (AControl.Parent <> AContainer) and
515 (not (csAcceptsControls in AControl.Parent.ControlStyle)) then
516 break;
517 end
518 else
519 if (AnObject is TCollectionItem) then
520 begin
521 if AnObject = AContainer then break;
522 if not (AContainer is TCollection) then
523 break;
524 if TCollectionItem(AnObject).Collection <> TCollection(AContainer) then
525 break;
526 end;
527 Node := Node.GetNextMultiSelected;
528 end;
529 AcceptControl := (Node = nil);
530 end;
531
532 Accept := AcceptContainer and AcceptControl;
533 //debugln('TComponentTreeView.DragOver A ',dbgs(Accept));
534 inherited DragOver(Source, X, Y, State, Accept);
535 //debugln('TComponentTreeView.DragOver B ',dbgs(Accept));
536
537 Accept := AcceptContainer and AcceptControl and ((OnDragOver=nil) or Accept);
538 end;
539
540 procedure TComponentTreeView.DragCanceled;
541 begin
542 SetInsertMark(nil, tvimNone);
543 inherited DragCanceled;
544 end;
545
546 procedure TComponentTreeView.MouseLeave;
547 begin
548 SetInsertMark(nil,tvimNone);
549 inherited MouseLeave;
550 end;
551
552 procedure TComponentTreeView.GetComponentInsertMarkAt(X, Y: Integer; out
553 AnInsertMarkNode: TTreeNode; out AnInsertMarkType: TTreeViewInsertMarkType);
554 var
555 Node: TTreeNode;
556 begin
557 Node := GetFirstMultiSelected;
558 if (Node <> nil) and (TObject(Node.Data) is TControl) then
559 begin
560 // TWinControl allows only to add/remove children, but not at a specific position
561 AnInsertMarkNode := GetNodeAt(X,Y);
562 AnInsertMarkType := tvimAsFirstChild;
563 end
564 else
565 begin
566 GetInsertMarkAt(X, Y, AnInsertMarkNode, AnInsertMarkType);
567 if (Node <> nil) and (TObject(Node.Data) is TCollectionItem) then
568 if AnInsertMarkType = tvimAsFirstChild then
569 AnInsertMarkType := tvimAsPrevSibling;
570 end;
571 end;
572
573 procedure TComponentTreeView.DoModified;
574 begin
575 if Assigned(PropertyEditorHook) then
576 PropertyEditorHook.RefreshPropertyValues;
577 if Assigned(FOnModified) then
578 OnModified(Self);
579 end;
580
GetImageFornull581 function TComponentTreeView.GetImageFor(APersistent: TPersistent): integer;
582 begin
583 Result := -1;
584 if Assigned(APersistent) then
585 begin
586 if (APersistent is TControl)
587 and (csAcceptsControls in TControl(APersistent).ControlStyle) then
588 Result := ImgIndexBox
589 else
590 if (APersistent is TControl) then
591 Result := ImgIndexControl
592 else
593 if (APersistent is TComponent) then
594 Result := ImgIndexComponent
595 else
596 if (APersistent is TCollection) then
597 Result := ImgIndexCollection
598 else
599 if (APersistent is TCollectionItem) then
600 Result := ImgIndexItem;
601 end;
602 // finally, ask the designer such as TDesignerMediator to override it, if any
603 if Assigned(OnComponentGetImageIndex) then
604 OnComponentGetImageIndex(APersistent, Result);
605 end;
606
607 procedure TComponentTreeView.SetPropertyEditorHook(AValue: TPropertyEditorHook);
608 begin
609 if FPropertyEditorHook=AValue then exit;
610 FPropertyEditorHook:=AValue;
611 RebuildComponentNodes;
612 end;
613
GetSelectionnull614 function TComponentTreeView.GetSelection: TPersistentSelectionList;
615 begin
616 Result:=FComponentList.Selection;
617 end;
618
619 constructor TComponentTreeView.Create(TheOwner: TComponent);
620 begin
621 inherited Create(TheOwner);
622 DragMode := dmAutomatic;
623 FComponentList:=TBackupComponentList.Create;
624 Options := Options + [tvoAllowMultiselect, tvoAutoItemHeight, tvoKeepCollapsedNodes, tvoReadOnly];
625 MultiSelectStyle := MultiSelectStyle + [msShiftSelect];
626 ImgIndexForm := IDEImages.GetImageIndex('oi_form');
627 ImgIndexComponent := IDEImages.GetImageIndex('oi_comp');
628 ImgIndexControl := IDEImages.GetImageIndex('oi_control');
629 ImgIndexBox := IDEImages.GetImageIndex('oi_box');
630 ImgIndexCollection := IDEImages.GetImageIndex('oi_collection');
631 ImgIndexItem := IDEImages.GetImageIndex('oi_item');
632 Images := IDEImages.Images_16;
633 end;
634
635 destructor TComponentTreeView.Destroy;
636 begin
637 FreeThenNil(FComponentList);
638 inherited Destroy;
639 end;
640
641 procedure TComponentTreeView.RebuildComponentNodes;
642 var
643 Candidates: TAvlTree; // tree of TComponentCandidate sorted for aPersistent (CompareComponentCandidates)
644 RootObject: TPersistent;
645 RootComponent: TComponent absolute RootObject;
646
647 procedure AddChildren(AComponent: TComponent; ANode: TTreeNode);
648 var
649 Walker: TComponentWalker;
650 Root: TComponent;
651 begin
652 if csDestroying in AComponent.ComponentState then exit;
653 //debugln(['AddChildren ',DbgSName(AComponent),' ',AComponent.ComponentCount]);
654 Walker := TComponentWalker.Create(Self, Candidates, RootComponent, ANode);
655 try
656 // add inline components children
657 if csInline in AComponent.ComponentState then
658 Root := AComponent
659 else
660 Root := RootComponent;
661 TComponentAccessor(AComponent).GetChildren(@Walker.Walk, Root);
662 finally
663 Walker.Free;
664 end;
665 end;
666
667 procedure AddCandidates(OwnerComponent: TComponent);
668 var
669 AComponent: TComponent;
670 Candidate: TComponentCandidate;
671 i: Integer;
672 begin
673 //debugln(['AddCandidates OwnerComponent=',DbgSName(OwnerComponent)]);
674 if OwnerComponent = nil then Exit;
675 if csDestroying in OwnerComponent.ComponentState then exit;
676 for i := 0 to OwnerComponent.ComponentCount - 1 do
677 begin
678 AComponent := OwnerComponent.Components[i];
679 if csDestroying in AComponent.ComponentState then continue;
680 Candidate := TComponentCandidate.Create;
681 Candidate.APersistent := AComponent;
682 if Candidates.Find(Candidate)<>nil then
683 begin
684 DebugLn('WARNING: TComponentTreeView.RebuildComponentNodes doppelganger found ', AComponent.Name);
685 Candidate.Free;
686 end
687 else
688 begin
689 Candidates.Add(Candidate);
690 if csInline in AComponent.ComponentState then
691 AddCandidates(AComponent);
692 end;
693 end;
694 end;
695
696 var
697 RootNode: TTreeNode;
698 Candidate: TComponentCandidate;
699 begin
700 BeginUpdate;
701 Items.Clear;
702 RootObject := nil;
703 if PropertyEditorHook<>nil then
704 RootObject := PropertyEditorHook.LookupRoot;
705 if (RootObject is TComponent)
706 and (csDestroying in TComponent(RootObject).ComponentState) then
707 RootObject:=nil;
708 if RootObject <> nil then
709 begin
710 Candidates:=TAvlTree.Create(TListSortCompare(@CompareComponentCandidates));
711 try
712 // first add the lookup root
713 RootNode := Items.Add(nil, CreateNodeCaption(RootObject));
714 RootNode.Data := RootObject;
715 RootNode.ImageIndex := ImgIndexForm;
716 RootNode.SelectedIndex := RootNode.ImageIndex;
717 RootNode.MultiSelected := Selection.IndexOf(RootObject) >= 0;
718
719 // create candidate nodes for every child
720 Candidate := TComponentCandidate.Create;
721 Candidate.APersistent := RootObject;
722 Candidate.Added := True;
723 Candidates.Add(Candidate);
724
725 // add components in creation order and TControl.Parent relationship
726 if RootObject is TComponent then
727 begin
728 AddCandidates(RootComponent);
729 AddChildren(RootComponent,RootNode);
730 end;
731 finally
732 Candidates.FreeAndClear;
733 Candidates.Free;
734 end;
735
736 RootNode.Expand(true);
737 end;
738 MakeSelectionVisible;
739 EndUpdate;
740 end;
741
742 procedure TComponentTreeView.UpdateComponentNodesValues;
743 // Could be optimised by adding a PropName parameter and searching a node by name.
744
745 procedure UpdateComponentNode(ANode: TTreeNode);
746 var
747 APersistent: TPersistent;
748 begin
749 if ANode = nil then Exit;
750 APersistent := TPersistent(ANode.Data);
751 if APersistent is TComponent then
752 ANode.Text := ComponentCaption(TComponent(APersistent))
753 else if APersistent is TCollectionItem then
754 ANode.Text := CollectionItemCaption(TCollectionItem(APersistent));
755 // Note: Collection name does not change, don't update.
756
757 UpdateComponentNode(ANode.GetFirstChild); // Recursive call.
758 UpdateComponentNode(ANode.GetNextSibling);
759 end;
760
761 begin
762 BeginUpdate;
763 UpdateComponentNode(Items.GetFirstNode);
764 EndUpdate;
765 end;
766
767 procedure TComponentTreeView.UpdateSelected;
768
769 procedure UpdateComponentNode(ANode: TTreeNode);
770 var
771 APersistent: TPersistent;
772 begin
773 if ANode = nil then Exit;
774 APersistent := TPersistent(ANode.Data);
775 ANode.MultiSelected := Selection.IndexOf(APersistent) >= 0;
776 UpdateComponentNode(ANode.GetFirstChild);
777 UpdateComponentNode(ANode.GetNextSibling);
778 end;
779
780 begin
781 BeginUpdate;
782 Selected := Nil;
783 UpdateComponentNode(Items.GetFirstNode);
784 EndUpdate;
785 end;
786
TComponentTreeView.CollectionCaptionnull787 function TComponentTreeView.CollectionCaption(ACollection: TCollection; DefaultName: string): string;
788 var
789 PropList: PPropList;
790 i, PropCount: Integer;
791 begin
792 Result := '';
793 if Result <> '' then
794 Result := TCollectionAccess(ACollection).PropName
795 else if DefaultName<>'' then
796 Result := DefaultName // DefaultName is the property name.
797 else if ACollection.Owner <> nil then
798 begin
799 PropCount := GetPropList(ACollection.Owner, PropList);
800 try // Find the property name where ACollection can be found.
801 for i := 0 to PropCount - 1 do
802 if (PropList^[i]^.PropType^.Kind = tkClass) then
803 if GetObjectProp(ACollection.Owner, PropList^[i], ACollection.ClassType) = ACollection then
804 begin
805 Result := PropList^[i]^.Name;
806 Break;
807 end;
808 finally
809 FreeMem(PropList);
810 end;
811 end;
812 if Result = '' then
813 Result := '<unknown collection>';
814 Result := Result + ': ' + ACollection.ClassName;
815 end;
816
CollectionItemCaptionnull817 function TComponentTreeView.CollectionItemCaption(ACollItem: TCollectionItem): string;
818 begin
819 Result := IntToStr(ACollItem.Index)+' - '+ACollItem.DisplayName+': '+ACollItem.ClassName;
820 end;
821
ComponentCaptionnull822 function TComponentTreeView.ComponentCaption(AComponent: TComponent): String;
823 begin
824 Result := AComponent.Name + ': ' + AComponent.ClassName;
825 end;
826
CreateNodeCaptionnull827 function TComponentTreeView.CreateNodeCaption(APersistent: TPersistent; DefaultName: string): string;
828 begin
829 Result := APersistent.ClassName;
830 if APersistent is TComponent then
831 Result := ComponentCaption(TComponent(APersistent))
832 else if APersistent is TCollection then
833 Result := CollectionCaption(TCollection(APersistent), DefaultName)
834 else if APersistent is TCollectionItem then
835 Result := CollectionItemCaption(TCollectionItem(APersistent))
836 else if DefaultName<>'' then
837 Result := DefaultName + ':' + Result;
838 end;
839
840 end.
841
842