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