1 { $Id$ }
2 {
3 /***************************************************************************
4 componentreg.pas
5 ----------------
6
7 ***************************************************************************/
8
9 *****************************************************************************
10 See the file COPYING.modifiedLGPL.txt, included in this distribution,
11 for details about the license.
12 *****************************************************************************
13
14 Author: Mattias Gaertner, Juha Manninen
15
16 Abstract:
17 Interface to the component palette and the registered component classes.
18 Supports reordering of pages and components by user settings in environment options.
19 }
20 unit ComponentReg;
21
22 {$mode objfpc}{$H+}
23
24 interface
25
26 uses
27 Classes, SysUtils, typinfo, Contnrs, Laz_AVL_Tree, fgl,
28 // LCL
29 Controls,
30 // LazUtils
31 LazUtilities, LazLoggerBase, Laz2_XMLCfg, LazMethodList, LazUTF8;
32
33 type
34 TComponentPriorityCategory = (
35 cpBase,
36 cpUser, // User has changed the order using options GUI.
37 cpRecommended,
38 cpNormal,
39 cpOptional
40 );
41
42 TComponentPriority = record
43 Category: TComponentPriorityCategory;
44 Level: integer; // higher level means higher priority (range: -1000 to 1000)
45 end;
46
47 const
48 ComponentPriorityNormal: TComponentPriority = (Category: cpNormal; Level: 0);
49
50 LCLCompPriority: TComponentPriority = (Category: cpBase; Level: 10);
51 FCLCompPriority: TComponentPriority = (Category: cpBase; Level: 9);
52 IDEIntfCompPriority: TComponentPriority = (Category: cpBase; Level: 8);
53
54 type
55 TBaseComponentPage = class;
56 TBaseComponentPalette = class;
57 TRegisteredComponent = class;
58 TOnGetCreationClass = procedure(Sender: TObject;
59 var NewComponentClass: TComponentClass) of object;
60
61 { TRegisteredCompList }
62
63 TRegisteredCompList = class(specialize TFPGList<TRegisteredComponent>)
64 public
Equalsnull65 function Equals(Obj: TObject): Boolean; override;
66 end;
67
68 { TBaseCompPaletteOptions }
69
70 TBaseCompPaletteOptions = class
71 protected
72 FPageNames: TStringList; // Pages reordered by user.
73 public
74 constructor Create;
75 destructor Destroy; override;
76 procedure Clear;
77 procedure Assign(Source: TBaseCompPaletteOptions);
Equalsnull78 function Equals(Obj: TObject): boolean; override;
79 public
80 property PageNames: TStringList read FPageNames;
81 end;
82
83 { TCompPaletteOptions }
84
85 TCompPaletteOptions = class(TBaseCompPaletteOptions)
86 private
87 FName: string;
88 // List of page names with component names.
89 // Object holds another TStringList for the components.
90 FPageNamesCompNames: TStringList;
91 // Pages removed or renamed. They must be hidden in the palette.
92 FHiddenPageNames: TStringList;
93 FVisible: boolean;
94 public
95 constructor Create;
96 destructor Destroy; override;
97 procedure Clear;
98 procedure Assign(Source: TCompPaletteOptions);
99 procedure AssignPageCompNames(aPageName: string; aList: TStringList);
IsDefaultnull100 function IsDefault: Boolean;
101 procedure Load(XMLConfig: TXMLConfig; Path: String);
102 procedure Save(XMLConfig: TXMLConfig; Path: String);
Equalsnull103 function Equals(Obj: TObject): boolean; override;
104 public
105 property Name: string read FName write FName;
106 property PageNamesCompNames: TStringList read FPageNamesCompNames;
107 property HiddenPageNames: TStringList read FHiddenPageNames;
108 property Visible: boolean read FVisible write FVisible;
109 end;
110
111 { TCompPaletteUserOrder }
112
113 // Only used by the component palette options to show all available pages.
114 // It's like TCompPaletteOptions but collects all pages and components,
115 // including the original ones and the newly installed ones.
116 // The active palette is later synchronized with this.
117 TCompPaletteUserOrder = class(TBaseCompPaletteOptions)
118 private
119 fPalette: TBaseComponentPalette;
120 // List of page names with component contents.
121 // Object holds TRegisteredComponentList for the components.
122 FComponentPages: TStringList;
123 // Reference to either EnvironmentOptions.ComponentPaletteOptions or a copy of it.
124 fOptions: TCompPaletteOptions;
125 public
126 constructor Create(aPalette: TBaseComponentPalette);
127 destructor Destroy; override;
128 procedure Clear;
129 procedure Assign(Source: TCompPaletteUserOrder);
130 procedure AssignCompPage(aPageName: string; aList: TRegisteredCompList);
131 function Equals(Obj: TObject): boolean; override;
132 function SortPagesAndCompsUserOrder: Boolean;
133 public
134 // all pages, ordered first by Options, then by default priority
135 property ComponentPages: TStringList read FComponentPages;
136 property Options: TCompPaletteOptions read fOptions write fOptions;
137 end;
138
139 { TRegisteredComponent }
140
141 TRegisteredComponent = class
142 private
143 FComponentClass: TComponentClass;
144 FOnGetCreationClass: TOnGetCreationClass;
145 FOrigPageName: string;
146 FRealPage: TBaseComponentPage;
147 FVisible: boolean;
148 protected
149 procedure SetVisible(const AValue: boolean); virtual;
150 public
151 constructor Create(TheComponentClass: TComponentClass; const ThePageName: string);
152 destructor Destroy; override;
153 procedure ConsistencyCheck; virtual;
154 function GetUnitName: string; virtual; abstract;
155 function GetPriority: TComponentPriority; virtual;
156 procedure AddToPalette; virtual;
157 function CanBeCreatedInDesigner: boolean; virtual;
158 function GetCreationClass: TComponentClass; virtual;
159 public
160 property ComponentClass: TComponentClass read FComponentClass;
161 property OnGetCreationClass: TOnGetCreationClass read FOnGetCreationClass
162 write FOnGetCreationClass;
163 property OrigPageName: string read FOrigPageName; // case sensitive
164 property RealPage: TBaseComponentPage read FRealPage write FRealPage;
165 property Visible: boolean read FVisible write SetVisible;
166 end;
167
168 { TBaseComponentPage }
169
170 TBaseComponentPage = class
171 private
172 FPageName: string;
173 FPalette: TBaseComponentPalette;
174 FVisible: boolean;
175 protected
176 FIndex: Integer; // Index in the Pages container.
177 procedure SetVisible(const AValue: boolean); virtual;
178 procedure OnComponentVisibleChanged({%H-}AComponent: TRegisteredComponent); virtual;
179 public
180 constructor Create(const ThePageName: string);
181 destructor Destroy; override;
182 public
183 property PageName: string read FPageName;
184 property Palette: TBaseComponentPalette read FPalette write FPalette;
185 property Visible: boolean read FVisible write SetVisible;
186 end;
187
188 TBaseComponentPageClass = class of TBaseComponentPage;
189
190 { TBaseComponentPalette }
191
192 TComponentPaletteHandlerType = (
193 cphtUpdateVisible, // Visibility of component palette icons is recomputed
194 cphtComponentAdded, // Typically selection is changed after component was added.
195 cphtSelectionChanged
196 );
197
198 TComponentSelectionMode = (
199 csmSingle, // reset selection on component add
200 csmMulty // don't reset selection on component add
201 );
202
203 TEndUpdatePaletteEvent = procedure(Sender: TObject; PaletteChanged: boolean) of object;
204 TGetComponentClassEvent = procedure(const AClass: TComponentClass) of object;
205 TUpdateCompVisibleEvent = procedure(AComponent: TRegisteredComponent;
206 var VoteVisible: integer { Visible>0 } ) of object;
207 TPaletteHandlerEvent = procedure of object;
208 TComponentAddedEvent = procedure(ALookupRoot, AComponent: TComponent; ARegisteredComponent: TRegisteredComponent) of object;
209 RegisterUnitComponentProc = procedure(const Page, UnitName: ShortString;
210 ComponentClass: TComponentClass);
211 TBaseComponentPageList = specialize TFPGList<TBaseComponentPage>;
212 TPagePriorityList = specialize TFPGMap<String, TComponentPriority>;
213
214 TBaseComponentPalette = class
215 private
216 // List of pages, created based on user ordered and original pages.
217 fPages: TBaseComponentPageList;
218 // List of all components in all pages.
219 fComps: TRegisteredCompList;
220 // New pages added and their priorities, ordered by priority.
221 fOrigPagePriorities: TPagePriorityList;
222 // User ordered + original pages and components
223 fUserOrder: TCompPaletteUserOrder;
224 // Component cache, a tree of TRegisteredComponent sorted for componentclass
225 fComponentCache: TAVLTree;
226 // Two page caches, one for original pages, one for user ordered pages,
227 // containing page names. Object holds TRegisteredCompList for components.
228 fOrigComponentPageCache: TStringList; // Original
229 fUserComponentPageCache: TStringList; // User ordered
230 // Used to find names that differ in character case only.
231 fOrigPageHelper: TStringListUTF8Fast;
232 fHandlers: array[TComponentPaletteHandlerType] of TMethodList;
233 fComponentPageClass: TBaseComponentPageClass;
234 fSelected: TRegisteredComponent;
235 fSelectionMode: TComponentSelectionMode;
236 fHideControls: boolean;
237 fChangeStamp: integer;
238 fOnClassSelected: TNotifyEvent;
239 fLastFoundCompClassName: String;
240 fLastFoundRegComp: TRegisteredComponent;
241 procedure AddHandler(HandlerType: TComponentPaletteHandlerType;
242 const AMethod: TMethod; AsLast: boolean = false);
243 procedure RemoveHandler(HandlerType: TComponentPaletteHandlerType;
244 const AMethod: TMethod);
245 procedure CacheOrigComponentPages;
CreatePagesFromUserOrdernull246 function CreatePagesFromUserOrder: Boolean;
247 procedure DoPageAddedComponent(Component: TRegisteredComponent);
248 procedure DoPageRemovedComponent(Component: TRegisteredComponent);
249 procedure SetHideControls(AValue: boolean);
VoteCompVisibilitynull250 function VoteCompVisibility(AComponent: TRegisteredComponent): Boolean;
GetSelectednull251 function GetSelected: TRegisteredComponent;
GetMultiSelectnull252 function GetMultiSelect: boolean;
253 procedure SetSelected(const AValue: TRegisteredComponent);
254 procedure SetMultiSelect(AValue: boolean);
255 protected
256 FChanged: boolean;
257 procedure DoChange; virtual; abstract;
258 public
259 constructor Create(EnvPaletteOptions: TCompPaletteOptions);
260 destructor Destroy; override;
261 procedure Clear;
AssignOrigCompsForPagenull262 function AssignOrigCompsForPage(PageName: string;
263 DestComps: TRegisteredCompList): Boolean;
AssignOrigVisibleCompNamesnull264 function AssignOrigVisibleCompNames(PageName: string;
265 DestCompNames: TStringList): Boolean;
RefUserCompsForPagenull266 function RefUserCompsForPage(PageName: string): TRegisteredCompList;
267 procedure BeginUpdate; virtual; abstract;
268 procedure EndUpdate; virtual; abstract;
269 procedure IncChangeStamp;
IndexOfPageNamenull270 function IndexOfPageName(const APageName: string; ACaseSensitive: Boolean): integer;
GetPagenull271 function GetPage(const APageName: string; ACaseSensitive: Boolean=False): TBaseComponentPage;
272 procedure AddRegComponent(NewComponent: TRegisteredComponent);
273 procedure RemoveRegComponent(AComponent: TRegisteredComponent);
FindRegComponentnull274 function FindRegComponent(ACompClass: TClass): TRegisteredComponent;
FindRegComponentnull275 function FindRegComponent(const ACompClassName: string): TRegisteredComponent;
CreateNewClassNamenull276 function CreateNewClassName(const Prefix: string): string;
277 procedure Update({%H-}ForceUpdateAll: Boolean); virtual;
278 procedure IterateRegisteredClasses(Proc: TGetComponentClassEvent);
279 procedure SetSelectedComp(AComponent: TRegisteredComponent; AMulti: Boolean);
280 // Registered handlers
281 procedure DoAfterComponentAdded(ALookupRoot, AComponent: TComponent;
282 ARegisteredComponent: TRegisteredComponent); virtual;
283 procedure DoAfterSelectionChanged;
284 procedure RemoveAllHandlersOfObject(AnObject: TObject);
285 procedure AddHandlerUpdateVisible(const OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent;
286 AsLast: boolean = false);
287 procedure RemoveHandlerUpdateVisible(OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent);
288 procedure AddHandlerComponentAdded(OnComponentAddedEvent: TComponentAddedEvent);
289 procedure RemoveHandlerComponentAdded(OnComponentAddedEvent: TComponentAddedEvent);
290 procedure AddHandlerSelectionChanged(OnSelectionChangedEvent: TPaletteHandlerEvent);
291 procedure RemoveHandlerSelectionChanged(OnSelectionChangedEvent: TPaletteHandlerEvent);
292 public
293 property Pages: TBaseComponentPageList read fPages;
294 property Comps: TRegisteredCompList read fComps;
295 property OrigPagePriorities: TPagePriorityList read fOrigPagePriorities;
296 property ComponentPageClass: TBaseComponentPageClass read FComponentPageClass
297 write FComponentPageClass;
298 property ChangeStamp: integer read fChangeStamp;
299 property HideControls: boolean read FHideControls write SetHideControls;
300 property Selected: TRegisteredComponent read GetSelected write SetSelected;
301 property MultiSelect: boolean read GetMultiSelect write SetMultiSelect;
302 property SelectionMode: TComponentSelectionMode read FSelectionMode write FSelectionMode;
303 // User ordered + original pages and components.
304 property UserOrder: TCompPaletteUserOrder read fUserOrder;
305 property OnClassSelected: TNotifyEvent read fOnClassSelected write fOnClassSelected;
306 end;
307
308
309 {$IFDEF VerboseComponentPalette}
310 const
311 CompPalVerbPgName = 'Dialogs'; //'Standard';
312 {$ENDIF}
313 var
314 IDEComponentPalette: TBaseComponentPalette = nil;
315
ComponentPrioritynull316 function ComponentPriority(Category: TComponentPriorityCategory; Level: integer): TComponentPriority;
ComparePrioritynull317 function ComparePriority(const p1,p2: TComponentPriority): integer;
CompareIDEComponentByClassnull318 function CompareIDEComponentByClass(Data1, Data2: pointer): integer;
dbgsnull319 function dbgs(const c: TComponentPriorityCategory): string; overload;
dbgsnull320 function dbgs(const p: TComponentPriority): string; overload;
321
322 implementation
323
324 const
325 BasePath = 'ComponentPaletteOptions/';
326
ComponentPrioritynull327 function ComponentPriority(Category: TComponentPriorityCategory; Level: integer
328 ): TComponentPriority;
329 begin
330 Result.Category:=Category;
331 Result.Level:=Level;
332 end;
333
ComparePrioritynull334 function ComparePriority(const p1, p2: TComponentPriority): integer;
335 begin
336 // lower category is better
337 Result:=ord(p2.Category)-ord(p1.Category);
338 if Result<>0 then exit;
339 // higher level is better
340 Result:=p1.Level-p2.Level;
341 end;
342
CompareIDEComponentByClassnull343 function CompareIDEComponentByClass(Data1, Data2: Pointer): integer;
344 var
345 Comp1: TRegisteredComponent absolute Data1;
346 Comp2: TRegisteredComponent absolute Data2;
347 begin
mustnull348 // The same compare function must be used here and in CompareClassWithIDEComponent.
349 Result:=ComparePointers(Comp1.ComponentClass, Comp2.ComponentClass);
350 end;
351
CompareClassWithIDEComponentnull352 function CompareClassWithIDEComponent(Key, Data: Pointer): integer;
353 var
354 AClass: TComponentClass absolute Key;
355 RegComp: TRegisteredComponent absolute Data;
356 begin
357 Result:=ComparePointers(AClass, RegComp.ComponentClass);
358 end;
359
dbgsnull360 function dbgs(const c: TComponentPriorityCategory): string;
361 begin
362 Result:=GetEnumName(TypeInfo(TComponentPriorityCategory),ord(c));
363 end;
364
dbgsnull365 function dbgs(const p: TComponentPriority): string;
366 begin
367 Result:='Cat='+dbgs(p.Category)+',Lvl='+IntToStr(p.Level);
368 end;
369
370 { TRegisteredCompList }
371
Equalsnull372 function TRegisteredCompList.Equals(Obj: TObject): Boolean;
373 Var
374 i: Longint;
375 Source: TRegisteredCompList;
376 begin
377 if Obj is TRegisteredCompList then
378 begin
379 Source:=TRegisteredCompList(Obj);
380 if Count<>Source.Count then exit(False);
381 For i:=0 to Count-1 do
382 If Items[i]<>Source[i] then exit(False);
383 Result:=True;
384 end else
385 Result:=inherited Equals(Obj);
386 end;
387
388 { TBaseCompPaletteOptions }
389
390 constructor TBaseCompPaletteOptions.Create;
391 begin
392 inherited Create;
393 FPageNames := TStringList.Create;
394 end;
395
396 destructor TBaseCompPaletteOptions.Destroy;
397 begin
398 FreeAndNil(FPageNames);
399 inherited Destroy;
400 end;
401
402 procedure TBaseCompPaletteOptions.Clear;
403 begin
404 FPageNames.Clear;
405 end;
406
407 procedure TBaseCompPaletteOptions.Assign(Source: TBaseCompPaletteOptions);
408 begin
409 FPageNames.Assign(Source.FPageNames);
410 end;
411
Equalsnull412 function TBaseCompPaletteOptions.Equals(Obj: TObject): boolean;
413 var
414 Source: TBaseCompPaletteOptions;
415 begin
416 if Obj is TBaseCompPaletteOptions then
417 begin
418 Source:=TBaseCompPaletteOptions(Obj);
419 Result:=FPageNames.Equals(Source.FPageNames);
420 end else
421 Result:=inherited Equals(Obj);
422 end;
423
424 { TCompPaletteOptions }
425
426 constructor TCompPaletteOptions.Create;
427 begin
428 inherited Create;
429 FPageNamesCompNames := TStringListUTF8Fast.Create;
430 FPageNamesCompNames.OwnsObjects := True;
431 FHiddenPageNames := TStringListUTF8Fast.Create;
432 FVisible := True;
433 end;
434
435 destructor TCompPaletteOptions.Destroy;
436 begin
437 FHiddenPageNames.Free;
438 FPageNamesCompNames.Free;
439 inherited Destroy;
440 end;
441
442 procedure TCompPaletteOptions.Clear;
443 begin
444 inherited Clear;
445 FPageNamesCompNames.Clear;
446 FHiddenPageNames.Clear;
447 end;
448
449 procedure TCompPaletteOptions.Assign(Source: TCompPaletteOptions);
450 var
451 i: Integer;
452 sl: TStringList;
453 begin
454 inherited Assign(Source);
455 // Name: do not assign name
456 FPageNamesCompNames.Clear;
457 for i:=0 to Source.FPageNamesCompNames.Count-1 do
458 begin
459 sl := TStringList.Create;
460 sl.Assign(Source.FPageNamesCompNames.Objects[i] as TStringList);
461 FPageNamesCompNames.AddObject(Source.FPageNamesCompNames[i], sl);
462 end;
463 FHiddenPageNames.Assign(Source.FHiddenPageNames);
464 FVisible := Source.FVisible;
465 end;
466
467 procedure TCompPaletteOptions.AssignPageCompNames(aPageName: string; aList: TStringList);
468 var
469 sl: TStringList;
470 begin
471 sl := TStringList.Create;
472 sl.Assign(aList);
473 FPageNamesCompNames.AddObject(aPageName, sl);
474 end;
475
IsDefaultnull476 function TCompPaletteOptions.IsDefault: Boolean;
477 begin
478 Result := (FPageNames.Count = 0)
479 and (FPageNamesCompNames.Count = 0)
480 and (FHiddenPageNames.Count = 0);
481 end;
482
483 procedure TCompPaletteOptions.Load(XMLConfig: TXMLConfig; Path: String);
484 var
485 CompNames: TStringList;
486 SubPath, CompPath: String;
487 PageName, CompName: String;
488 PageCount, CompCount: Integer;
489 i, j: Integer;
490 begin
491 Path := Path + BasePath;
492 try
493 FName:=XMLConfig.GetValue(Path+'Name/Value','');
494 FVisible:=XMLConfig.GetValue(Path+'Visible/Value',true);
495
496 // Pages
497 FPageNames.Clear;
498 SubPath:=Path+'Pages/';
499 PageCount:=XMLConfig.GetValue(SubPath+'Count', 0);
500 for i:=1 to PageCount do begin
501 PageName:=XMLConfig.GetValue(SubPath+'Item'+IntToStr(i)+'/Value', '');
502 if PageName <> '' then
503 FPageNames.Add(PageName);
504 end;
505
506 // HiddenPages
507 FHiddenPageNames.Clear;
508 SubPath:=Path+'HiddenPages/';
509 PageCount:=XMLConfig.GetValue(SubPath+'Count', 0);
510 for i:=1 to PageCount do begin
511 PageName:=XMLConfig.GetValue(SubPath+'Item'+IntToStr(i)+'/Value', '');
512 if PageName <> '' then
513 FHiddenPageNames.Add(PageName);
514 end;
515
516 // ComponentPages
517 FPageNamesCompNames.Clear;
518 SubPath:=Path+'ComponentPages/';
519 PageCount:=XMLConfig.GetValue(SubPath+'Count', 0);
520 for i:=1 to PageCount do begin
521 CompPath:=SubPath+'Page'+IntToStr(i)+'/';
522 PageName:=XMLConfig.GetValue(CompPath+'Value', '');
523 CompNames:=TStringList.Create;
524 CompCount:=XMLConfig.GetValue(CompPath+'Components/Count', 0);
525 for j:=1 to CompCount do begin
526 CompName:=XMLConfig.GetValue(CompPath+'Components/Item'+IntToStr(j)+'/Value', '');
527 CompNames.Add(CompName);
528 end; // CompNames is owned by FComponentPages
529 FPageNamesCompNames.AddObject(PageName, CompNames);
530 end;
531 except
532 on E: Exception do begin
533 DebugLn('ERROR: TCompPaletteOptions.Load: ',E.Message);
534 exit;
535 end;
536 end;
537 end;
538
539 procedure TCompPaletteOptions.Save(XMLConfig: TXMLConfig; Path: String);
540 var
541 CompNames: TStringList;
542 SubPath, CompPath: String;
543 i, j: Integer;
544 begin
545 try
546 Path := Path + BasePath;
547 XMLConfig.SetDeleteValue(Path+'Name/Value', FName,'');
548 XMLConfig.SetDeleteValue(Path+'Visible/Value', FVisible,true);
549
550 SubPath:=Path+'Pages/';
551 XMLConfig.DeletePath(SubPath);
552 XMLConfig.SetDeleteValue(SubPath+'Count', FPageNames.Count, 0);
553 for i:=0 to FPageNames.Count-1 do
554 XMLConfig.SetDeleteValue(SubPath+'Item'+IntToStr(i+1)+'/Value', FPageNames[i], '');
555
556 SubPath:=Path+'HiddenPages/';
557 XMLConfig.DeletePath(SubPath);
558 XMLConfig.SetDeleteValue(SubPath+'Count', FHiddenPageNames.Count, 0);
559 for i:=0 to FHiddenPageNames.Count-1 do
560 XMLConfig.SetDeleteValue(SubPath+'Item'+IntToStr(i+1)+'/Value', FHiddenPageNames[i], '');
561
562 SubPath:=Path+'ComponentPages/';
563 XMLConfig.DeletePath(SubPath);
564 XMLConfig.SetDeleteValue(SubPath+'Count', FPageNamesCompNames.Count, 0);
565 for i:=0 to FPageNamesCompNames.Count-1 do begin
566 CompNames:=FPageNamesCompNames.Objects[i] as TStringList;
567 CompPath:=SubPath+'Page'+IntToStr(i+1)+'/';
568 XMLConfig.SetDeleteValue(CompPath+'Value', FPageNamesCompNames[i], '');
569 XMLConfig.SetDeleteValue(CompPath+'Components/Count', CompNames.Count, 0);
570 for j:=0 to CompNames.Count-1 do
571 XMLConfig.SetDeleteValue(CompPath+'Components/Item'+IntToStr(j+1)+'/Value',
572 CompNames[j], '');
573 end;
574 except
575 on E: Exception do begin
576 DebugLn('ERROR: TCompPaletteOptions.Save: ',E.Message);
577 exit;
578 end;
579 end;
580 end;
581
Equalsnull582 function TCompPaletteOptions.Equals(Obj: TObject): boolean;
583 var
584 Source: TCompPaletteOptions;
585 begin
586 Result:=inherited Equals(Obj);
587 if not Result then exit;
588 if Obj is TCompPaletteOptions then
589 begin
590 Source:=TCompPaletteOptions(Obj);
591 // Name: do not check Name
592 if Visible<>Source.Visible then exit(false);
593 if not FHiddenPageNames.Equals(Source.FHiddenPageNames) then exit(false);
594 end;
595 end;
596
597 { TCompPaletteUserOrder }
598
599 constructor TCompPaletteUserOrder.Create(aPalette: TBaseComponentPalette);
600 begin
601 inherited Create;
602 fPalette:=aPalette;
603 FComponentPages := TStringListUTF8Fast.Create;
604 FComponentPages.OwnsObjects := True;
605 end;
606
607 destructor TCompPaletteUserOrder.Destroy;
608 begin
609 Clear;
610 FreeAndNil(FComponentPages);
611 inherited Destroy;
612 end;
613
614 procedure TCompPaletteUserOrder.Clear;
615 begin
616 inherited Clear;
617 FComponentPages.Clear;
618 end;
619
620 procedure TCompPaletteUserOrder.Assign(Source: TCompPaletteUserOrder);
621 var
622 i: Integer;
623 nm, ty: String;
624 obj: TObject;
625 begin
626 inherited Assign(Source);
627 FComponentPages.Clear;
628 for i:=0 to Source.FComponentPages.Count-1 do
629 begin
630 nm := Source.FComponentPages[i];
631 obj := Source.FComponentPages.Objects[i];
632 ty := obj.ClassName;
633 AssignCompPage(nm, obj as TRegisteredCompList);
634 end;
635 end;
636
637 procedure TCompPaletteUserOrder.AssignCompPage(aPageName: string; aList: TRegisteredCompList);
638 var
639 rcl: TRegisteredCompList;
640 begin
641 rcl := TRegisteredCompList.Create;
642 rcl.Assign(aList);
643 FComponentPages.AddObject(aPageName, rcl);
644 end;
645
Equalsnull646 function TCompPaletteUserOrder.Equals(Obj: TObject): boolean;
647 var
648 Source: TCompPaletteUserOrder;
649 i: Integer;
650 MyList, SrcList: TRegisteredCompList;
651 begin
652 Result:=inherited Equals(Obj);
653 if not Result then exit;
654 if Obj is TCompPaletteUserOrder then
655 begin
656 Source:=TCompPaletteUserOrder(Obj);
657 if FComponentPages.Count<>Source.FComponentPages.Count then exit(false);
658 for i:=0 to Source.FComponentPages.Count-1 do
659 begin
660 MyList:=FComponentPages.Objects[i] as TRegisteredCompList;
661 SrcList:=Source.FComponentPages.Objects[i] as TRegisteredCompList;
662 if not MyList.Equals(SrcList) then exit(false);
663 end;
664 Result:=true;
665 end;
666 end;
667
SortPagesAndCompsUserOrdernull668 function TCompPaletteUserOrder.SortPagesAndCompsUserOrder: Boolean;
669 // Calculate page order using user config and default order. User config takes priority.
670 // This order will finally be shown in the palette.
671 var
672 DstComps: TRegisteredCompList;
673 RegComp: TRegisteredComponent;
674 sl: TStringList;
675 PgName: String;
676 PageI, i, j: Integer;
677 begin
678 Result:=True;
679 Clear;
680 fPalette.CacheOrigComponentPages;
681 // First add user defined page order from EnvironmentOptions,
682 FComponentPages.Assign(fOptions.FPageNames);
683 // then add other pages which don't have user configuration
684 for PageI := 0 to fPalette.OrigPagePriorities.Count-1 do
685 begin
686 PgName:=fPalette.OrigPagePriorities.Keys[PageI];
687 if (FComponentPages.IndexOf(PgName) = -1)
688 and (fOptions.FHiddenPageNames.IndexOf(PgName) = -1) then
689 FComponentPages.Add(PgName);
690 end;
691 // Map components with their pages
692 for PageI := 0 to FComponentPages.Count-1 do
693 begin
694 PgName := FComponentPages[PageI];
695 DstComps := TRegisteredCompList.Create;
696 FComponentPages.Objects[PageI] := DstComps;
697 i := fOptions.FPageNamesCompNames.IndexOf(PgName);
698 if i >= 0 then begin // Add components reordered by user.
699 sl := fOptions.FPageNamesCompNames.Objects[i] as TStringList;
700 for j := 0 to sl.Count-1 do
701 begin
702 RegComp := fPalette.FindRegComponent(sl[j]);
703 DstComps.Add(RegComp);
704 end;
705 end
706 else // Add components that were not reordered.
707 fPalette.AssignOrigCompsForPage(PgName, DstComps);
708 end;
709 end;
710
711 { TRegisteredComponent }
712
713 procedure TRegisteredComponent.SetVisible(const AValue: boolean);
714 begin
715 if FVisible=AValue then exit;
716 FVisible:=AValue;
717 if (FRealPage<>nil) then
718 FRealPage.OnComponentVisibleChanged(Self);
719 end;
720
721 constructor TRegisteredComponent.Create(TheComponentClass: TComponentClass;
722 const ThePageName: string);
723 begin
724 FComponentClass:=TheComponentClass;
725 FOrigPageName:=ThePageName;
726 FVisible:=true;
727 end;
728
729 destructor TRegisteredComponent.Destroy;
730 begin
731 if Assigned(FRealPage) and Assigned(FRealPage.Palette) then
732 FRealPage.Palette.RemoveRegComponent(Self);
733 inherited Destroy;
734 end;
735
736 procedure TRegisteredComponent.ConsistencyCheck;
737 begin
738 if (FComponentClass=nil) then
739 raise Exception.Create('TRegisteredComponent.ConsistencyCheck FComponentClass=nil');
740 if not IsValidIdent(FComponentClass.ClassName) then
741 raise Exception.Create('TRegisteredComponent.ConsistencyCheck not IsValidIdent(FComponentClass.ClassName)');
742 end;
743
GetPrioritynull744 function TRegisteredComponent.GetPriority: TComponentPriority;
745 begin
746 Result:=ComponentPriorityNormal;
747 end;
748
749 procedure TRegisteredComponent.AddToPalette;
750 begin
751 IDEComponentPalette.AddRegComponent(Self);
752 end;
753
CanBeCreatedInDesignernull754 function TRegisteredComponent.CanBeCreatedInDesigner: boolean;
755 begin
756 Result:=true;
757 end;
758
GetCreationClassnull759 function TRegisteredComponent.GetCreationClass: TComponentClass;
760 begin
761 Result:=FComponentClass;
762 if Assigned(OnGetCreationClass) then
763 OnGetCreationClass(Self,Result);
764 end;
765
766 { TBaseComponentPage }
767
768 constructor TBaseComponentPage.Create(const ThePageName: string);
769 begin
770 FPageName:=ThePageName;
771 FVisible:=FPageName<>'';
772 end;
773
774 destructor TBaseComponentPage.Destroy;
775 begin
776 inherited Destroy;
777 end;
778
779 procedure TBaseComponentPage.SetVisible(const AValue: boolean);
780 begin
781 if FVisible=AValue then exit;
782 FVisible:=AValue;
783 //if (FPalette<>nil) then
784 // FPalette.OnPageVisibleChanged(Self);
785 end;
786
787 procedure TBaseComponentPage.OnComponentVisibleChanged(AComponent: TRegisteredComponent);
788 begin
789
790 end;
791
792 { TBaseComponentPalette }
793
794 constructor TBaseComponentPalette.Create(EnvPaletteOptions: TCompPaletteOptions);
795 begin
796 fSelectionMode:=csmSingle;
797 fPages:=TBaseComponentPageList.Create;
798 fComps:=TRegisteredCompList.Create;
799 fOrigPagePriorities:=TPagePriorityList.Create;
800 fUserOrder:=TCompPaletteUserOrder.Create(Self);
801 fUserOrder.Options:=EnvPaletteOptions; // EnvironmentOptions.ComponentPaletteOptions;
802 fComponentCache:=TAVLTree.Create(@CompareIDEComponentByClass);
803 fOrigComponentPageCache:=TStringList.Create;
804 fOrigComponentPageCache.OwnsObjects:=True;
805 {$IF FPC_FULLVERSION>=30200}fOrigComponentPageCache.UseLocale:=False;{$ENDIF}
806 fOrigComponentPageCache.CaseSensitive:=True;
807 fOrigComponentPageCache.Sorted:=True;
808 fUserComponentPageCache:=TStringList.Create;
809 fUserComponentPageCache.OwnsObjects:=True;
810 {$IF FPC_FULLVERSION>=30200}fUserComponentPageCache.UseLocale:=False;{$ENDIF}
811 fUserComponentPageCache.CaseSensitive:=True;
812 fUserComponentPageCache.Sorted:=True;
813 fOrigPageHelper:=TStringListUTF8Fast.Create; // Note: CaseSensitive = False
814 fOrigPageHelper.Sorted:=True;
815 fLastFoundCompClassName:='';
816 fLastFoundRegComp:=Nil;
817 end;
818
819 destructor TBaseComponentPalette.Destroy;
820 var
821 HandlerType: TComponentPaletteHandlerType;
822 begin
823 Clear;
824 FreeAndNil(fOrigPageHelper);
825 FreeAndNil(fUserComponentPageCache);
826 FreeAndNil(fOrigComponentPageCache);
827 FreeAndNil(fComponentCache);
828 FreeAndNil(fUserOrder);
829 FreeAndNil(fOrigPagePriorities);
830 FreeAndNil(fComps);
831 FreeAndNil(fPages);
832 for HandlerType:=Low(HandlerType) to High(HandlerType) do
833 FHandlers[HandlerType].Free;
834 inherited Destroy;
835 end;
836
837 procedure TBaseComponentPalette.Clear;
838 var
839 i: Integer;
840 begin
841 for i:=0 to fPages.Count-1 do
842 fPages[i].Free;
843 fPages.Clear;
844 for i:=0 to fComps.Count-1 do
845 fComps[i].RealPage:=nil;
846 fComps.Clear;
847 fOrigPagePriorities.Clear;
848 fOrigPageHelper.Clear;
849 end;
850
851 procedure TBaseComponentPalette.CacheOrigComponentPages;
852 var
853 PageI, CompI: Integer;
854 PgName: string;
855 RegComp: TRegisteredComponent;
856 RegComps: TRegisteredCompList;
857 begin
858 if fOrigComponentPageCache.Count > 0 then Exit; // Fill cache only once.
859 for PageI := 0 to fOrigPagePriorities.Count-1 do
860 begin
861 PgName:=fOrigPagePriorities.Keys[PageI];
862 Assert((PgName <> '') and not fOrigComponentPageCache.Find(PgName, CompI),
863 Format('CacheComponentPages: %s already cached.', [PgName]));
864 // Add a cache StringList for this page name.
865 RegComps := TRegisteredCompList.Create;
866 fOrigComponentPageCache.AddObject(PgName, RegComps);
867 // Find all components for this page and add them to cache.
868 for CompI := 0 to fComps.Count-1 do begin
869 RegComp := fComps[CompI];
870 if RegComp.OrigPageName = PgName then // case sensitive!
871 RegComps.Add(RegComp);
872 end;
873 end;
874 end;
875
CreatePagesFromUserOrdernull876 function TBaseComponentPalette.CreatePagesFromUserOrder: Boolean;
877 var
878 UserPageI, CurPgInd, CompI: Integer;
879 aVisibleCompCnt: integer;
880 PgName: String;
881 Pg: TBaseComponentPage;
882 RegiComps, UserRegComps: TRegisteredCompList;
883 RegComp: TRegisteredComponent;
884 begin
885 Result := True;
886 fUserComponentPageCache.Clear;
887 for UserPageI := 0 to fUserOrder.ComponentPages.Count-1 do
888 begin
889 PgName := fUserOrder.ComponentPages[UserPageI];
890 CurPgInd := IndexOfPageName(PgName, True);
891 if CurPgInd = -1 then begin
892 // Create a new page
893 {$IFDEF VerboseComponentPalette}
894 DebugLn(['TComponentPalette.CreatePagesFromUserOrder, page ', PgName, ' index ',UserPageI]);
895 {$ENDIF}
896 Pg := ComponentPageClass.Create(PgName);
897 fPages.Insert(UserPageI, Pg);
898 Pg.Palette := Self;
899 end
900 else if CurPgInd <> UserPageI then begin
901 {$IFDEF VerboseComponentPalette}
902 DebugLn(['TComponentPalette.CreatePagesFromUserOrder, move ', PgName, ' from ',CurPgInd, ' to ',UserPageI]);
903 {$ENDIF}
904 fPages.Move(CurPgInd, UserPageI); // Move page to right place.
905 end;
906 Pg := Pages[UserPageI];
907 Pg.FIndex := UserPageI;
908 Assert(PgName = Pg.PageName,
909 Format('TComponentPalette.CreatePagesFromUserOrder: Page names differ, "%s" and "%s".',
910 [PgName, Pg.PageName]));
911 // New cache page
912 UserRegComps := TRegisteredCompList.Create;
913 fUserComponentPageCache.AddObject(PgName, UserRegComps);
914 // Associate components belonging to this page
915 aVisibleCompCnt := 0;
916 RegiComps := fUserOrder.ComponentPages.Objects[UserPageI] as TRegisteredCompList;
917 for CompI := 0 to RegiComps.Count-1 do
918 begin
919 RegComp := RegiComps[CompI];
920 if RegComp = nil then Continue;
921 RegComp.RealPage := Pg;
922 UserRegComps.Add(RegComp);
923 if VoteCompVisibility(RegComp) then
924 inc(aVisibleCompCnt);
925 end;
926 {$IFDEF VerboseComponentPalette}
927 if PgName=CompPalVerbPgName then
928 debugln(['TComponentPalette.CreatePagesFromUserOrder HideControls=',HideControls,' aVisibleCompCnt=',aVisibleCompCnt]);
929 {$ENDIF}
930 Pg.Visible := (CompareText(PgName,'Hidden')<>0) and (aVisibleCompCnt>0);
931 end;
932 // Remove left-over pages.
933 while fPages.Count > fUserOrder.ComponentPages.Count do begin
934 Pg := fPages[fPages.Count-1];
935 {$IFDEF VerboseComponentPalette}
936 DebugLn(['TComponentPalette.CreatePagesFromUserOrder: Deleting left-over page=',
937 Pg.PageName, ', Index=', fPages.Count-1]);
938 {$ENDIF}
939 fPages.Delete(fPages.Count-1);
940 Pg.Free;
941 end;
942 end;
943
AssignOrigCompsForPagenull944 function TBaseComponentPalette.AssignOrigCompsForPage(PageName: string;
945 DestComps: TRegisteredCompList): Boolean;
946 // Returns True if the page was found.
947 var
948 rcl: TRegisteredCompList;
949 i: Integer;
950 begin
951 Result := fOrigComponentPageCache.Find(PageName, i);
952 if Result then begin
953 rcl := fOrigComponentPageCache.Objects[i] as TRegisteredCompList;
954 DestComps.Assign(rcl);
955 end
956 else
957 DestComps.Clear;
958 //raise Exception.Create(Format('AssignOrigCompsForPage: %s not found in cache.', [PageName]));
959 end;
960
AssignOrigVisibleCompNamesnull961 function TBaseComponentPalette.AssignOrigVisibleCompNames(PageName: string;
962 DestCompNames: TStringList): Boolean;
963 // Returns True if the page was found.
964 var
965 rcl: TRegisteredCompList;
966 i: Integer;
967 begin
968 DestCompNames.Clear;
969 Result := fOrigComponentPageCache.Find(PageName, i);
970 if not Result then Exit;
971 rcl := fOrigComponentPageCache.Objects[i] as TRegisteredCompList;
972 for i := 0 to rcl.Count-1 do
973 if rcl[i].Visible then
974 DestCompNames.Add(rcl[i].ComponentClass.ClassName);
975 end;
976
RefUserCompsForPagenull977 function TBaseComponentPalette.RefUserCompsForPage(PageName: string): TRegisteredCompList;
978 var
979 i: Integer;
980 begin
981 if fUserComponentPageCache.Find(PageName, i) then
982 Result := fUserComponentPageCache.Objects[i] as TRegisteredCompList
983 else
984 Result := Nil;
985 end;
986
GetSelectednull987 function TBaseComponentPalette.GetSelected: TRegisteredComponent;
988 begin
989 Result := fSelected;
990 end;
991
GetMultiSelectnull992 function TBaseComponentPalette.GetMultiSelect: boolean;
993 begin
994 Result := FSelectionMode = csmMulty;
995 end;
996
997 procedure TBaseComponentPalette.SetSelected(const AValue: TRegisteredComponent);
998 begin
999 if fSelected=AValue then exit;
1000 fSelected:=AValue;
1001 if fSelected<>nil then begin
1002 if (fSelected.RealPage=nil) or (fSelected.RealPage.Palette<>Self)
1003 or (not fSelected.Visible)
1004 or (not fSelected.CanBeCreatedInDesigner) then
1005 fSelected:=nil;
1006 end;
1007 DoAfterSelectionChanged;
1008 end;
1009
1010 procedure TBaseComponentPalette.SetMultiSelect(AValue: boolean);
1011 begin
1012 if AValue then
1013 FSelectionMode := csmMulty
1014 else
1015 FSelectionMode := csmSingle;
1016 end;
1017
1018 procedure TBaseComponentPalette.AddHandler(HandlerType: TComponentPaletteHandlerType;
1019 const AMethod: TMethod; AsLast: boolean);
1020 begin
1021 if FHandlers[HandlerType]=nil then
1022 FHandlers[HandlerType]:=TMethodList.Create;
1023 FHandlers[HandlerType].Add(AMethod,AsLast);
1024 end;
1025
1026 procedure TBaseComponentPalette.RemoveHandler(HandlerType: TComponentPaletteHandlerType;
1027 const AMethod: TMethod);
1028 begin
1029 FHandlers[HandlerType].Remove(AMethod);
1030 end;
1031
1032 procedure TBaseComponentPalette.DoPageAddedComponent(Component: TRegisteredComponent);
1033 begin
1034 fComponentCache.Add(Component);
1035 DoChange;
1036 end;
1037
1038 procedure TBaseComponentPalette.DoPageRemovedComponent(Component: TRegisteredComponent);
1039 begin
1040 fComponentCache.Remove(Component);
1041 DoChange;
1042 end;
1043
1044 procedure TBaseComponentPalette.SetHideControls(AValue: boolean);
1045 begin
1046 if FHideControls=AValue then Exit;
1047 FHideControls:=AValue;
1048 FChanged:=True;
1049 end;
1050
1051 procedure TBaseComponentPalette.IncChangeStamp;
1052 begin
1053 Inc(fChangeStamp);
1054 end;
1055
IndexOfPageNamenull1056 function TBaseComponentPalette.IndexOfPageName(const APageName: string;
1057 ACaseSensitive: Boolean): integer;
1058 begin
1059 Result:=Pages.Count-1;
1060 if ACaseSensitive then
1061 begin // Case sensitive search
1062 while (Result>=0) and (Pages[Result].PageName <> APageName) do
1063 dec(Result);
1064 end
1065 else begin // Case in-sensitive search
1066 while (Result>=0) and (AnsiCompareText(Pages[Result].PageName,APageName)<>0) do
1067 dec(Result);
1068 end;
1069 end;
1070
GetPagenull1071 function TBaseComponentPalette.GetPage(const APageName: string;
1072 ACaseSensitive: Boolean=False): TBaseComponentPage;
1073 var
1074 i: Integer;
1075 begin
1076 i:=IndexOfPageName(APageName, ACaseSensitive);
1077 if i>=0 then
1078 Result:=Pages[i]
1079 else
1080 Result:=nil;
1081 end;
1082
1083 procedure TBaseComponentPalette.AddRegComponent(NewComponent: TRegisteredComponent);
1084 var
1085 NewPriority: TComponentPriority;
1086 InsertIndex: Integer;
1087 begin
1088 // Store components to fComps, sorting them by priority.
1089 NewPriority:=NewComponent.GetPriority;
1090 InsertIndex:=0;
1091 while (InsertIndex<fComps.Count)
1092 and (ComparePriority(NewPriority,fComps[InsertIndex].GetPriority)<=0) do
1093 inc(InsertIndex);
1094 fComps.Insert(InsertIndex,NewComponent);
1095 DoPageAddedComponent(NewComponent);
1096
1097 if NewComponent.FOrigPageName = '' then Exit;
1098
1099 // See if page was added with different char case. Use the first version always.
1100 if fOrigPageHelper.Find(NewComponent.FOrigPageName, InsertIndex) then begin
1101 NewComponent.FOrigPageName := fOrigPageHelper[InsertIndex]; // Possibly different case
1102 Assert(fOrigPagePriorities.IndexOf(NewComponent.FOrigPageName) >= 0,
1103 'TBaseComponentPalette.AddComponent: FOrigPageName not found!');
1104 end
1105 else begin
1106 fOrigPageHelper.Add(NewComponent.FOrigPageName);
1107 Assert(fOrigPagePriorities.IndexOf(NewComponent.FOrigPageName) = -1,
1108 'TBaseComponentPalette.AddComponent: FOrigPageName exists but it should not!');
1109 // Store a list of page names and their priorities.
1110 InsertIndex:=0;
1111 while (InsertIndex<fOrigPagePriorities.Count)
1112 and (ComparePriority(NewPriority, fOrigPagePriorities.Data[InsertIndex])<=0) do
1113 inc(InsertIndex);
1114 fOrigPagePriorities.InsertKeyData(InsertIndex, NewComponent.FOrigPageName, NewPriority);
1115 end;
1116 end;
1117
1118 procedure TBaseComponentPalette.RemoveRegComponent(AComponent: TRegisteredComponent);
1119 begin
1120 fComps.Remove(AComponent);
1121 AComponent.RealPage:=nil;
1122 //ToDo: fix DoPageRemovedComponent(AComponent);
1123 end;
1124
FindRegComponentnull1125 function TBaseComponentPalette.FindRegComponent(ACompClass: TClass): TRegisteredComponent;
1126 // Return registered component based on LCL component class type.
1127 // Optimized with balanced tree fComponentCache.
1128 var
1129 ANode: TAVLTreeNode;
1130 begin
1131 ANode:=fComponentCache.FindKey(ACompClass, @CompareClassWithIDEComponent);
1132 if ANode<>nil then
1133 Result:=TRegisteredComponent(ANode.Data)
1134 else
1135 Result:=nil;
1136 end;
1137
FindRegComponentnull1138 function TBaseComponentPalette.FindRegComponent(const ACompClassName: string): TRegisteredComponent;
1139 // Return registered component based on LCL component class name.
1140 var
1141 i: Integer;
1142 begin
1143 // A small optimization. If same type is asked many times, return it quickly.
1144 if ACompClassName = fLastFoundCompClassName then
1145 Exit(fLastFoundRegComp);
1146 // Linear search. Can be optimized if needed.
1147 for i := 0 to fComps.Count-1 do
1148 if fComps[i].ComponentClass.ClassName = ACompClassName then
1149 begin
1150 fLastFoundCompClassName := ACompClassName;
1151 fLastFoundRegComp := fComps[i];
1152 Exit(fLastFoundRegComp);
1153 end;
1154 Result:=nil;
1155 end;
1156
CreateNewClassNamenull1157 function TBaseComponentPalette.CreateNewClassName(const Prefix: string): string;
1158 var
1159 i: Integer;
1160 begin
1161 if FindRegComponent(Prefix)=nil then begin
1162 Result:=Prefix+'1';
1163 end else begin
1164 i:=1;
1165 repeat
1166 Result:=Prefix+IntToStr(i);
1167 inc(i);
1168 until FindRegComponent(Result)=nil;
1169 end;
1170 end;
1171
1172 procedure TBaseComponentPalette.Update(ForceUpdateAll: Boolean);
1173 begin
1174 fUserOrder.SortPagesAndCompsUserOrder;
1175 CreatePagesFromUserOrder;
1176 end;
1177
1178 procedure TBaseComponentPalette.IterateRegisteredClasses(Proc: TGetComponentClassEvent);
1179 var
1180 i: Integer;
1181 begin
1182 for i:=0 to fComps.Count-1 do
1183 Proc(fComps[i].ComponentClass);
1184 end;
1185
1186 procedure TBaseComponentPalette.SetSelectedComp(AComponent: TRegisteredComponent; AMulti: Boolean);
1187 begin
1188 MultiSelect := AMulti;
1189 Selected := AComponent;
1190 end;
1191
1192 // Execute handlers
1193
VoteCompVisibilitynull1194 function TBaseComponentPalette.VoteCompVisibility(AComponent: TRegisteredComponent): Boolean;
1195 var
1196 i, Vote: Integer;
1197 begin
1198 Vote:=1;
1199 if HideControls and AComponent.ComponentClass.InheritsFrom(TControl) then
1200 Dec(Vote);
1201 i:=FHandlers[cphtUpdateVisible].Count;
1202 while FHandlers[cphtUpdateVisible].NextDownIndex(i) do
1203 TUpdateCompVisibleEvent(FHandlers[cphtUpdateVisible][i])(AComponent,Vote);
1204 Result:=Vote>0;
1205 AComponent.Visible:=Result;
1206 end;
1207
1208 procedure TBaseComponentPalette.DoAfterComponentAdded(ALookupRoot,
1209 AComponent: TComponent; ARegisteredComponent: TRegisteredComponent);
1210 var
1211 i: Integer;
1212 begin
1213 i:=FHandlers[cphtComponentAdded].Count;
1214 while FHandlers[cphtComponentAdded].NextDownIndex(i) do
1215 TComponentAddedEvent(FHandlers[cphtComponentAdded][i])(ALookupRoot, AComponent, ARegisteredComponent);
1216 end;
1217
1218 procedure TBaseComponentPalette.DoAfterSelectionChanged;
1219 var
1220 i: Integer;
1221 begin
1222 i:=FHandlers[cphtSelectionChanged].Count;
1223 while FHandlers[cphtSelectionChanged].NextDownIndex(i) do
1224 TPaletteHandlerEvent(FHandlers[cphtSelectionChanged][i])();
1225 end;
1226
1227 procedure TBaseComponentPalette.RemoveAllHandlersOfObject(AnObject: TObject);
1228 var
1229 HandlerType: TComponentPaletteHandlerType;
1230 begin
1231 for HandlerType:=Low(HandlerType) to High(HandlerType) do
1232 FHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
1233 end;
1234
1235 // Add / Remove handlers
1236
1237 // UpdateVisible
1238 procedure TBaseComponentPalette.AddHandlerUpdateVisible(
1239 const OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent; AsLast: boolean);
1240 begin
1241 AddHandler(cphtUpdateVisible,TMethod(OnUpdateCompVisibleEvent),AsLast);
1242 end;
1243
1244 procedure TBaseComponentPalette.RemoveHandlerUpdateVisible(
1245 OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent);
1246 begin
1247 RemoveHandler(cphtUpdateVisible,TMethod(OnUpdateCompVisibleEvent));
1248 end;
1249
1250 // ComponentAdded
1251 procedure TBaseComponentPalette.AddHandlerComponentAdded(
1252 OnComponentAddedEvent: TComponentAddedEvent);
1253 begin
1254 AddHandler(cphtComponentAdded,TMethod(OnComponentAddedEvent));
1255 end;
1256
1257 procedure TBaseComponentPalette.RemoveHandlerComponentAdded(
1258 OnComponentAddedEvent: TComponentAddedEvent);
1259 begin
1260 RemoveHandler(cphtComponentAdded,TMethod(OnComponentAddedEvent));
1261 end;
1262
1263 // SelectionChanged
1264 procedure TBaseComponentPalette.AddHandlerSelectionChanged(
1265 OnSelectionChangedEvent: TPaletteHandlerEvent);
1266 begin
1267 AddHandler(cphtSelectionChanged,TMethod(OnSelectionChangedEvent));
1268 end;
1269
1270 procedure TBaseComponentPalette.RemoveHandlerSelectionChanged(
1271 OnSelectionChangedEvent: TPaletteHandlerEvent);
1272 begin
1273 RemoveHandler(cphtSelectionChanged,TMethod(OnSelectionChangedEvent));
1274 end;
1275
1276 end.
1277
1278