paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-28 23:49:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

IDE: Prevent an occasional invalid type cast. At least TAnchorside property caused it.

Browse Source
This commit is contained in:
Juha 2022-10-04 14:27:16 +03:00
parent fe5518b176
commit c79af3b7d5
1 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
ide/project.pp
View File

@ -5187,7 +5187,7 @@ procedure TProject.FindUnitsUsingSubComponent(SubComponent: TComponent;
PropInfo: PPropInfo;
PropList: PPropList;
CurCount,i: integer;
ReferenceComponent: TComponent;
RefObj: TObject;
begin
if csDestroying in AComponent.ComponentState then exit;
@ -5200,16 +5200,19 @@ procedure TProject.FindUnitsUsingSubComponent(SubComponent: TComponent;
CurCount:=GetPropList(TypeInfo,PropList);
try
// read properties
for i:=0 to CurCount-1 do begin
for i:=0 to CurCount-1 do
begin
PropInfo:=PropList^[i];
if PropInfo^.PropType^.Kind=tkClass then begin
if PropInfo^.PropType^.Kind=tkClass then
begin
// property of kind TObject
ReferenceComponent:=TComponent(GetObjectProp(AComponent,PropInfo));
//debugln('TProject.FindUnitsUsingSubComponent Property ',dbgsName(AComponent),' Name=',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,' Value=',dbgsName(ReferenceComponent),' TypeInfo=',TypeInfo^.Name);
if ReferenceComponent=SubComponent then begin
RefObj:=GetObjectProp(AComponent,PropInfo);
//DebugLn('TProject.FindUnitsUsingSubComponent Property ',dbgsName(AComponent),
// ' Name=',PropInfo^.Name,' Type=',PropInfo^.PropType^.Name,
// ' Value=',dbgsName(RefObj),' TypeInfo=',TypeInfo^.Name);
if RefObj=SubComponent then
if List.IndexOf(AnUnitInfo)<0 then
List.Add(AnUnitInfo);
end;
end;
end;
finally