paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 00:38:10 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Optimize ComponentPalette caches. Index by registered class instead of class name.

Browse Source 
git-svn-id: trunk@64182 -
This commit is contained in:
juha 2020-12-08 19:34:40 +00:00
parent b52cbb021d
commit ce1d8c1014
15 changed files with 320 additions and 240 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

375
components/ideintf/componentreg.pas
View File

@ -24,11 +24,11 @@ unit ComponentReg;
interface
uses
Classes, SysUtils, typinfo, Laz_AVL_Tree, fgl,
Classes, SysUtils, typinfo, Contnrs, Laz_AVL_Tree, fgl,
// LCL
Controls,
// LazUtils
LazLoggerBase, Laz2_XMLCfg, LazMethodList;
LazUtilities, LazLoggerBase, Laz2_XMLCfg, LazMethodList;
type
TComponentPriorityCategory = (
@ -54,49 +54,56 @@ const
type
TBaseComponentPage = class;
TBaseComponentPalette = class;
TRegisteredComponent = class;
TOnGetCreationClass = procedure(Sender: TObject;
var NewComponentClass: TComponentClass) of object;
{ TRegisteredCompList }
TRegisteredCompList = class(specialize TFPGList<TRegisteredComponent>)
public
function Equals(Obj: TObject): Boolean; override;
end;
{ TBaseCompPaletteOptions }
TBaseCompPaletteOptions = class
protected
// Pages reordered by user.
FPageNames: TStringList;
// List of page names with component contents.
// Object holds another StringList for the component names.
FComponentPages: TStringList;
FPageNames: TStringList; // Pages reordered by user.
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Assign(Source: TBaseCompPaletteOptions);
procedure AssignComponentPage(aPageName: string; aList: TStringList);
function Equals(Obj: TObject): boolean; override;
public
property PageNames: TStringList read FPageNames;
property ComponentPages: TStringList read FComponentPages;
end;
{ TCompPaletteOptions }
TCompPaletteOptions = class(TBaseCompPaletteOptions)
private
FName: string;
// List of page names with component names.
// Object holds another TStringList for the components.
FPageNamesCompNames: TStringList;
// Pages removed or renamed. They must be hidden in the palette.
FHiddenPageNames: TStringList;
FName: string;
FVisible: boolean;
public
constructor Create;
destructor Destroy; override;
procedure Clear;
procedure Assign(Source: TCompPaletteOptions);
procedure AssignPageCompNames(aPageName: string; aList: TStringList);
function IsDefault: Boolean;
procedure Load(XMLConfig: TXMLConfig; Path: String);
procedure Save(XMLConfig: TXMLConfig; Path: String);
function Equals(Obj: TObject): boolean; override;
public
property Name: string read FName write FName;
property PageNamesCompNames: TStringList read FPageNamesCompNames;
property HiddenPageNames: TStringList read FHiddenPageNames;
property Visible: boolean read FVisible write FVisible;
end;
@ -110,15 +117,22 @@ type
TCompPaletteUserOrder = class(TBaseCompPaletteOptions)
private
fPalette: TBaseComponentPalette;
// List of page names with component contents.
// Object holds TRegisteredComponentList for the components.
FComponentPages: TStringList;
// Reference to either EnvironmentOptions.ComponentPaletteOptions or a copy of it.
fOptions: TCompPaletteOptions;
public
constructor Create(aPalette: TBaseComponentPalette);
destructor Destroy; override;
procedure Clear;
procedure Assign(Source: TCompPaletteUserOrder);
procedure AssignCompPage(aPageName: string; aList: TRegisteredCompList);
function Equals(Obj: TObject): boolean; override;
function SortPagesAndCompsUserOrder: Boolean;
public
property ComponentPages; // all pages, ordered first by Options, then by default priority
// all pages, ordered first by Options, then by default priority
property ComponentPages: TStringList read FComponentPages;
property Options: TCompPaletteOptions read fOptions write fOptions;
end;
@ -151,8 +165,6 @@ type
property Visible: boolean read FVisible write SetVisible;
end;
TRegisteredComponentList = specialize TFPGList<TRegisteredComponent>;
{ TBaseComponentPage }
@ -205,15 +217,15 @@ type
// List of pages, created based on user ordered and original pages.
fPages: TBaseComponentPageList;
// List of all components in all pages.
fComps: TRegisteredComponentList;
fComps: TRegisteredCompList;
// New pages added and their priorities, ordered by priority.
fOrigPagePriorities: TPagePriorityList;
// User ordered + original pages and components
fUserOrder: TCompPaletteUserOrder;
// Component cache, a tree of TRegisteredComponent sorted for componentclass
fComponentCache: TAVLTree;
// Two page caches, one for original pages, one for user ordered pages.
// Lists have page names. Object holds another StringList for component names.
// Two page caches, one for original pages, one for user ordered pages,
// containing page names. Object holds TRegisteredCompList for components.
fOrigComponentPageCache: TStringList; // Original
fUserComponentPageCache: TStringList; // User ordered
// Used to find names that differ in character case only.
@ -227,6 +239,8 @@ type
fChanged: boolean;
fChangeStamp: integer;
fOnClassSelected: TNotifyEvent;
fLastFoundCompClassName: String;
fLastFoundRegComp: TRegisteredComponent;
procedure AddHandler(HandlerType: TComponentPaletteHandlerType;
const AMethod: TMethod; AsLast: boolean = false);
procedure RemoveHandler(HandlerType: TComponentPaletteHandlerType;
@ -245,18 +259,21 @@ type
constructor Create(EnvPaletteOptions: TCompPaletteOptions);
destructor Destroy; override;
procedure Clear;
function AssignOrigCompsForPage(PageName: string; DestComps: TStringList): Boolean;
function AssignOrigVisibleCompsForPage(PageName: string; DestComps: TStringList): Boolean;
function RefUserCompsForPage(PageName: string): TStringList;
function AssignOrigCompsForPage(PageName: string;
DestComps: TRegisteredCompList): Boolean;
function AssignOrigVisibleCompNames(PageName: string;
DestCompNames: TStringList): Boolean;
function RefUserCompsForPage(PageName: string): TRegisteredCompList;
procedure BeginUpdate(Change: boolean);
procedure EndUpdate;
function IsUpdateLocked: boolean;
procedure IncChangeStamp;
function IndexOfPageName(const APageName: string; ACaseSensitive: Boolean): integer;
function GetPage(const APageName: string; ACaseSensitive: Boolean=False): TBaseComponentPage;
procedure AddComponent(NewComponent: TRegisteredComponent);
procedure RemoveComponent(AComponent: TRegisteredComponent);
function FindComponent(const CompClassName: string): TRegisteredComponent;
procedure AddRegComponent(NewComponent: TRegisteredComponent);
procedure RemoveRegComponent(AComponent: TRegisteredComponent);
function FindRegComponent(ACompClass: TClass): TRegisteredComponent;
function FindRegComponent(const ACompClassName: string): TRegisteredComponent;
function CreateNewClassName(const Prefix: string): string;
procedure Update({%H-}ForceUpdateAll: Boolean); virtual;
procedure IterateRegisteredClasses(Proc: TGetComponentClassEvent);
@ -275,7 +292,6 @@ type
procedure RemoveHandlerSelectionChanged(OnSelectionChangedEvent: TPaletteHandlerEvent);
public
property Pages: TBaseComponentPageList read fPages;
property Comps: TRegisteredComponentList read fComps;
property OrigPagePriorities: TPagePriorityList read fOrigPagePriorities;
property ComponentPageClass: TBaseComponentPageClass read FComponentPageClass
write FComponentPageClass;
@ -299,7 +315,7 @@ var
function ComponentPriority(Category: TComponentPriorityCategory; Level: integer): TComponentPriority;
function ComparePriority(const p1,p2: TComponentPriority): integer;
function CompareIDEComponentByClassName(Data1, Data2: pointer): integer;
function CompareIDEComponentByClass(Data1, Data2: pointer): integer;
function dbgs(const c: TComponentPriorityCategory): string; overload;
function dbgs(const p: TComponentPriority): string; overload;
@ -324,25 +340,22 @@ begin
Result:=p1.Level-p2.Level;
end;
function CompareIDEComponentByClassName(Data1, Data2: Pointer): integer;
function CompareIDEComponentByClass(Data1, Data2: Pointer): integer;
var
Comp1: TRegisteredComponent absolute Data1;
Comp2: TRegisteredComponent absolute Data2;
begin
// The same case-insensitive compare function should be used in this function
// and in CompareClassNameWithRegisteredComponent.
Result:=ShortCompareText(Comp1.ComponentClass.Classname,
Comp2.ComponentClass.Classname);
Result:=ComparePointers(Comp1.ComponentClass, Comp2.ComponentClass);
end;
function CompareClassNameWithRegisteredComponent(Key, Data: Pointer): integer;
function CompareClassWithRegisteredComponent(Key, Data: Pointer): integer;
var
AClassName: String;
RegComp: TRegisteredComponent;
AClass: TComponentClass absolute Key;
RegComp: TRegisteredComponent absolute Data;
begin
AClassName:=String(Key);
RegComp:=TRegisteredComponent(Data);
Result:=ShortCompareText(AClassName, RegComp.ComponentClass.ClassName);
Result:=ComparePointers(AClass, RegComp.ComponentClass);
end;
function dbgs(const c: TComponentPriorityCategory): string;
@ -355,19 +368,34 @@ begin
Result:='Cat='+dbgs(p.Category)+',Lvl='+IntToStr(p.Level);
end;
{ TRegisteredCompList }
function TRegisteredCompList.Equals(Obj: TObject): Boolean;
Var
i: Longint;
Source: TRegisteredCompList;
begin
if Obj is TRegisteredCompList then
begin
Source:=TRegisteredCompList(Obj);
if Count<>Source.Count then exit(False);
For i:=0 to Count-1 do
If Items[i]<>Source[i] then exit(False);
Result:=True;
end else
Result:=inherited Equals(Obj);
end;
{ TBaseCompPaletteOptions }
constructor TBaseCompPaletteOptions.Create;
begin
inherited Create;
FPageNames := TStringList.Create;
FComponentPages := TStringList.Create;
FComponentPages.OwnsObjects := True;
end;
destructor TBaseCompPaletteOptions.Destroy;
begin
FreeAndNil(FComponentPages);
FreeAndNil(FPageNames);
inherited Destroy;
end;
@ -375,49 +403,21 @@ end;
procedure TBaseCompPaletteOptions.Clear;
begin
FPageNames.Clear;
FComponentPages.Clear;
end;
procedure TBaseCompPaletteOptions.Assign(Source: TBaseCompPaletteOptions);
var
i: Integer;
begin
FPageNames.Assign(Source.FPageNames);
FComponentPages.Clear;
for i:=0 to Source.FComponentPages.Count-1 do
AssignComponentPage(Source.FComponentPages[i],
TStringList(Source.FComponentPages.Objects[i]));
end;
procedure TBaseCompPaletteOptions.AssignComponentPage(aPageName: string; aList: TStringList);
var
sl: TStringList;
begin
sl := TStringList.Create;
sl.Assign(aList);
FComponentPages.AddObject(aPageName, sl);
end;
function TBaseCompPaletteOptions.Equals(Obj: TObject): boolean;
var
Source: TBaseCompPaletteOptions;
i, j: Integer;
MyList, SrcList: TStringList;
begin
if Obj is TBaseCompPaletteOptions then
begin
Source:=TBaseCompPaletteOptions(Obj);
if (not FPageNames.Equals(Source.FPageNames))
or (FComponentPages.Count<>Source.FComponentPages.Count) then exit(false);
for i:=0 to Source.FComponentPages.Count-1 do
begin
MyList:=TStringList(FComponentPages[i]);
SrcList:=TStringList(Source.FComponentPages[i]);
if not MyList.Equals(SrcList) then exit(false);
for j:=0 to MyList.Count-1 do
if MyList.Objects[j]<>SrcList.Objects[j] then exit(false);
end;
Result:=true;
Result:=FPageNames.Equals(Source.FPageNames);
end else
Result:=inherited Equals(Obj);
end;
@ -427,6 +427,8 @@ end;
constructor TCompPaletteOptions.Create;
begin
inherited Create;
FPageNamesCompNames := TStringList.Create;
FPageNamesCompNames.OwnsObjects := True;
FHiddenPageNames := TStringList.Create;
FVisible := True;
end;
@ -434,33 +436,54 @@ end;
destructor TCompPaletteOptions.Destroy;
begin
FHiddenPageNames.Free;
FPageNamesCompNames.Free;
inherited Destroy;
end;
procedure TCompPaletteOptions.Clear;
begin
inherited Clear;
FPageNamesCompNames.Clear;
FHiddenPageNames.Clear;
end;
procedure TCompPaletteOptions.Assign(Source: TCompPaletteOptions);
var
i: Integer;
sl: TStringList;
begin
inherited Assign(Source);
// Name: do not assign name
FPageNamesCompNames.Clear;
for i:=0 to Source.FPageNamesCompNames.Count-1 do
begin
sl := TStringList.Create;
sl.Assign(Source.FPageNamesCompNames.Objects[i] as TStringList);
FPageNamesCompNames.AddObject(Source.FPageNamesCompNames[i], sl);
end;
FHiddenPageNames.Assign(Source.FHiddenPageNames);
FVisible := Source.FVisible;
// Name: do not assign name
end;
procedure TCompPaletteOptions.AssignPageCompNames(aPageName: string; aList: TStringList);
var
sl: TStringList;
begin
sl := TStringList.Create;
sl.Assign(aList);
FPageNamesCompNames.AddObject(aPageName, sl);
end;
function TCompPaletteOptions.IsDefault: Boolean;
begin
Result := (PageNames.Count = 0)
and (ComponentPages.Count = 0)
and (FPageNamesCompNames.Count = 0)
and (HiddenPageNames.Count = 0);
end;
procedure TCompPaletteOptions.Load(XMLConfig: TXMLConfig; Path: String);
var
CompList: TStringList;
CompNames: TStringList;
SubPath, CompPath: String;
PageName, CompName: String;
PageCount, CompCount: Integer;
@ -492,19 +515,19 @@ begin
end;
// ComponentPages
FComponentPages.Clear;
FPageNamesCompNames.Clear;
SubPath:=Path+'ComponentPages/';
PageCount:=XMLConfig.GetValue(SubPath+'Count', 0);
for i:=1 to PageCount do begin
CompPath:=SubPath+'Page'+IntToStr(i)+'/';
PageName:=XMLConfig.GetValue(CompPath+'Value', '');
CompList:=TStringList.Create;
CompNames:=TStringList.Create;
CompCount:=XMLConfig.GetValue(CompPath+'Components/Count', 0);
for j:=1 to CompCount do begin
CompName:=XMLConfig.GetValue(CompPath+'Components/Item'+IntToStr(j)+'/Value', '');
CompList.Add(CompName);
end;
FComponentPages.AddObject(PageName, CompList); // CompList is owned by FComponentPages
CompNames.Add(CompName);
end; // CompNames is owned by FComponentPages
FPageNamesCompNames.AddObject(PageName, CompNames);
end;
except
on E: Exception do begin
@ -516,7 +539,7 @@ end;
procedure TCompPaletteOptions.Save(XMLConfig: TXMLConfig; Path: String);
var
CompList: TStringList;
CompNames: TStringList;
SubPath, CompPath: String;
i, j: Integer;
begin
@ -539,14 +562,15 @@ begin
SubPath:=Path+'ComponentPages/';
XMLConfig.DeletePath(SubPath);
XMLConfig.SetDeleteValue(SubPath+'Count', FComponentPages.Count, 0);
for i:=0 to FComponentPages.Count-1 do begin
CompList:=FComponentPages.Objects[i] as TStringList;
XMLConfig.SetDeleteValue(SubPath+'Count', FPageNamesCompNames.Count, 0);
for i:=0 to FPageNamesCompNames.Count-1 do begin
CompNames:=FPageNamesCompNames.Objects[i] as TStringList;
CompPath:=SubPath+'Page'+IntToStr(i+1)+'/';
XMLConfig.SetDeleteValue(CompPath+'Value', FComponentPages[i], '');
XMLConfig.SetDeleteValue(CompPath+'Components/Count', CompList.Count, 0);
for j:=0 to CompList.Count-1 do
XMLConfig.SetDeleteValue(CompPath+'Components/Item'+IntToStr(j+1)+'/Value', CompList[j], '');
XMLConfig.SetDeleteValue(CompPath+'Value', FPageNamesCompNames[i], '');
XMLConfig.SetDeleteValue(CompPath+'Components/Count', CompNames.Count, 0);
for j:=0 to CompNames.Count-1 do
XMLConfig.SetDeleteValue(CompPath+'Components/Item'+IntToStr(j+1)+'/Value',
CompNames[j], '');
end;
except
on E: Exception do begin
@ -577,26 +601,80 @@ constructor TCompPaletteUserOrder.Create(aPalette: TBaseComponentPalette);
begin
inherited Create;
fPalette:=aPalette;
FComponentPages := TStringList.Create;
FComponentPages.OwnsObjects := True;
end;
destructor TCompPaletteUserOrder.Destroy;
begin
Clear;
FreeAndNil(FComponentPages);
inherited Destroy;
end;
procedure TCompPaletteUserOrder.Clear;
begin
inherited Clear;
FComponentPages.Clear;
end;
procedure TCompPaletteUserOrder.Assign(Source: TCompPaletteUserOrder);
var
i: Integer;
nm, ty: String;
obj: TObject;
begin
inherited Assign(Source);
FComponentPages.Clear;
for i:=0 to Source.FComponentPages.Count-1 do
begin
nm := Source.FComponentPages[i];
obj := Source.FComponentPages.Objects[i];
ty := obj.ClassName;
AssignCompPage(nm, obj as TRegisteredCompList);
end;
end;
procedure TCompPaletteUserOrder.AssignCompPage(aPageName: string; aList: TRegisteredCompList);
var
rcl: TRegisteredCompList;
begin
rcl := TRegisteredCompList.Create;
rcl.Assign(aList);
FComponentPages.AddObject(aPageName, rcl);
end;
function TCompPaletteUserOrder.Equals(Obj: TObject): boolean;
var
Source: TCompPaletteUserOrder;
i: Integer;
MyList, SrcList: TRegisteredCompList;
begin
Result:=inherited Equals(Obj);
if not Result then exit;
if Obj is TCompPaletteUserOrder then
begin
Source:=TCompPaletteUserOrder(Obj);
if FComponentPages.Count<>Source.FComponentPages.Count then exit(false);
for i:=0 to Source.FComponentPages.Count-1 do
begin
MyList:=FComponentPages.Objects[i] as TRegisteredCompList;
SrcList:=Source.FComponentPages.Objects[i] as TRegisteredCompList;
if not MyList.Equals(SrcList) then exit(false);
end;
Result:=true;
end;
end;
function TCompPaletteUserOrder.SortPagesAndCompsUserOrder: Boolean;
// Calculate page order using user config and default order. User config takes priority.
// This order will finally be shown in the palette.
var
DstComps: TStringList;
PageI, i: Integer;
DstComps: TRegisteredCompList;
RegComp: TRegisteredComponent;
sl: TStringList;
PgName: String;
PageI, i, j: Integer;
begin
Result:=True;
Clear;
@ -615,12 +693,17 @@ begin
for PageI := 0 to FComponentPages.Count-1 do
begin
PgName := FComponentPages[PageI];
DstComps := TStringList.Create;
DstComps.CaseSensitive := True;
DstComps := TRegisteredCompList.Create;
FComponentPages.Objects[PageI] := DstComps;
i := fOptions.ComponentPages.IndexOf(PgName);
if i >= 0 then // Add components reordered by user.
DstComps.Assign(fOptions.ComponentPages.Objects[i] as TStringList)
i := fOptions.FPageNamesCompNames.IndexOf(PgName);
if i >= 0 then begin // Add components reordered by user.
sl := fOptions.FPageNamesCompNames.Objects[i] as TStringList;
for j := 0 to sl.Count-1 do
begin
RegComp := fPalette.FindRegComponent(sl[j]);
DstComps.Add(RegComp);
end;
end
else // Add components that were not reordered.
fPalette.AssignOrigCompsForPage(PgName, DstComps);
end;
@ -647,7 +730,7 @@ end;
destructor TRegisteredComponent.Destroy;
begin
if Assigned(FRealPage) and Assigned(FRealPage.Palette) then
FRealPage.Palette.RemoveComponent(Self);
FRealPage.Palette.RemoveRegComponent(Self);
inherited Destroy;
end;
@ -666,7 +749,7 @@ end;
procedure TRegisteredComponent.AddToPalette;
begin
IDEComponentPalette.AddComponent(Self);
IDEComponentPalette.AddRegComponent(Self);
end;
function TRegisteredComponent.CanBeCreatedInDesigner: boolean;
@ -713,11 +796,11 @@ constructor TBaseComponentPalette.Create(EnvPaletteOptions: TCompPaletteOptions)
begin
fSelectionMode:=csmSingle;
fPages:=TBaseComponentPageList.Create;
fComps:=TRegisteredComponentList.Create;
fComps:=TRegisteredCompList.Create;
fOrigPagePriorities:=TPagePriorityList.Create;
fUserOrder:=TCompPaletteUserOrder.Create(Self);
fUserOrder.Options:=EnvPaletteOptions; // EnvironmentOptions.ComponentPaletteOptions;
fComponentCache:=TAVLTree.Create(@CompareIDEComponentByClassName);
fComponentCache:=TAVLTree.Create(@CompareIDEComponentByClass);
fOrigComponentPageCache:=TStringList.Create;
fOrigComponentPageCache.OwnsObjects:=True;
fOrigComponentPageCache.CaseSensitive:=True;
@ -728,6 +811,8 @@ begin
fUserComponentPageCache.Sorted:=True;
fOrigPageHelper:=TStringList.Create; // Note: CaseSensitive = False
fOrigPageHelper.Sorted:=True;
fLastFoundCompClassName:='';
fLastFoundRegComp:=Nil;
end;
destructor TBaseComponentPalette.Destroy;
@ -764,10 +849,10 @@ end;
procedure TBaseComponentPalette.CacheOrigComponentPages;
var
sl: TStringList;
PageI, CompI: Integer;
PgName: string;
Comp: TRegisteredComponent;
RegComp: TRegisteredComponent;
RegComps: TRegisteredCompList;
begin
if fOrigComponentPageCache.Count > 0 then Exit; // Fill cache only once.
for PageI := 0 to fOrigPagePriorities.Count-1 do
@ -776,14 +861,13 @@ begin
Assert((PgName <> '') and not fOrigComponentPageCache.Find(PgName, CompI),
Format('CacheComponentPages: %s already cached.', [PgName]));
// Add a cache StringList for this page name.
sl := TStringList.Create;
sl.CaseSensitive := True;
fOrigComponentPageCache.AddObject(PgName, sl);
RegComps := TRegisteredCompList.Create;
fOrigComponentPageCache.AddObject(PgName, RegComps);
// Find all components for this page and add them to cache.
for CompI := 0 to fComps.Count-1 do begin
Comp := fComps[CompI];
if Comp.OrigPageName = PgName then // case sensitive!
sl.AddObject(Comp.ComponentClass.ClassName, Comp);
RegComp := fComps[CompI];
if RegComp.OrigPageName = PgName then // case sensitive!
RegComps.Add(RegComp);
end;
end;
end;
@ -794,8 +878,8 @@ var
aVisibleCompCnt: integer;
PgName: String;
Pg: TBaseComponentPage;
CompNames, UserComps: TStringList;
Comp: TRegisteredComponent;
RegiComps, UserRegComps: TRegisteredCompList;
RegComp: TRegisteredComponent;
begin
Result := True;
fUserComponentPageCache.Clear;
@ -824,19 +908,18 @@ begin
Format('TComponentPalette.CreatePagesFromUserOrder: Page names differ, "%s" and "%s".',
[PgName, Pg.PageName]));
// New cache page
UserComps := TStringList.Create;
UserComps.CaseSensitive := True;
fUserComponentPageCache.AddObject(PgName, UserComps);
UserRegComps := TRegisteredCompList.Create;
fUserComponentPageCache.AddObject(PgName, UserRegComps);
// Associate components belonging to this page
aVisibleCompCnt := 0;
CompNames := TStringList(fUserOrder.ComponentPages.Objects[UserPageI]);
for CompI := 0 to CompNames.Count-1 do
RegiComps := fUserOrder.ComponentPages.Objects[UserPageI] as TRegisteredCompList;
for CompI := 0 to RegiComps.Count-1 do
begin
Comp := FindComponent(CompNames[CompI]);
if not Assigned(Comp) then Continue;
Comp.RealPage := Pg;
UserComps.AddObject(CompNames[CompI], Comp);
if VoteCompVisibility(Comp) then
RegComp := RegiComps[CompI];
if RegComp = nil then Continue;
RegComp.RealPage := Pg;
UserRegComps.Add(RegComp);
if VoteCompVisibility(RegComp) then
inc(aVisibleCompCnt);
end;
{$IFDEF VerboseComponentPalette}
@ -858,44 +941,44 @@ begin
end;
function TBaseComponentPalette.AssignOrigCompsForPage(PageName: string;
DestComps: TStringList): Boolean;
DestComps: TRegisteredCompList): Boolean;
// Returns True if the page was found.
var
sl: TStringList;
rcl: TRegisteredCompList;
i: Integer;
begin
Result := fOrigComponentPageCache.Find(PageName, i);
if Result then begin
sl := fOrigComponentPageCache.Objects[i] as TStringList;
DestComps.Assign(sl);
rcl := fOrigComponentPageCache.Objects[i] as TRegisteredCompList;
DestComps.Assign(rcl);
end
else
DestComps.Clear;
//raise Exception.Create(Format('AssignOrigCompsForPage: %s not found in cache.', [PageName]));
end;
function TBaseComponentPalette.AssignOrigVisibleCompsForPage(PageName: string;
DestComps: TStringList): Boolean;
function TBaseComponentPalette.AssignOrigVisibleCompNames(PageName: string;
DestCompNames: TStringList): Boolean;
// Returns True if the page was found.
var
sl: TStringList;
rcl: TRegisteredCompList;
i: Integer;
begin
DestComps.Clear;
DestCompNames.Clear;
Result := fOrigComponentPageCache.Find(PageName, i);
if not Result then Exit;
sl := fOrigComponentPageCache.Objects[i] as TStringList;
for i := 0 to sl.Count-1 do
if FindComponent(sl[i]).Visible then
DestComps.Add(sl[i]);
rcl := fOrigComponentPageCache.Objects[i] as TRegisteredCompList;
for i := 0 to rcl.Count-1 do
if rcl[i].Visible then
DestCompNames.Add(rcl[i].ComponentClass.ClassName);
end;
function TBaseComponentPalette.RefUserCompsForPage(PageName: string): TStringList;
function TBaseComponentPalette.RefUserCompsForPage(PageName: string): TRegisteredCompList;
var
i: Integer;
begin
if fUserComponentPageCache.Find(PageName, i) then
Result := fUserComponentPageCache.Objects[i] as TStringList
Result := fUserComponentPageCache.Objects[i] as TRegisteredCompList
else
Result := Nil;
end;
@ -1020,7 +1103,7 @@ begin
Result:=nil;
end;
procedure TBaseComponentPalette.AddComponent(NewComponent: TRegisteredComponent);
procedure TBaseComponentPalette.AddRegComponent(NewComponent: TRegisteredComponent);
var
NewPriority: TComponentPriority;
InsertIndex: Integer;
@ -1029,7 +1112,7 @@ begin
NewPriority:=NewComponent.GetPriority;
InsertIndex:=0;
while (InsertIndex<fComps.Count)
and (ComparePriority(NewPriority,Comps[InsertIndex].GetPriority)<=0) do
and (ComparePriority(NewPriority,fComps[InsertIndex].GetPriority)<=0) do
inc(InsertIndex);
fComps.Insert(InsertIndex,NewComponent);
DoPageAddedComponent(NewComponent);
@ -1055,37 +1138,57 @@ begin
end;
end;
procedure TBaseComponentPalette.RemoveComponent(AComponent: TRegisteredComponent);
procedure TBaseComponentPalette.RemoveRegComponent(AComponent: TRegisteredComponent);
begin
fComps.Remove(AComponent);
AComponent.RealPage:=nil;
//ToDo: fix DoPageRemovedComponent(AComponent);
end;
function TBaseComponentPalette.FindComponent(const CompClassName: string): TRegisteredComponent;
function TBaseComponentPalette.FindRegComponent(ACompClass: TClass): TRegisteredComponent;
// Return registered component based on LCL component class type.
// Optimized with balanced tree fComponentCache.
var
ANode: TAVLTreeNode;
begin
ANode:=fComponentCache.FindKey(Pointer(CompClassName),
@CompareClassNameWithRegisteredComponent);
ANode:=fComponentCache.FindKey(ACompClass, @CompareClassWithRegisteredComponent);
if ANode<>nil then
Result:=TRegisteredComponent(ANode.Data)
else
Result:=nil;
end;
function TBaseComponentPalette.FindRegComponent(const ACompClassName: string): TRegisteredComponent;
// Return registered component based on LCL component class name.
var
i: Integer;
begin
// A small optimization. If same type is asked many times, return it quickly.
if ACompClassName = fLastFoundCompClassName then
Exit(fLastFoundRegComp);
// Linear search. Can be optimized if needed.
for i := 0 to fComps.Count-1 do
if fComps[i].ComponentClass.ClassName = ACompClassName then
begin
fLastFoundCompClassName := ACompClassName;
fLastFoundRegComp := fComps[i];
Exit(fLastFoundRegComp);
end;
Result:=nil;
end;
function TBaseComponentPalette.CreateNewClassName(const Prefix: string): string;
var
i: Integer;
begin
if FindComponent(Prefix)=nil then begin
if FindRegComponent(Prefix)=nil then begin
Result:=Prefix+'1';
end else begin
i:=1;
repeat
Result:=Prefix+IntToStr(i);
inc(i);
until FindComponent(Result)=nil;
until FindRegComponent(Result)=nil;
end;
end;
@ -1099,8 +1202,8 @@ procedure TBaseComponentPalette.IterateRegisteredClasses(Proc: TGetComponentClas
var
i: Integer;
begin
for i:=0 to Comps.Count-1 do
Proc(Comps[i].ComponentClass);
for i:=0 to fComps.Count-1 do
Proc(fComps[i].ComponentClass);
end;
procedure TBaseComponentPalette.SetSelectedComp(AComponent: TRegisteredComponent; AMulti: Boolean);

2
converter/missingpropertiesdlg.pas
View File

@ -598,7 +598,7 @@ begin
if not Assigned(fUsedUnitsTool) then Exit;
for i := 0 to aMissingTypes.Count-1 do
begin
RegComp:=IDEComponentPalette.FindComponent(aMissingTypes[i]);
RegComp:=IDEComponentPalette.FindRegComponent(aMissingTypes[i]);
NeededUnitName:='';
if (RegComp<>nil) then begin
if RegComp.ComponentClass<>nil then begin

2
designer/designerprocs.pas
View File

@ -388,7 +388,7 @@ begin
if InvisibleClasses.IndexOf(AComponent.ClassType) > -1 then
Exit(True);
Assert(Assigned(IDEComponentPalette), 'ComponentIsInvisible: IDEComponentPalette=Nil');
RegComp:=IDEComponentPalette.FindComponent(AComponent.ClassName);
RegComp:=IDEComponentPalette.FindRegComponent(AComponent.ClassType);
Result:=(RegComp=nil) or (RegComp.OrigPageName='');
if Result then begin
DebugLn(['---ComponentIsInvisible: Adding ', AComponent, ' to InvisibleClasses.---']);

12
ide/checklfmdlg.pas
View File

@ -195,7 +195,7 @@ var
if BaseFormEditor1.FindDesignerBaseClassByName(AClassName,true)<>nil then
exit;
// search in registered classes
RegComp:=IDEComponentPalette.FindComponent(ObjNode.TypeName);
RegComp:=IDEComponentPalette.FindRegComponent(ObjNode.TypeName);
if (RegComp<>nil) and (RegComp.GetUnitName<>'') then exit;
// search in global registered classes
if GetClass(ObjNode.TypeName) <> nil then
@ -452,7 +452,7 @@ function TLFMChecker.FindAndFixMissingComponentClasses: TModalResult;
var
CurError: TLFMError;
MissingObjectTypes: TStringList;
TypeName: String;
AClassName: String;
RegComp: TRegisteredComponent;
i: Integer;
begin
@ -463,16 +463,16 @@ begin
CurError:=fLFMTree.FirstError;
while CurError<>nil do begin
if CurError.IsMissingObjectType then begin
TypeName:=(CurError.Node as TLFMObjectNode).TypeName;
if MissingObjectTypes.IndexOf(TypeName)<0 then
MissingObjectTypes.Add(TypeName);
AClassName:=(CurError.Node as TLFMObjectNode).TypeName;
if MissingObjectTypes.IndexOf(AClassName)<0 then
MissingObjectTypes.Add(AClassName);
end;
CurError:=CurError.NextError;
end;
// keep missing object types only with a registered component class
for i:=MissingObjectTypes.Count-1 downto 0 do begin
RegComp:=IDEComponentPalette.FindComponent(MissingObjectTypes[i]);
RegComp:=IDEComponentPalette.FindRegComponent(MissingObjectTypes[i]);
if (RegComp=nil) or (RegComp.GetUnitName='') then
MissingObjectTypes.Delete(i);
end;

8
ide/componentlist.pas
View File

@ -385,7 +385,7 @@ procedure TComponentListForm.UpdateComponents;
// Fill all three tabsheets: Flat list, Palette layout and Component inheritence.
var
Pg: TBaseComponentPage;
Comps: TStringList;
Comps: TRegisteredCompList;
Comp: TRegisteredComponent;
ParentNode: TTreeNode;
AListNode: TTreeNode;
@ -417,11 +417,11 @@ begin
ParentNode := PalletteTree.Items.AddChild(nil, Pg.PageName);
// Iterate components of one page
for j := 0 to Comps.Count-1 do begin
Comp := Comps.Objects[j] as TRegisteredComponent;
Comp := Comps[j];
// Flat list item
AListNode := ListTree.Items.AddChildObject(Nil, Comps[j], Comp);
AListNode := ListTree.Items.AddChildObject(Nil, Comp.ComponentClass.ClassName, Comp);
// Palette layout item
APaletteNode := PalletteTree.Items.AddChildObject(ParentNode, Comps[j], Comp);
APaletteNode := PalletteTree.Items.AddChildObject(ParentNode, Comp.ComponentClass.ClassName, Comp);
if Comp is TPkgComponent then
CurIcon := TPkgComponent(Comp).ImageIndex
else

20
ide/componentpalette.pas
View File

@ -61,11 +61,11 @@ type
fPageComponent: TCustomPage;
fSelectButton: TComponent;
fBtnIndex: integer;
fCompNames: TStringList; // Reference to component names.
fRegComps: TRegisteredCompList; // Reference to components.
fGuiCreated: Boolean;
procedure ReAlignButtons;
procedure RemoveSheet;
procedure InsertVisiblePage(aCompNames: TStringList);
procedure InsertVisiblePage(aCompNames: TRegisteredCompList);
procedure CreateSelectionButton(aButtonUniqueName: string; aScrollBox: TScrollBox);
procedure CreateOrDelButton(aComp: TPkgComponent; aButtonUniqueName: string;
aScrollBox: TScrollBox);
@ -295,7 +295,7 @@ begin
PageComponent:=nil;
end;
procedure TComponentPage.InsertVisiblePage(aCompNames: TStringList);
procedure TComponentPage.InsertVisiblePage(aCompNames: TRegisteredCompList);
var
Pal: TComponentPalette;
TabIndex: Integer;
@ -309,7 +309,7 @@ begin
{$ENDIF}
exit;
end;
fCompNames := aCompNames;
fRegComps := aCompNames;
Pal := TComponentPalette(Palette);
TabControl := TCustomTabControl(Pal.FPageControl);
if PageComponent=nil then
@ -505,9 +505,9 @@ begin
CreateSelectionButton(IntToStr(FIndex), ScrollBox);
// create component buttons and delete unneeded ones
fBtnIndex := 0;
Assert(Assigned(fCompNames), 'TComponentPage.CreateButtons: fCompNames is not assigned.');
for i := 0 to fCompNames.Count-1 do begin
Comp := Pal.FindComponent(fCompNames[i]) as TPkgComponent;
Assert(Assigned(fRegComps), 'TComponentPage.CreateButtons: fCompNames is not assigned.');
for i := 0 to fRegComps.Count-1 do begin
Comp := fRegComps[i] as TPkgComponent;
if Assigned(Comp) then
CreateOrDelButton(Comp, Format('%d_%d_',[FIndex,i]), ScrollBox);
end;
@ -980,7 +980,7 @@ begin
Pg.RemoveSheet;
end;
{$ENDIF}
Pg.InsertVisiblePage(TStringList(UserOrder.ComponentPages.Objects[i]));
Pg.InsertVisiblePage(UserOrder.ComponentPages.Objects[i] as TRegisteredCompList);
{$IFDEF VerboseComponentPalette}
DebugLn(['TComponentPalette.UpdateNoteBookButtons: PageIndex=', i, ' PageName=',Pages[i].PageName]);
{$ENDIF}
@ -1017,7 +1017,7 @@ var
ARegComp: TRegisteredComponent;
begin
if AComponent<>nil then
ARegComp:=FindComponent(AComponent.ClassName)
ARegComp:=FindRegComponent(AComponent.ClassType)
else
ARegComp:=nil;
if ARegComp<>nil then
@ -1046,7 +1046,7 @@ var
begin
i := fComponentButtons.IndexOfData(Button);
if i >= 0 then
Result := FindComponent(fComponentButtons.Keys[i])
Result := FindRegComponent(fComponentButtons.Keys[i])
else
Result := nil;
end;

29
ide/customformeditor.pp
View File

@ -538,7 +538,7 @@ procedure TCustomFormEditor.RegisterFrame;
var
FrameComp: TRegisteredComponent;
begin
FrameComp:=IDEComponentPalette.FindComponent('TFrame');
FrameComp:=IDEComponentPalette.FindRegComponent('TFrame');
if FrameComp <> nil then
FrameComp.OnGetCreationClass:=@FrameCompGetCreationClass;
end;
@ -1836,8 +1836,7 @@ var
OldClassName: String;
DefinePropertiesPersistent: TDefinePropertiesPersistent;
function CreateTempPersistent(
const APersistentClass: TPersistentClass): boolean;
function CreateTempPersistent(APersistentClass: TPersistentClass): boolean;
begin
Result:=false;
if APersistent<>nil then
@ -1865,35 +1864,38 @@ var
AncestorClass: TComponentClass;
begin
Result:=false;
Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
// try to find the AClassName in the registered components
if APersistent=nil then begin
CacheItem.RegisteredComponent:=IDEComponentPalette.FindComponent(AClassname);
//if APersistent=nil then begin
CacheItem.RegisteredComponent:=IDEComponentPalette.FindRegComponent(AClassName);
if (CacheItem.RegisteredComponent<>nil)
and (CacheItem.RegisteredComponent.ComponentClass<>nil) then begin
//debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',AClassName,' is registered');
if not CreateTempPersistent(CacheItem.RegisteredComponent.ComponentClass)
then exit;
end;
end;
//end;
// try to find the AClassName in the registered TPersistent classes
if APersistent=nil then begin
//if APersistent=nil then begin
APersistentClass:=Classes.GetClass(AClassName);
if APersistentClass<>nil then begin
//debugln('TCustomFormEditor.FindDefineProperty PersistentClass ',AClassName,' is registered');
Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
if not CreateTempPersistent(APersistentClass) then exit;
end;
end;
//end;
if APersistent=nil then begin
//if APersistent=nil then begin
// try to find the AClassName in the open forms/datamodules
Assert(APersistent=nil, 'GetDefinePersistent: APersistent is assigned.');
APersistent:=FindJITComponentByClassName(AClassName);
if APersistent<>nil then
debugln('TCustomFormEditor.FindDefineProperty ComponentClass ',
AClassName,' is a resource,'
+' but inheriting design properties is not yet implemented');
end;
//end;
// try default classes
if (APersistent=nil) then begin
@ -1925,9 +1927,8 @@ begin
AutoFreePersistent:=false;
if not GetDefinePersistent(APersistentClassName) then exit;
if (APersistent=nil) then begin
if APersistent=nil then
if not GetDefinePersistent(AncestorClassName) then exit;
end;
if APersistent<>nil then begin
//debugln('TCustomFormEditor.FindDefineProperty Getting define properties for ',APersistent.ClassName);
@ -2247,7 +2248,7 @@ var
i: Integer;
begin
//DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName]);
RegComp:=IDEComponentPalette.FindComponent(ComponentClassName);
RegComp:=IDEComponentPalette.FindRegComponent(ComponentClassName);
if RegComp<>nil then begin
//DebugLn(['TCustomFormEditor.JITListFindClass ',ComponentClassName,' is registered as ',DbgSName(RegComp.ComponentClass)]);
ComponentClass:=RegComp.ComponentClass;

24
ide/environmentopts.pp
View File

@ -2287,8 +2287,8 @@ begin
try
if AutoSaveActiveDesktop and Assigned(DebugDesktop) then
begin
Desktop.ImportSettingsFromIDE(Self);
DebugDesktop.Assign(Desktop);
FDesktop.ImportSettingsFromIDE(Self);
DebugDesktop.Assign(FDesktop);
end;
UseDesktop(FLastDesktopBeforeDebug);
@ -2351,8 +2351,8 @@ begin
begin
FLastDesktopBeforeDebug := TDesktopOpt.Create(ActiveDesktopName);
if AutoSaveActiveDesktop then
Desktop.ImportSettingsFromIDE(Self);
FLastDesktopBeforeDebug.Assign(Desktop, False);
FDesktop.ImportSettingsFromIDE(Self);
FLastDesktopBeforeDebug.Assign(FDesktop, False);
EnvironmentOptions.UseDesktop(DebugDesktop);
end;
end;
@ -2786,8 +2786,8 @@ begin
FXMLCfg.DeletePath(CurPath+'Desktop');
end;
Desktop.Assign(ActiveDesktop, False);
Desktop.ExportSettingsToIDE(Self);
FDesktop.Assign(ActiveDesktop, False);
FDesktop.ExportSettingsToIDE(Self);
for i := 0 to SubConfigCount - 1 do
SubConfig[i].ReadFromXml(FXMLCfg);
@ -3107,8 +3107,8 @@ begin
and (Application.MainForm<>nil) and Application.MainForm.Visible then
begin
//save active desktop
Desktop.ImportSettingsFromIDE(Self);
ActiveDesktop.Assign(Desktop);
FDesktop.ImportSettingsFromIDE(Self);
ActiveDesktop.Assign(FDesktop);
if Assigned(FLastDesktopBeforeDebug) then//are we in debug session?
begin
@ -3704,7 +3704,7 @@ begin
Result := TDesktopOpt.Create(FActiveDesktopName);
FDesktops.Add(Result);
Result.Assign(Desktop);
Result.Assign(FDesktop);
if Assigned(IDEDockMaster) then
Result.FDockedOpt.LoadDefaults;
OldActiveDesktop := TDesktopOpt(FDesktops.Find(OldActiveDesktopName));
@ -3750,13 +3750,13 @@ begin
xLastFocusControl := Screen.ActiveControl;
xLastFocusForm := Screen.ActiveCustomForm;
DoBeforeWrite(False); //this is needed to get the EditorToolBar refreshed!!! - needed only here in UseDesktop()
Desktop.Assign(ADesktop);
FDesktop.Assign(ADesktop);
ActiveDesktopName := ADesktop.Name;
if ADesktop.AssociatedDebugDesktopName<>'' then
DebugDesktopName := ADesktop.AssociatedDebugDesktopName;
Desktop.ExportSettingsToIDE(Self);
FDesktop.ExportSettingsToIDE(Self);
DoAfterWrite(False); //this is needed to get the EditorToolBar refreshed!!! - needed only here in UseDesktop()
Desktop.RestoreDesktop;
FDesktop.RestoreDesktop;
//set focus back to the previously focused control
if Screen.CustomFormIndex(xLastFocusForm) >= 0 then//check if form hasn't been destroyed

38
ide/frames/componentpalette_options.pas
View File

@ -77,10 +77,6 @@ type
procedure ComponentsListViewItemChecked(Sender: TObject; {%H-}Item: TListItem);
procedure ComponentsListViewKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure CompMoveDownBtnClick(Sender: TObject);
procedure CompPalModeAddButtonClick(Sender: TObject);
procedure CompPalModeComboBoxChange(Sender: TObject);
procedure CompPalModeDeleteButtonClick(Sender: TObject);
procedure CompPalModeRenameButtonClick(Sender: TObject);
procedure ImportButtonClick(Sender: TObject);
procedure ExportButtonClick(Sender: TObject);
procedure PageMoveDownBtnClick(Sender: TObject);
@ -274,17 +270,17 @@ var
begin
OrigComps := TStringList.Create;
try
cpo.ComponentPages.Clear;
cpo.PageNamesCompNames.Clear;
for i := 1 to PagesListBox.Count-1 do // Skip "all components" page
begin
PgName := PagesListBox.Items[i];
UserComps := PagesListBox.Items.Objects[i] as TStringList;
Assert(Assigned(UserComps), 'TCompPaletteOptionsFrame.WriteComponents: No UserComps for '+PgName);
// Collect original visible components from this page.
IDEComponentPalette.AssignOrigVisibleCompsForPage(PgName, OrigComps);
IDEComponentPalette.AssignOrigVisibleCompNames(PgName, OrigComps);
// Differs from original order -> add configuration for components.
if (OrigComps.Count=0) or not OrigComps.Equals(UserComps) then
cpo.AssignComponentPage(PgName, UserComps);
cpo.AssignPageCompNames(PgName, UserComps);
end;
finally
OrigComps.Free;
@ -319,14 +315,14 @@ end;
procedure TCompPaletteOptionsFrame.InitialComps(aPageInd: Integer; aCompList: TStringList);
var
OrderedComps: TStringList;
OrderedComps: TRegisteredCompList;
Comp: TRegisteredComponent;
i: Integer;
begin
OrderedComps := fLocalUserOrder.ComponentPages.Objects[aPageInd] as TStringList;
OrderedComps := fLocalUserOrder.ComponentPages.Objects[aPageInd] as TRegisteredCompList;
for i := 0 to OrderedComps.Count-1 do
begin
Comp := IDEComponentPalette.FindComponent(OrderedComps[i]);
Comp := OrderedComps[i];
if Assigned(Comp) and Comp.Visible then
aCompList.AddObject(Comp.ComponentClass.ClassName, Comp);
end;
@ -738,28 +734,6 @@ begin
end;
end;
procedure TCompPaletteOptionsFrame.CompPalModeAddButtonClick(Sender: TObject);
begin
end;
procedure TCompPaletteOptionsFrame.CompPalModeComboBoxChange(Sender: TObject);
begin
end;
procedure TCompPaletteOptionsFrame.CompPalModeDeleteButtonClick(Sender: TObject
);
begin
end;
procedure TCompPaletteOptionsFrame.CompPalModeRenameButtonClick(Sender: TObject
);
begin
end;
procedure TCompPaletteOptionsFrame.MarkAsChanged;
begin
// ToDo: compare settings with original palette options after each change.

9
ide/main.pp
View File

@ -9345,7 +9345,7 @@ begin
NewClassName:=FindLFMClassName(TxtCompStream);
// check if component class is registered
ARegComp:=IDEComponentPalette.FindComponent(NewClassName);
ARegComp:=IDEComponentPalette.FindRegComponent(NewClassName);
if ARegComp=nil then begin
IDEMessageDialog(lisClassNotFound,
Format(lisClassIsNotARegisteredComponentClassUnableToPaste,[NewClassName,LineEnding]),
@ -11533,7 +11533,8 @@ begin
DebugLn(['** TMainIDE.DesignerActivated: Calling UpdateIDEComponentPalette(true)',
', IDEStarted=', FIDEStarted, ' **']);
{$ENDIF}
MainIDEBar.UpdateIDEComponentPalette(true);
if FIDEStarted then
MainIDEBar.UpdateIDEComponentPalette(true);
end;
procedure TMainIDE.DesignerCloseQuery(Sender: TObject);
@ -11627,7 +11628,7 @@ var
raise Exception.Create(Format(lisComponentNameIsKeyword, [AName]));
// check if registered component class
RegComp:=IDEComponentPalette.FindComponent(AName);
RegComp:=IDEComponentPalette.FindRegComponent(AName);
if RegComp<>nil then begin
s:=Format(lisThereIsAlreadyAComponentClassWithTheName, [RegComp.
ComponentClass.ClassName]);
@ -13310,7 +13311,7 @@ begin
AComponent:=TComponent(APersistent)
else
AComponent:=nil;
RegComp:=IDEComponentPalette.FindComponent(APersistent.ClassName);
RegComp:=IDEComponentPalette.FindRegComponent(APersistent.ClassType);
if AComponent<>nil then begin
if RegComp=nil then begin
ClassUnitInfo:=Project1.UnitWithComponentClass(TComponentClass(AComponent.ClassType));

2
ide/sourcefilemanager.pas
View File

@ -6650,7 +6650,7 @@ var
FoundComponentClass:=AnUnitInfo.UnitResourceFileformat.FindComponentClass(aClassName);
if FoundComponentClass=nil then
begin
RegComp:=IDEComponentPalette.FindComponent(aClassName);
RegComp:=IDEComponentPalette.FindRegComponent(aClassName);
if RegComp<>nil then
FoundComponentClass:=RegComp.ComponentClass;
end;

10
packager/addtopackagedlg.pas
View File

@ -226,7 +226,7 @@ end;
procedure TAddToPackageDlg.FormCreate(Sender: TObject);
begin
Caption:=lisMenuNewComponent;
fPkgComponents:=TAVLTree.Create(@CompareIDEComponentByClassName);
fPkgComponents:=TAVLTree.Create(@CompareIDEComponentByClass);
fPackages:=TAVLTree.Create(@CompareLazPackageID);
fParams:=TAddToPkgResult.Create;
IDEDialogLayoutList.ApplyLayout(Self,700,400);
@ -492,7 +492,7 @@ begin
exit;
end;
// check if classname already exists
PkgComponent:=TPkgComponent(IDEComponentPalette.FindComponent(fParams.NewClassname));
PkgComponent:=TPkgComponent(IDEComponentPalette.FindRegComponent(fParams.NewClassname));
if PkgComponent<>nil then begin
if IDEMessageDialog(lisA2PClassNameAlreadyExists,
Format(lisA2PTheClassNameExistsAlreadyInPackageFile, [fParams.NewClassName, LineEnding,
@ -502,7 +502,7 @@ begin
exit;
end;
// check if unitname is a componentclass
if IDEComponentPalette.FindComponent(fParams.Unit_Name)<>nil then begin
if IDEComponentPalette.FindRegComponent(fParams.Unit_Name)<>nil then begin
if IDEMessageDialog(lisA2PAmbiguousUnitName,
Format(lisA2PTheUnitNameIsTheSameAsAnRegisteredComponent,[fParams.Unit_Name,LineEnding]),
mtWarning,[mbCancel,mbIgnore])<>mrIgnore
@ -511,7 +511,7 @@ begin
end;
// create dependency if needed
PkgComponent:=TPkgComponent(IDEComponentPalette.FindComponent(fParams.AncestorType));
PkgComponent:=TPkgComponent(IDEComponentPalette.FindRegComponent(fParams.AncestorType));
if PkgComponent<>nil then begin
fParams.UsedUnitname:=PkgComponent.GetUnitName;
ARequiredPackage:=PkgComponent.PkgFile.LazPackage;
@ -564,7 +564,7 @@ var
begin
fLastNewAncestorType:=AncestorComboBox.Text;
if not IsValidIdent(fLastNewAncestorType) then exit;
PkgComponent:=TPkgComponent(IDEComponentPalette.FindComponent(fLastNewAncestorType));
PkgComponent:=TPkgComponent(IDEComponentPalette.FindRegComponent(fLastNewAncestorType));
// create unique classname
ClassNameEdit.Text:=IDEComponentPalette.CreateNewClassName(fLastNewAncestorType);
// choose the same page name

7
packager/packagesystem.pas
View File

@ -1853,8 +1853,7 @@ begin
// check unitname
FRegistrationUnitName:=TheUnitName;
if not IsValidUnitName(FRegistrationUnitName) then begin
RegistrationError(Format(lisPkgSysInvalidUnitname, [FRegistrationUnitName]
));
RegistrationError(Format(lisPkgSysInvalidUnitname, [FRegistrationUnitName]));
exit;
end;
// check unit file
@ -1934,7 +1933,7 @@ begin
end;
{$ENDIF}
if (IDEComponentPalette<>nil)
and (IDEComponentPalette.FindComponent(CurClassname)<>nil) then
and (IDEComponentPalette.FindRegComponent(CurComponent.ClassType)<>nil) then
RegistrationError(Format(lisPkgSysComponentClassAlreadyDefined,[CurClassname]));
if AbortRegistration then exit;
// add the component to the package owning the file
@ -1944,7 +1943,7 @@ begin
//DebugLn('TLazPackageGraph.RegisterComponentsHandler Page="',Page,
// '" CurComponent=',CurClassname,' FRegistrationFile=',FRegistrationFile.Filename);
if IDEComponentPalette<>nil then
IDEComponentPalette.AddComponent(NewPkgComponent);
IDEComponentPalette.AddRegComponent(NewPkgComponent);
end;
end;

20
packager/pkgmanager.pas
View File

@ -204,6 +204,12 @@ type
function CopyMoveFiles(Sender: TObject): boolean;
function ResolveBrokenDependenciesOnline(ABrokenDependencies: TFPList): TModalResult;
function ShowBrokenDependenciesReport(Dependencies: TFPList): TModalResult;
// Components
function FilterMissingDependenciesForUnit(const UnitFilename: string;
InputPackageList: TPackagePackageArray;
out OutputPackageList: TOwnerPackageArray): TModalResult;
function GetUnitsAndDependenciesForComponents(ComponentClassNames: TStrings;
out PackageList: TPackagePackageArray; out UnitList: TStringList): TModalResult;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -354,14 +360,10 @@ type
function AddUnitDependenciesForComponentClasses(const UnitFilename: string;
ComponentClassnames: TStrings;
Quiet: boolean = false): TModalResult; override;
function GetUnitsAndDependenciesForComponents(ComponentClassNames: TStrings;
out PackageList: TPackagePackageArray; out UnitList: TStringList): TModalResult;
function GetMissingDependenciesForUnit(const UnitFilename: string;
{ function GetMissingDependenciesForUnit(const UnitFilename: string;
ComponentClassnames: TStrings;
var List: TOwnerPackageArray): TModalResult;
function FilterMissingDependenciesForUnit(const UnitFilename: string;
InputPackageList: TPackagePackageArray;
out OutputPackageList: TOwnerPackageArray): TModalResult;
}
function GetUsableComponentUnits(CurRoot: TPersistent): TFPList; override; // list of TUnitInfo
procedure IterateComponentNames(CurRoot: TPersistent; TypeData: PTypeData;
Proc: TGetStrProc); override;
@ -4509,7 +4511,7 @@ begin
for CurClassID:=0 to ComponentClassnames.Count-1 do
begin
CurCompClass:=ComponentClassnames[CurClassID];
CurRegisteredComponent:=IDEComponentPalette.FindComponent(CurCompClass);
CurRegisteredComponent:=IDEComponentPalette.FindRegComponent(CurCompClass);
if CurRegisteredComponent is TPkgComponent then
begin
CurUnitName:='';
@ -4643,7 +4645,7 @@ begin
end;
Result:=mrOk;
end;
{
function TPkgManager.GetMissingDependenciesForUnit(
const UnitFilename: string; ComponentClassnames: TStrings;
var List: TOwnerPackageArray): TModalResult;
@ -4662,7 +4664,7 @@ begin
AllUnits.Free;
end;
end;
}
function TPkgManager.GetOwnersOfUnit(const UnitFilename: string): TFPList;
begin
Result:=GetPossibleOwnersOfUnit(UnitFilename,[]);

2
packager/projpackchecks.pas
View File

@ -203,7 +203,7 @@ begin
end;
end;
// check if unitname is a componentclass
if IDEComponentPalette.FindComponent(AUnitFilename)<>nil then
if IDEComponentPalette.FindRegComponent(AUnitFilename)<>nil then
begin
if IDEMessageDialog(lisA2PAmbiguousUnitName,
Format(lisA2PTheUnitNameIsTheSameAsAnRegisteredComponent,[AUnitFilename,LineEnding]),