IDE: added check to avoid circular frames, bug #14311

git-svn-id: trunk@21274 -
This commit is contained in:
mattias 2009-08-17 21:43:04 +00:00
parent bdb9e3c022
commit cb375e7df1
2 changed files with 34 additions and 2 deletions

View File

@ -1547,8 +1547,12 @@ var
end;
//DebugLn(['AddComponent ',dbgsName(NewComponentClass)]);
if NewComponentClass=nil then exit;
if LookupRoot.InheritsFrom(NewComponentClass) then begin
if NewComponentClass = nil then exit;
// check circles
if LookupRoot.InheritsFrom(NewComponentClass) or
TheFormEditor.HasCircularDependencies(NewComponentClass, LookupRoot) then
begin
IDEMessageDialog(lisInvalidCircle,
Format(lisIsAThisCircleDependencyIsNotAllowed, [dbgsName(LookupRoot),
dbgsName(NewComponentClass), #13]),

View File

@ -256,6 +256,7 @@ each control that's dropped onto the form
var Ancestor, RootAncestor: TComponent);
procedure SetComponentNameAndClass(CI: TIComponentInterface;
const NewName, NewClassName: shortstring);
function HasCircularDependencies(AClass: TComponentClass; AComponent: TComponent): Boolean;
// ancestors
function GetAncestorLookupRoot(AComponent: TComponent): TComponent; override;
@ -1840,6 +1841,33 @@ begin
AComponent.Name:=NewName;
end;
function TCustomFormEditor.HasCircularDependencies(AClass: TComponentClass; AComponent: TComponent): Boolean;
function HasChild(WhatToTraverse, WhatToSearch: TComponent): Boolean;
var
i: integer;
begin
Result := False;
for i := 0 to WhatToTraverse.ComponentCount - 1 do
begin
Result := WhatToTraverse.Components[i].InheritsFrom(WhatToSearch.ClassType) or
HasChild(WhatToTraverse.Components[i], WhatToSearch);
if Result then Exit;
end;
end;
var
AnUnitInfo: TUnitInfo;
Cmp: TComponent;
begin
Result := False;
AnUnitInfo := Project1.UnitWithComponentClass(AClass);
if AnUnitInfo = nil then Exit;
Cmp := AnUnitInfo.Component;
if Cmp = nil then Exit;
Result := HasChild(Cmp, AComponent);
end;
function TCustomFormEditor.GetAncestorLookupRoot(AComponent: TComponent
): TComponent;
var