← Back to branch summary

~ubuntu-branches/ubuntu/vivid/lazarus/vivid

« back to all changes in this revision

Viewing changes to components/ideintf/componentreg.pas

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Paul Gevers
  • Date: 2014-02-22 10:25:57 UTC
  • mfrom: (1.1.11)
  • Revision ID: package-import@ubuntu.com-20140222102557-ors9d31r84nz31jq
Tags: 1.2~rc2+dfsg-1
http://bugs.debian.org/724776
[ Abou Al Montacir ]
* New upstream pre-release.
  + Moved ideintf to components directory.
  + Added new package cairocanvas.
* Remove usage of depreciated parameters form of find. (Closes: Bug#724776)
* Bumped standard version to 3.9.5.
* Clean the way handling make files generation and removal.

[ Paul Gevers ]
* Remove nearly obsolete bzip compression for binary packages
  (See https://lists.debian.org/debian-devel/2014/01/msg00542.html)
* Update d/copyright for newly added dir in examples and components
* Update Vcs-* fields with new packaging location
* Update d/watch file to properly (Debian way) change upstreams versions
* Prevent 46MB of package size by sym linking duplicate files
* Patches
  - refresh to remove fuzz
  - add more Lintian found spelling errors
  - new patch to add shbang to two scripts in lazarus-src
* Drop lcl-# from Provides list of lcl-units-#
* Make lazarus-ide-qt4-# an arch all until it really contains stuff
* Make all metapackages arch all as the usecase for arch any doesn't
  seem to warrant the addition archive hit
* Fix permissions of non-scripts in lazarus-src-#

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/ideintf/componentreg.pas
 
1
{  $Id: componentreg.pas 42732 2013-09-11 06:21:29Z juha $  }
 
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
 
15
 
 
16
  Abstract:
 
17
    Interface to the component palette and the registered component classes.
 
18
}
 
19
unit ComponentReg;
 
20
 
 
21
{$mode objfpc}{$H+}
 
22
 
 
23
interface
 
24
 
 
25
uses
 
26
  Classes, SysUtils, typinfo, Controls, ComCtrls, LazarusPackageIntf,
 
27
  LazConfigStorage, LCLProc;
 
28
 
 
29
type
 
30
  TComponentPriorityCategory = (
 
31
    cpBase,
 
32
    cpUser,            // User has changed the order using options GUI.
 
33
    cpRecommended,
 
34
    cpNormal,
 
35
    cpOptional
 
36
    );
 
37
    
 
38
  TComponentPriority = record
 
39
    Category: TComponentPriorityCategory;
 
40
    Level: integer; // higher level means higher priority (range: -1000 to 1000)
 
41
  end;
 
42
    
 
43
const
 
44
  ComponentPriorityNormal: TComponentPriority = (Category: cpNormal; Level: 0);
 
45
 
 
46
  LCLCompPriority: TComponentPriority = (Category: cpBase; Level: 10);
 
47
  FCLCompPriority: TComponentPriority = (Category: cpBase; Level: 9);
 
48
  IDEIntfCompPriority: TComponentPriority = (Category: cpBase; Level: 8);
 
49
 
 
50
type
 
51
  TBaseComponentPage = class;
 
52
  TBaseComponentPalette = class;
 
53
  TOnGetCreationClass = procedure(Sender: TObject;
 
54
                              var NewComponentClass: TComponentClass) of object;
 
55
 
 
56
  { TCompPaletteOptions }
 
57
 
 
58
  TCompPaletteOptions = class
 
59
  private
 
60
    FConfigStore: TConfigStorage;
 
61
    // Pages reordered by user.
 
62
    FPageNames: TStringList;
 
63
    // Pages removed or renamed. They must be hidden in the palette.
 
64
    FHiddenPageNames: TStringList;
 
65
    // List of page names with changed component contents.
 
66
    // Object holds another StringList for the component names.
 
67
    FComponentPages: TStringList;
 
68
  public
 
69
    constructor Create;
 
70
    destructor Destroy; override;
 
71
    procedure ClearComponentPages;
 
72
    procedure AssignComponentPages(aPageName: string; aList: TStringList);
 
73
    function Load: boolean;
 
74
    function Save: boolean;
 
75
  public
 
76
    property ConfigStore: TConfigStorage read FConfigStore write FConfigStore;
 
77
    property PageNames: TStringList read FPageNames;
 
78
    property HiddenPageNames: TStringList read FHiddenPageNames;
 
79
    property ComponentPages: TStringList read FComponentPages;
 
80
  end;
 
81
 
 
82
 
 
83
  { TRegisteredComponent }
 
84
 
 
85
  TRegisteredComponent = class
 
86
  private
 
87
    FButton: TComponent;
 
88
    FComponentClass: TComponentClass;
 
89
    FOnGetCreationClass: TOnGetCreationClass;
 
90
    FPage: TBaseComponentPage;
 
91
    FPageName: string;
 
92
    FVisible: boolean;
 
93
  protected
 
94
    procedure SetVisible(const AValue: boolean); virtual;
 
95
    procedure FreeButton;
 
96
  public
 
97
    constructor Create(TheComponentClass: TComponentClass; const ThePageName: string);
 
98
    destructor Destroy; override;
 
99
    procedure ConsistencyCheck; virtual;
 
100
    function GetUnitName: string; virtual; abstract;
 
101
    function GetPriority: TComponentPriority; virtual;
 
102
    procedure AddToPalette; virtual;
 
103
    function CanBeCreatedInDesigner: boolean; virtual;
 
104
    function GetCreationClass: TComponentClass; virtual;
 
105
    function IsTControl: boolean;
 
106
  public
 
107
    property ComponentClass: TComponentClass read FComponentClass;
 
108
    property OnGetCreationClass: TOnGetCreationClass read FOnGetCreationClass
 
109
                                                     write FOnGetCreationClass;
 
110
    property PageName: string read FPageName;
 
111
    property Page: TBaseComponentPage read FPage write FPage;
 
112
    property Button: TComponent read FButton write FButton;
 
113
    property Visible: boolean read FVisible write SetVisible;
 
114
  end;
 
115
  TRegisteredComponentClass = class of TRegisteredComponent;
 
116
 
 
117
 
 
118
  { TBaseComponentPage }
 
119
 
 
120
  TBaseComponentPage = class
 
121
  private
 
122
    FComps: TList;              // list of TRegisteredComponent
 
123
    FPageComponent: TCustomPage;
 
124
    FPageName: string;
 
125
    FPalette: TBaseComponentPalette;
 
126
    FPriority: TComponentPriority;
 
127
    FSelectButton: TComponent;
 
128
    FVisible: boolean;
 
129
    function GetItems(Index: integer): TRegisteredComponent;
 
130
  protected
 
131
    procedure SetVisible(const AValue: boolean); virtual;
 
132
    procedure OnComponentVisibleChanged(AComponent: TRegisteredComponent); virtual;
 
133
  public
 
134
    constructor Create(const ThePageName: string);
 
135
    destructor Destroy; override;
 
136
    procedure Clear;
 
137
    procedure ClearButtons;
 
138
    procedure ConsistencyCheck;
 
139
    function Count: integer;
 
140
    procedure Add(NewComponent: TRegisteredComponent);
 
141
    procedure Remove(AComponent: TRegisteredComponent);
 
142
    function FindComponent(const CompClassName: string): TRegisteredComponent;
 
143
    function FindButton(Button: TComponent): TRegisteredComponent;
 
144
    procedure UpdateVisible;
 
145
    function GetMaxComponentPriority: TComponentPriority;
 
146
  public
 
147
    property Comps[Index: integer]: TRegisteredComponent read GetItems; default;
 
148
    property PageName: string read FPageName;
 
149
    property Palette: TBaseComponentPalette read FPalette;
 
150
    property Priority: TComponentPriority read FPriority write FPriority;
 
151
    property PageComponent: TCustomPage read FPageComponent write FPageComponent;
 
152
    property SelectButton: TComponent read FSelectButton write FSelectButton;
 
153
    property Visible: boolean read FVisible write SetVisible;
 
154
  end;
 
155
  TBaseComponentPageClass = class of TBaseComponentPage;
 
156
 
 
157
 
 
158
  { TBaseComponentPalette }
 
159
  
 
160
  TComponentPaletteHandlerType = (
 
161
    cphtUpdateVisible, // visibility of component palette icons is recomputed
 
162
    cphtComponentAdded // Typically selection is changed after component was added.
 
163
    );
 
164
 
 
165
  TEndUpdatePaletteEvent = procedure(Sender: TObject; PaletteChanged: boolean) of object;
 
166
  TGetComponentClassEvent = procedure(const AClass: TComponentClass) of object;
 
167
  TUpdateCompVisibleEvent = procedure(AComponent: TRegisteredComponent;
 
168
                      var VoteVisible: integer { Visible>0 }  ) of object;
 
169
  TComponentAddedEvent = procedure of object;
 
170
  RegisterUnitComponentProc = procedure(const Page, UnitName: ShortString;
 
171
                                        ComponentClass: TComponentClass);
 
172
 
 
173
  TBaseComponentPalette = class
 
174
  private
 
175
    FPages: TList;  // list of TBaseComponentPage
 
176
    FHandlers: array[TComponentPaletteHandlerType] of TMethodList;
 
177
    FBaseComponentPageClass: TBaseComponentPageClass;
 
178
    FRegisteredComponentClass: TRegisteredComponentClass;
 
179
    FOnBeginUpdate: TNotifyEvent;
 
180
    FOnEndUpdate: TEndUpdatePaletteEvent;
 
181
    FHideControls: boolean;
 
182
    FUpdateLock: integer;
 
183
    fChanged: boolean;
 
184
    function GetPages(Index: integer): TBaseComponentPage;
 
185
    procedure AddHandler(HandlerType: TComponentPaletteHandlerType;
 
186
                         const AMethod: TMethod; AsLast: boolean = false);
 
187
    procedure RemoveHandler(HandlerType: TComponentPaletteHandlerType;
 
188
                            const AMethod: TMethod);
 
189
    procedure SetHideControls(const AValue: boolean);
 
190
  protected
 
191
    fPagesDefaultOrder: TList;  // Pages list ordered by package priorities
 
192
    // Pages ordered by user. Contains page name + another StringList
 
193
    //  for component names, just like TCompPaletteOptions.ComponentPages.
 
194
    fPagesUserOrder: TStringList;
 
195
    procedure DoChange; virtual;
 
196
    procedure DoBeginUpdate; virtual;
 
197
    procedure DoEndUpdate(Changed: boolean); virtual;
 
198
    procedure OnPageAddedComponent(Component: TRegisteredComponent); virtual;
 
199
    procedure OnPageRemovedComponent(Page: TBaseComponentPage;
 
200
                                Component: TRegisteredComponent); virtual;
 
201
    procedure OnComponentVisibleChanged(AComponent: TRegisteredComponent); virtual;
 
202
    procedure OnPageVisibleChanged(APage: TBaseComponentPage); virtual;
 
203
    procedure Update; virtual;
 
204
    procedure UpdateVisible(AComponent: TRegisteredComponent); virtual;
 
205
    function GetSelected: TRegisteredComponent; virtual;
 
206
    procedure SetBaseComponentPageClass(const AValue: TBaseComponentPageClass); virtual;
 
207
    procedure SetRegisteredComponentClass(const AValue: TRegisteredComponentClass); virtual;
 
208
    procedure SetSelected(const AValue: TRegisteredComponent); virtual;
 
209
    function SortPagesDefaultOrder: Boolean;
 
210
  public
 
211
    constructor Create;
 
212
    destructor Destroy; override;
 
213
    procedure Clear;
 
214
    procedure ClearButtons; virtual;
 
215
    procedure BeginUpdate(Change: boolean);
 
216
    procedure EndUpdate;
 
217
    function IsUpdateLocked: boolean;
 
218
    procedure DoAfterComponentAdded; virtual;
 
219
    procedure ConsistencyCheck;
 
220
    function Count: integer;
 
221
    function GetPage(const APageName: string; aCaseSens: Boolean = False): TBaseComponentPage;
 
222
    function IndexOfPageName(const APageName: string): integer;
 
223
    function IndexOfPageWithName(const APageName: string): integer;
 
224
    procedure AddComponent(NewComponent: TRegisteredComponent);
 
225
    function CreateNewPage(const NewPageName: string;
 
226
                        const Priority: TComponentPriority): TBaseComponentPage;
 
227
    function FindComponent(const CompClassName: string): TRegisteredComponent; virtual;
 
228
    function FindButton(Button: TComponent): TRegisteredComponent;
 
229
    function CreateNewClassName(const Prefix: string): string;
 
230
    function IndexOfPageComponent(AComponent: TComponent): integer;
 
231
    procedure UpdateVisible; virtual;
 
232
    procedure IterateRegisteredClasses(Proc: TGetComponentClassEvent);
 
233
    procedure RegisterCustomIDEComponents(
 
234
                        const RegisterProc: RegisterUnitComponentProc); virtual;
 
235
    procedure RemoveAllHandlersOfObject(AnObject: TObject);
 
236
    procedure AddHandlerUpdateVisible(
 
237
                        const OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent;
 
238
                        AsLast: boolean = false);
 
239
    procedure RemoveHandlerUpdateVisible(
 
240
                        const OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent);
 
241
    procedure AddHandlerComponentAdded(
 
242
                        const OnComponentAddedEvent: TComponentAddedEvent);
 
243
    procedure RemoveHandlerComponentAdded(
 
244
                        const OnComponentAddedEvent: TComponentAddedEvent);
 
245
  public
 
246
    property Pages[Index: integer]: TBaseComponentPage read GetPages; default;
 
247
    property BaseComponentPageClass: TBaseComponentPageClass
 
248
                                                   read FBaseComponentPageClass;
 
249
    property RegisteredComponentClass: TRegisteredComponentClass
 
250
                                                 read FRegisteredComponentClass;
 
251
    property UpdateLock: integer read FUpdateLock;
 
252
    property OnBeginUpdate: TNotifyEvent read FOnBeginUpdate
 
253
                                         write FOnBeginUpdate;
 
254
    property OnEndUpdate: TEndUpdatePaletteEvent read FOnEndUpdate
 
255
                                                 write FOnEndUpdate;
 
256
    property HideControls: boolean read FHideControls write SetHideControls;
 
257
    property Selected: TRegisteredComponent read GetSelected write SetSelected;
 
258
    property PagesDefaultOrder: TList read fPagesDefaultOrder;
 
259
    property PagesUserOrder: TStringList read fPagesUserOrder;
 
260
  end;
 
261
  
 
262
 
 
263
var
 
264
  IDEComponentPalette: TBaseComponentPalette = nil;
 
265
 
 
266
function ComponentPriority(Category: TComponentPriorityCategory; Level: integer): TComponentPriority;
 
267
function ComparePriority(const p1,p2: TComponentPriority): integer;
 
268
function CompareIDEComponentByClassName(Data1, Data2: pointer): integer;
 
269
function dbgs(const c: TComponentPriorityCategory): string; overload;
 
270
function dbgs(const p: TComponentPriority): string; overload;
 
271
 
 
272
implementation
 
273
 
 
274
procedure RaiseException(const Msg: string);
 
275
begin
 
276
  raise Exception.Create(Msg);
 
277
end;
 
278
 
 
279
function ComponentPriority(Category: TComponentPriorityCategory; Level: integer
 
280
  ): TComponentPriority;
 
281
begin
 
282
  Result.Category:=Category;
 
283
  Result.Level:=Level;
 
284
end;
 
285
 
 
286
function ComparePriority(const p1, p2: TComponentPriority): integer;
 
287
begin
 
288
  // lower category is better
 
289
  Result:=ord(p2.Category)-ord(p1.Category);
 
290
  if Result<>0 then exit;
 
291
  // higher level is better
 
292
  Result:=p1.Level-p2.Level;
 
293
end;
 
294
 
 
295
function CompareIDEComponentByClassName(Data1, Data2: pointer): integer;
 
296
var
 
297
  Comp1: TRegisteredComponent;
 
298
  Comp2: TRegisteredComponent;
 
299
begin
 
300
  Comp1:=TRegisteredComponent(Data1);
 
301
  Comp2:=TRegisteredComponent(Data2);
 
302
  Result:=AnsiCompareText(Comp1.ComponentClass.Classname,
 
303
                          Comp2.ComponentClass.Classname);
 
304
end;
 
305
 
 
306
function dbgs(const c: TComponentPriorityCategory): string;
 
307
begin
 
308
  Result:=GetEnumName(TypeInfo(TComponentPriorityCategory),ord(c));
 
309
end;
 
310
 
 
311
function dbgs(const p: TComponentPriority): string;
 
312
begin
 
313
  Result:='Cat='+dbgs(p.Category)+',Lvl='+IntToStr(p.Level);
 
314
end;
 
315
 
 
316
{ TCompPaletteOptions }
 
317
 
 
318
constructor TCompPaletteOptions.Create;
 
319
begin
 
320
  inherited Create;
 
321
  FPageNames := TStringList.Create;
 
322
  FHiddenPageNames := TStringList.Create;
 
323
  FComponentPages := TStringList.Create;
 
324
end;
 
325
 
 
326
destructor TCompPaletteOptions.Destroy;
 
327
var
 
328
  i: Integer;
 
329
begin
 
330
  ClearComponentPages;
 
331
  FComponentPages.Free;
 
332
  FHiddenPageNames.Free;
 
333
  FPageNames.Free;
 
334
  inherited Destroy;
 
335
end;
 
336
 
 
337
procedure TCompPaletteOptions.ClearComponentPages;
 
338
var
 
339
  i: Integer;
 
340
begin
 
341
  for i:=0 to FComponentPages.Count-1 do
 
342
    FComponentPages.Objects[i].Free;   // Free also the contained StringList.
 
343
  FComponentPages.Clear;
 
344
end;
 
345
 
 
346
procedure TCompPaletteOptions.AssignComponentPages(aPageName: string; aList: TStringList);
 
347
var
 
348
  sl: TStringList;
 
349
begin
 
350
  sl := TStringList.Create;
 
351
  sl.Assign(aList);
 
352
  FComponentPages.AddObject(aPageName, sl);
 
353
end;
 
354
 
 
355
function TCompPaletteOptions.Load: boolean;
 
356
var
 
357
  CompList: TStringList;
 
358
  Path, SubPath, CompPath: String;
 
359
  PageName, CompName: String;
 
360
  PageCount, CompCount: Integer;
 
361
  i, j: Integer;
 
362
begin
 
363
  Result:=False;
 
364
  if ConfigStore=nil then exit;
 
365
  try
 
366
    Path:='ComponentPaletteOptions/';
 
367
    //FileVersion := ConfigStore.GetValue(Path+'Version/Value',0);
 
368
 
 
369
    FPageNames.Clear;
 
370
    SubPath:=Path+'Pages/';
 
371
    PageCount:=ConfigStore.GetValue(SubPath+'Count', 0);
 
372
    for i:=1 to PageCount do begin
 
373
      PageName:=ConfigStore.GetValue(SubPath+'Item'+IntToStr(i)+'/Value', '');
 
374
      FPageNames.Add(PageName);
 
375
    end;
 
376
 
 
377
    FHiddenPageNames.Clear;
 
378
    SubPath:=Path+'HiddenPages/';
 
379
    PageCount:=ConfigStore.GetValue(SubPath+'Count', 0);
 
380
    for i:=1 to PageCount do begin
 
381
      PageName:=ConfigStore.GetValue(SubPath+'Item'+IntToStr(i)+'/Value', '');
 
382
      FHiddenPageNames.Add(PageName);
 
383
    end;
 
384
 
 
385
    ClearComponentPages;
 
386
    SubPath:=Path+'ComponentPages/';
 
387
    PageCount:=ConfigStore.GetValue(SubPath+'Count', 0);
 
388
    for i:=1 to PageCount do begin
 
389
      CompPath:=SubPath+'Page'+IntToStr(i+1)+'/';
 
390
      PageName:=ConfigStore.GetValue(CompPath+'Value', '');
 
391
      CompList:=TStringList.Create;
 
392
      CompCount:=ConfigStore.GetValue(CompPath+'Components/Count', 0);
 
393
      for j:=1 to CompCount do begin
 
394
        CompName:=ConfigStore.GetValue(CompPath+'Components/Item'+IntToStr(j)+'/Value', '');
 
395
        CompList.Add(CompName);
 
396
      end;
 
397
      FComponentPages.AddObject(PageName, CompList); // CompList is owned by FComponentPages
 
398
    end;
 
399
  except
 
400
    on E: Exception do begin
 
401
      DebugLn('ERROR: TOIOptions.Load: ',E.Message);
 
402
      exit;
 
403
    end;
 
404
  end;
 
405
  Result:=True;
 
406
end;
 
407
 
 
408
function TCompPaletteOptions.Save: boolean;
 
409
var
 
410
  CompList: TStringList;
 
411
  Path, SubPath, CompPath, ss: String;
 
412
  PageCount, CompCount: Integer;
 
413
  i, j: Integer;
 
414
begin
 
415
  Result:=False;
 
416
  if ConfigStore=nil then exit;
 
417
  try
 
418
    Path:='ComponentPaletteOptions/';
 
419
 
 
420
    SubPath:=Path+'Pages/';
 
421
    ConfigStore.SetDeleteValue(SubPath+'Count', FPageNames.Count, 0);
 
422
    for i:=0 to FPageNames.Count-1 do
 
423
      ConfigStore.SetDeleteValue(SubPath+'Item'+IntToStr(i+1)+'/Value', FPageNames[i], '');
 
424
 
 
425
    SubPath:=Path+'HiddenPages/';
 
426
    ConfigStore.SetDeleteValue(SubPath+'Count', FHiddenPageNames.Count, 0);
 
427
    for i:=0 to FHiddenPageNames.Count-1 do
 
428
      ConfigStore.SetDeleteValue(SubPath+'Item'+IntToStr(i+1)+'/Value', FHiddenPageNames[i], '');
 
429
 
 
430
    SubPath:=Path+'ComponentPages/';
 
431
    ConfigStore.SetDeleteValue(SubPath+'Count', FComponentPages.Count, 0);
 
432
    for i:=0 to FComponentPages.Count-1 do begin
 
433
      CompList:=FComponentPages.Objects[i] as TStringList;
 
434
      CompPath:=SubPath+'Page'+IntToStr(i+1)+'/';
 
435
      ConfigStore.SetDeleteValue(CompPath+'Value', FComponentPages[i], '');
 
436
      ConfigStore.SetDeleteValue(CompPath+'Components/Count', CompList.Count, 0);
 
437
      for j:=0 to CompList.Count-1 do
 
438
        ConfigStore.SetDeleteValue(CompPath+'Components/Item'+IntToStr(j+1)+'/Value', CompList[j], '');
 
439
    end;
 
440
  except
 
441
    on E: Exception do begin
 
442
      DebugLn('ERROR: TOIOptions.Save: ',E.Message);
 
443
      exit;
 
444
    end;
 
445
  end;
 
446
  Result:=true;
 
447
end;
 
448
 
 
449
{ TRegisteredComponent }
 
450
 
 
451
procedure TRegisteredComponent.SetVisible(const AValue: boolean);
 
452
begin
 
453
  if FVisible=AValue then exit;
 
454
  FVisible:=AValue;
 
455
  if (FPage<>nil) then
 
456
    FPage.OnComponentVisibleChanged(Self);
 
457
end;
 
458
 
 
459
procedure TRegisteredComponent.FreeButton;
 
460
begin
 
461
  FButton.Free;
 
462
  FButton:=nil;
 
463
end;
 
464
 
 
465
constructor TRegisteredComponent.Create(TheComponentClass: TComponentClass;
 
466
  const ThePageName: string);
 
467
begin
 
468
  FComponentClass:=TheComponentClass;
 
469
  FPageName:=ThePageName;
 
470
  FVisible:=true;
 
471
end;
 
472
 
 
473
destructor TRegisteredComponent.Destroy;
 
474
begin
 
475
  if FPage<>nil then
 
476
    FPage.Remove(Self);
 
477
  FreeButton;
 
478
  inherited Destroy;
 
479
end;
 
480
 
 
481
procedure TRegisteredComponent.ConsistencyCheck;
 
482
begin
 
483
  if (FComponentClass=nil) then
 
484
    RaiseException('TRegisteredComponent.ConsistencyCheck FComponentClass=nil');
 
485
  if not IsValidIdent(FComponentClass.ClassName) then
 
486
    RaiseException('TRegisteredComponent.ConsistencyCheck not IsValidIdent(FComponentClass.ClassName)');
 
487
end;
 
488
 
 
489
function TRegisteredComponent.GetPriority: TComponentPriority;
 
490
begin
 
491
  Result:=ComponentPriorityNormal;
 
492
end;
 
493
 
 
494
procedure TRegisteredComponent.AddToPalette;
 
495
begin
 
496
  IDEComponentPalette.AddComponent(Self);
 
497
end;
 
498
 
 
499
function TRegisteredComponent.CanBeCreatedInDesigner: boolean;
 
500
begin
 
501
  Result:=true;
 
502
end;
 
503
 
 
504
function TRegisteredComponent.GetCreationClass: TComponentClass;
 
505
begin
 
506
  Result:=FComponentClass;
 
507
  if Assigned(OnGetCreationClass) then
 
508
    OnGetCreationClass(Self,Result);
 
509
end;
 
510
 
 
511
function TRegisteredComponent.IsTControl: boolean;
 
512
begin
 
513
  Result:=ComponentClass.InheritsFrom(TControl);
 
514
end;
 
515
 
 
516
{ TBaseComponentPage }
 
517
 
 
518
function TBaseComponentPage.GetItems(Index: integer): TRegisteredComponent;
 
519
begin
 
520
  Result:=TRegisteredComponent(FComps[Index]);
 
521
end;
 
522
 
 
523
procedure TBaseComponentPage.SetVisible(const AValue: boolean);
 
524
begin
 
525
  if FVisible=AValue then exit;
 
526
  FVisible:=AValue;
 
527
  if (FPalette<>nil) then
 
528
    FPalette.OnPageVisibleChanged(Self);
 
529
end;
 
530
 
 
531
procedure TBaseComponentPage.OnComponentVisibleChanged(AComponent: TRegisteredComponent);
 
532
begin
 
533
  if FPalette<>nil then
 
534
    FPalette.OnComponentVisibleChanged(AComponent);
 
535
end;
 
536
 
 
537
constructor TBaseComponentPage.Create(const ThePageName: string);
 
538
begin
 
539
  FPageName:=ThePageName;
 
540
  FComps:=TList.Create;
 
541
  FVisible:=FPageName<>'';
 
542
end;
 
543
 
 
544
destructor TBaseComponentPage.Destroy;
 
545
begin
 
546
  Clear;
 
547
  FreeAndNil(FPageComponent);
 
548
  FreeAndNil(FSelectButton);
 
549
  FreeAndNil(FComps);
 
550
  inherited Destroy;
 
551
end;
 
552
 
 
553
procedure TBaseComponentPage.Clear;
 
554
var
 
555
  i: Integer;
 
556
begin
 
557
  ClearButtons;
 
558
  for i:=0 to FComps.Count-1 do
 
559
    Comps[i].Page:=nil;
 
560
  FComps.Clear;
 
561
end;
 
562
 
 
563
procedure TBaseComponentPage.ClearButtons;
 
564
var
 
565
  i, Cnt: Integer;
 
566
begin
 
567
  Cnt:=Count;
 
568
  for i:=0 to Cnt-1 do
 
569
    Comps[i].FreeButton;
 
570
  FreeAndNil(FSelectButton);
 
571
end;
 
572
 
 
573
procedure TBaseComponentPage.ConsistencyCheck;
 
574
begin
 
575
 
 
576
end;
 
577
 
 
578
function TBaseComponentPage.Count: integer;
 
579
begin
 
580
  Result:=FComps.Count;
 
581
end;
 
582
 
 
583
procedure TBaseComponentPage.Add(NewComponent: TRegisteredComponent);
 
584
var
 
585
  InsertIndex: Integer;
 
586
  NewPriority: TComponentPriority;
 
587
begin
 
588
  NewPriority:=NewComponent.GetPriority;
 
589
  InsertIndex:=0;
 
590
  while (InsertIndex<Count)
 
591
  and (ComparePriority(NewPriority,Comps[InsertIndex].GetPriority)<=0) do
 
592
    inc(InsertIndex);
 
593
  FComps.Insert(InsertIndex,NewComponent);
 
594
  NewComponent.Page:=Self;
 
595
  if FPalette<>nil then
 
596
    FPalette.OnPageAddedComponent(NewComponent);
 
597
end;
 
598
 
 
599
procedure TBaseComponentPage.Remove(AComponent: TRegisteredComponent);
 
600
begin
 
601
  FComps.Remove(AComponent);
 
602
  AComponent.Page:=nil;
 
603
  if FPalette<>nil then
 
604
    FPalette.OnPageRemovedComponent(Self,AComponent);
 
605
end;
 
606
 
 
607
function TBaseComponentPage.FindComponent(const CompClassName: string): TRegisteredComponent;
 
608
var
 
609
  i: Integer;
 
610
begin
 
611
  for i:=0 to Count-1 do begin
 
612
    Result:=Comps[i];
 
613
    if CompareText(Result.ComponentClass.ClassName,CompClassName)=0 then
 
614
      exit;
 
615
  end;
 
616
  Result:=nil;
 
617
end;
 
618
 
 
619
function TBaseComponentPage.FindButton(Button: TComponent): TRegisteredComponent;
 
620
var
 
621
  i: Integer;
 
622
begin
 
623
  for i:=0 to Count-1 do begin
 
624
    Result:=Comps[i];
 
625
    if Result.Button=Button then exit;
 
626
  end;
 
627
  Result:=nil;
 
628
end;
 
629
 
 
630
procedure TBaseComponentPage.UpdateVisible;
 
631
var
 
632
  i: Integer;
 
633
  HasVisibleComponents: Boolean;
 
634
begin
 
635
  if Palette<>nil then begin
 
636
    HasVisibleComponents:=false;
 
637
    for i:=0 to Count-1 do begin
 
638
      Palette.UpdateVisible(Comps[i]);
 
639
      if Comps[i].Visible then HasVisibleComponents:=true;
 
640
    end;
 
641
    Visible:=HasVisibleComponents and (PageName<>'');
 
642
  end;
 
643
end;
 
644
 
 
645
function TBaseComponentPage.GetMaxComponentPriority: TComponentPriority;
 
646
var
 
647
  i: Integer;
 
648
begin
 
649
  if Count=0 then
 
650
    Result:=ComponentPriorityNormal
 
651
  else begin
 
652
    Result:=Comps[0].GetPriority;
 
653
    for i:=1 to Count-1 do
 
654
      if ComparePriority(Comps[i].GetPriority,Result)>0 then
 
655
        Result:=Comps[i].GetPriority;
 
656
  end;
 
657
end;
 
658
 
 
659
{ TBaseComponentPalette }
 
660
 
 
661
function TBaseComponentPalette.GetPages(Index: integer): TBaseComponentPage;
 
662
begin
 
663
  Result:=TBaseComponentPage(FPages[Index]);
 
664
end;
 
665
 
 
666
procedure TBaseComponentPalette.AddHandler(HandlerType: TComponentPaletteHandlerType;
 
667
  const AMethod: TMethod; AsLast: boolean);
 
668
begin
 
669
  if FHandlers[HandlerType]=nil then
 
670
    FHandlers[HandlerType]:=TMethodList.Create;
 
671
  FHandlers[HandlerType].Add(AMethod);
 
672
end;
 
673
 
 
674
function TBaseComponentPalette.GetSelected: TRegisteredComponent;
 
675
begin
 
676
  result := nil;
 
677
end;
 
678
 
 
679
procedure TBaseComponentPalette.RemoveHandler(HandlerType: TComponentPaletteHandlerType;
 
680
  const AMethod: TMethod);
 
681
begin
 
682
  FHandlers[HandlerType].Remove(AMethod);
 
683
end;
 
684
 
 
685
procedure TBaseComponentPalette.SetHideControls(const AValue: boolean);
 
686
begin
 
687
  if FHideControls=AValue then exit;
 
688
  FHideControls:=AValue;
 
689
  UpdateVisible;
 
690
end;
 
691
 
 
692
procedure TBaseComponentPalette.SetSelected(const AValue: TRegisteredComponent);
 
693
begin
 
694
  // ignore
 
695
end;
 
696
 
 
697
procedure TBaseComponentPalette.DoChange;
 
698
begin
 
699
  if FUpdateLock>0 then
 
700
    fChanged:=true
 
701
  else
 
702
    Update;
 
703
end;
 
704
 
 
705
procedure TBaseComponentPalette.DoBeginUpdate;
 
706
begin
 
707
 
 
708
end;
 
709
 
 
710
procedure TBaseComponentPalette.DoEndUpdate(Changed: boolean);
 
711
begin
 
712
  if Assigned(OnEndUpdate) then OnEndUpdate(Self,Changed);
 
713
end;
 
714
 
 
715
procedure TBaseComponentPalette.OnPageAddedComponent(Component: TRegisteredComponent);
 
716
begin
 
717
  DoChange;
 
718
end;
 
719
 
 
720
procedure TBaseComponentPalette.OnPageRemovedComponent(
 
721
  Page: TBaseComponentPage; Component: TRegisteredComponent);
 
722
begin
 
723
  DoChange;
 
724
end;
 
725
 
 
726
procedure TBaseComponentPalette.OnComponentVisibleChanged(AComponent: TRegisteredComponent);
 
727
begin
 
728
  DoChange;
 
729
end;
 
730
 
 
731
procedure TBaseComponentPalette.OnPageVisibleChanged(APage: TBaseComponentPage);
 
732
begin
 
733
  DoChange;
 
734
end;
 
735
 
 
736
procedure TBaseComponentPalette.Update;
 
737
begin
 
738
 
 
739
end;
 
740
 
 
741
procedure TBaseComponentPalette.UpdateVisible(AComponent: TRegisteredComponent);
 
742
var
 
743
  i, Vote: Integer;
 
744
begin
 
745
  Vote:=1;
 
746
  if HideControls and AComponent.IsTControl then
 
747
    Dec(Vote);
 
748
  i:=FHandlers[cphtUpdateVisible].Count;
 
749
  while FHandlers[cphtUpdateVisible].NextDownIndex(i) do
 
750
    TUpdateCompVisibleEvent(FHandlers[cphtUpdateVisible][i])(AComponent,Vote);
 
751
  AComponent.Visible:=Vote>0;
 
752
end;
 
753
 
 
754
procedure TBaseComponentPalette.SetBaseComponentPageClass(
 
755
  const AValue: TBaseComponentPageClass);
 
756
begin
 
757
  FBaseComponentPageClass:=AValue;
 
758
end;
 
759
 
 
760
procedure TBaseComponentPalette.SetRegisteredComponentClass(
 
761
  const AValue: TRegisteredComponentClass);
 
762
begin
 
763
  FRegisteredComponentClass:=AValue;
 
764
end;
 
765
 
 
766
constructor TBaseComponentPalette.Create;
 
767
begin
 
768
  FPages:=TList.Create;
 
769
  fPagesDefaultOrder:=TList.Create;
 
770
  fPagesUserOrder:=TStringList.Create;
 
771
end;
 
772
 
 
773
destructor TBaseComponentPalette.Destroy;
 
774
var
 
775
  HandlerType: TComponentPaletteHandlerType;
 
776
  i: Integer;
 
777
begin
 
778
  Clear;
 
779
  for i := 0 to fPagesUserOrder.Count-1 do
 
780
    fPagesUserOrder.Objects[i].Free;     // Free also contained StringLists.
 
781
  FreeAndNil(fPagesUserOrder);
 
782
  FreeAndNil(fPagesDefaultOrder);
 
783
  FreeAndNil(FPages);
 
784
  for HandlerType:=Low(HandlerType) to High(HandlerType) do
 
785
    FHandlers[HandlerType].Free;
 
786
  inherited Destroy;
 
787
end;
 
788
 
 
789
procedure TBaseComponentPalette.Clear;
 
790
var
 
791
  i: Integer;
 
792
begin
 
793
  for i:=0 to FPages.Count-1 do
 
794
    Pages[i].Free;
 
795
  FPages.Clear;
 
796
end;
 
797
 
 
798
procedure TBaseComponentPalette.ClearButtons;
 
799
var
 
800
  Cnt: Integer;
 
801
  i: Integer;
 
802
begin
 
803
  Cnt:=Count;
 
804
  for i:=0 to Cnt-1 do
 
805
    Pages[i].ClearButtons;
 
806
end;
 
807
 
 
808
procedure TBaseComponentPalette.BeginUpdate(Change: boolean);
 
809
begin
 
810
  inc(FUpdateLock);
 
811
  if FUpdateLock=1 then begin
 
812
    fChanged:=Change;
 
813
    DoBeginUpdate;
 
814
    if Assigned(OnBeginUpdate) then OnBeginUpdate(Self);
 
815
  end else
 
816
    fChanged:=fChanged or Change;
 
817
end;
 
818
 
 
819
procedure TBaseComponentPalette.EndUpdate;
 
820
begin
 
821
  if FUpdateLock<=0 then RaiseException('TBaseComponentPalette.EndUpdate');
 
822
  dec(FUpdateLock);
 
823
  if FUpdateLock=0 then DoEndUpdate(fChanged);
 
824
end;
 
825
 
 
826
function TBaseComponentPalette.IsUpdateLocked: boolean;
 
827
begin
 
828
  Result:=FUpdateLock>0;
 
829
end;
 
830
 
 
831
procedure TBaseComponentPalette.DoAfterComponentAdded;
 
832
var
 
833
  i: Integer;
 
834
begin
 
835
  i:=FHandlers[cphtComponentAdded].Count;
 
836
  while FHandlers[cphtComponentAdded].NextDownIndex(i) do
 
837
    TComponentAddedEvent(FHandlers[cphtComponentAdded][i])();
 
838
end;
 
839
 
 
840
procedure TBaseComponentPalette.ConsistencyCheck;
 
841
begin
 
842
 
 
843
end;
 
844
 
 
845
function TBaseComponentPalette.Count: integer;
 
846
begin
 
847
  Result:=FPages.Count;
 
848
end;
 
849
 
 
850
function TBaseComponentPalette.GetPage(const APageName: string;
 
851
  aCaseSens: Boolean = False): TBaseComponentPage;
 
852
var
 
853
  i: Integer;
 
854
begin
 
855
  if aCaseSens then
 
856
    i:=IndexOfPageName(APageName)
 
857
  else
 
858
    i:=IndexOfPageWithName(APageName);
 
859
  if i>=0 then
 
860
    Result:=Pages[i]
 
861
  else
 
862
    Result:=nil;
 
863
end;
 
864
 
 
865
function TBaseComponentPalette.IndexOfPageName(const APageName: string): integer;
 
866
begin
 
867
  Result:=Count-1;         // Case sensitive search
 
868
  while (Result>=0) and (Pages[Result].PageName <> APageName) do
 
869
    dec(Result);
 
870
end;
 
871
 
 
872
function TBaseComponentPalette.IndexOfPageWithName(const APageName: string): integer;
 
873
begin
 
874
  Result:=Count-1;         // Case in-sensitive search
 
875
  while (Result>=0) and (AnsiCompareText(Pages[Result].PageName,APageName)<>0) do
 
876
    dec(Result);
 
877
end;
 
878
 
 
879
procedure TBaseComponentPalette.AddComponent(NewComponent: TRegisteredComponent);
 
880
var
 
881
  CurPage: TBaseComponentPage;
 
882
begin
 
883
  CurPage:=GetPage(NewComponent.PageName);
 
884
  if CurPage=nil then
 
885
    CurPage:=CreateNewPage(NewComponent.PageName,NewComponent.GetPriority);
 
886
  CurPage.Add(NewComponent);
 
887
end;
 
888
 
 
889
function TBaseComponentPalette.CreateNewPage(const NewPageName: string;
 
890
  const Priority: TComponentPriority): TBaseComponentPage;
 
891
var
 
892
  InsertIndex: Integer;
 
893
begin
 
894
  Result:=TBaseComponentPage.Create(NewPageName);
 
895
  Result.Priority:=Priority;
 
896
  InsertIndex:=0;
 
897
  while (InsertIndex<Count)
 
898
  and (ComparePriority(Priority,Pages[InsertIndex].Priority)<=0) do
 
899
    inc(InsertIndex);
 
900
  FPages.Insert(InsertIndex,Result);
 
901
  Result.FPalette:=Self;
 
902
  if CompareText(NewPageName,'Hidden')=0 then
 
903
    Result.Visible:=false;
 
904
end;
 
905
 
 
906
function TBaseComponentPalette.FindComponent(const CompClassName: string): TRegisteredComponent;
 
907
var
 
908
  i: Integer;
 
909
begin
 
910
  for i:=0 to Count-1 do begin
 
911
    Result:=Pages[i].FindComponent(CompClassName);
 
912
    if Result<>nil then exit;
 
913
  end;
 
914
  Result:=nil;
 
915
end;
 
916
 
 
917
function TBaseComponentPalette.FindButton(Button: TComponent): TRegisteredComponent;
 
918
var
 
919
  i: Integer;
 
920
begin
 
921
  for i:=0 to Count-1 do begin
 
922
    Result:=Pages[i].FindButton(Button);
 
923
    if Result<>nil then exit;
 
924
  end;
 
925
  Result:=nil;
 
926
end;
 
927
 
 
928
function TBaseComponentPalette.CreateNewClassName(const Prefix: string): string;
 
929
var
 
930
  i: Integer;
 
931
begin
 
932
  if FindComponent(Prefix)=nil then begin
 
933
    Result:=Prefix+'1';
 
934
  end else begin
 
935
    i:=1;
 
936
    repeat
 
937
      Result:=Prefix+IntToStr(i);
 
938
      inc(i);
 
939
    until FindComponent(Result)=nil;
 
940
  end;
 
941
end;
 
942
 
 
943
function TBaseComponentPalette.IndexOfPageComponent(AComponent: TComponent): integer;
 
944
begin
 
945
  if AComponent<>nil then begin
 
946
    Result:=Count-1;
 
947
    while (Result>=0) and (Pages[Result].PageComponent<>AComponent) do
 
948
      dec(Result);
 
949
  end else
 
950
    Result:=-1;
 
951
end;
 
952
 
 
953
function TBaseComponentPalette.SortPagesDefaultOrder: Boolean;
 
954
// Calculate default page order by using component priorities (without user config).
 
955
// Note: components inside a page are already ordered when they are added.
 
956
var
 
957
  CurPrio, ListPrio: TComponentPriority;
 
958
  i, PageCnt: Integer;
 
959
begin
 
960
  Result := True;
 
961
  for PageCnt:=0 to Count-1 do
 
962
  begin
 
963
    i := fPagesDefaultOrder.Count-1;
 
964
    while (i >= 0) do begin
 
965
      CurPrio := Pages[PageCnt].GetMaxComponentPriority;
 
966
      ListPrio := TBaseComponentPage(fPagesDefaultOrder[i]).GetMaxComponentPriority;
 
967
      if ComparePriority(CurPrio, ListPrio) <= 0 then Break;
 
968
      dec(i);
 
969
    end;
 
970
    fPagesDefaultOrder.Insert(i+1, Pages[PageCnt]);
 
971
  end;
 
972
end;
 
973
 
 
974
procedure TBaseComponentPalette.UpdateVisible;
 
975
var
 
976
  i: Integer;
 
977
begin
 
978
  BeginUpdate(false);
 
979
  for i:=0 to Count-1 do
 
980
    Pages[i].UpdateVisible;
 
981
  EndUpdate;
 
982
end;
 
983
 
 
984
procedure TBaseComponentPalette.IterateRegisteredClasses(Proc: TGetComponentClassEvent);
 
985
var
 
986
  i, j: Integer;
 
987
  APage: TBaseComponentPage;
 
988
begin
 
989
  for i:=0 to Count-1 do begin
 
990
    APage:=Pages[i];
 
991
    for j:=0 to APage.Count-1 do
 
992
      Proc(APage[j].ComponentClass);
 
993
  end;
 
994
end;
 
995
 
 
996
procedure TBaseComponentPalette.RegisterCustomIDEComponents(
 
997
  const RegisterProc: RegisterUnitComponentProc);
 
998
begin
 
999
 
 
1000
end;
 
1001
 
 
1002
procedure TBaseComponentPalette.RemoveAllHandlersOfObject(AnObject: TObject);
 
1003
var
 
1004
  HandlerType: TComponentPaletteHandlerType;
 
1005
begin
 
1006
  for HandlerType:=Low(HandlerType) to High(HandlerType) do
 
1007
    FHandlers[HandlerType].RemoveAllMethodsOfObject(AnObject);
 
1008
end;
 
1009
 
 
1010
procedure TBaseComponentPalette.AddHandlerUpdateVisible(
 
1011
  const OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent; AsLast: boolean);
 
1012
begin
 
1013
  AddHandler(cphtUpdateVisible,TMethod(OnUpdateCompVisibleEvent));
 
1014
end;
 
1015
 
 
1016
procedure TBaseComponentPalette.RemoveHandlerUpdateVisible(
 
1017
  const OnUpdateCompVisibleEvent: TUpdateCompVisibleEvent);
 
1018
begin
 
1019
  RemoveHandler(cphtUpdateVisible,TMethod(OnUpdateCompVisibleEvent));
 
1020
end;
 
1021
 
 
1022
procedure TBaseComponentPalette.AddHandlerComponentAdded(
 
1023
  const OnComponentAddedEvent: TComponentAddedEvent);
 
1024
begin
 
1025
  AddHandler(cphtComponentAdded,TMethod(OnComponentAddedEvent));
 
1026
end;
 
1027
 
 
1028
procedure TBaseComponentPalette.RemoveHandlerComponentAdded(
 
1029
  const OnComponentAddedEvent: TComponentAddedEvent);
 
1030
begin
 
1031
  RemoveHandler(cphtComponentAdded,TMethod(OnComponentAddedEvent));
 
1032
end;
 
1033
 
 
1034
end.
 
1035