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

LCL: Refactoring, move nested function GetNode out and rename as GetPClassNode.

Browse Source 
git-svn-id: trunk@63670 -
This commit is contained in:
juha 2020-07-29 18:28:56 +00:00
parent f57a7803db
commit d8c4121c4f
1 changed files with 69 additions and 71 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

140
lcl/widgetset/wslclclasses.pp
View File

@ -404,6 +404,74 @@ begin
PPointer(ANode^.VClass + vmtMethodTable)^ := nil;
end;
{ Get PClass node is recursive, we want to detect if a new node may be an
unregistered intermediate in the ancestor class tree }
function GetPClassNode(AClass: TClass; AWSComponent: TWSLCLComponentClass;
aParentGet: boolean; aLeaf: boolean): PClassNode;
var
idx: Integer;
OldCount: integer;
lParentNode : PClassNode;
lClassNode : TClassNode; { A temp local node to fake normal processing
of a node that won't be stored aParentGet = 0
and TWSLCLComponentClass = nil }
lInsertNode : boolean; { Indicator that New(Result) has been requested }
begin
if (AClass = nil) or not (AClass.InheritsFrom(TLCLComponent)) then
Exit(nil);
if not WSClassesList.Search(AClass, idx) then
begin
lInsertNode := aParentGet or Assigned(AWSComponent);
if lInsertNode then
New(Result)
else
Result := @lClassNode;
Result^.LCLClass := TComponentClass(AClass);
Result^.WSClass := nil;
Result^.VClass := nil;
Result^.VClassName := '';
Result^.VClassNew := aParentGet;
Result^.Child := nil;
lParentNode := GetPClassNode(AClass.ClassParent, AWSComponent, True, False);
Result^.Parent := lParentNode;
{ Unregistered Intermediate nodes are patched with the parent information }
if aParentGet then
begin
Result^.WSClass := lParentNode^.WSClass;
Result^.VClass := lParentNode^.VClass;
PPointer(Result^.VClass + vmtWSPrivate)^ := PPointer(lParentNode^.VClass + vmtWSPrivate)^;
// Build a VClassName
if aLeaf then { Node that has an empty WSRegisterClass procedure }
Result^.VClassName := '(L)' + Result^.WSClass.ClassName
else { Internal node needed for tree consistency }
Result^.VClassName := '(I)' + Result^.WSClass.ClassName
end;
if lParentNode = nil then
begin
Result^.Sibling := nil;
if aLeaf then
Result^.VClassName := '(ROOT)' + AClass.ClassName;
end
else if lInsertNode then
begin
Result^.Sibling := lParentNode^.Child;
lParentNode^.Child := Result;
end
else
Result^.Sibling := nil;
if lInsertNode then
begin
WSClassesList.Search(aClass, idx);
WSClassesList.Insert(idx, Result);
end
else
Result := nil;
end
else
Result := WSClassesList[idx];
end;
// ANewRegistration - If true, VClass is not created during runtime,
// but instead normal, Object Pascal class creation is used
procedure RegisterWSComponent(const AComponent: TComponentClass;
@ -411,76 +479,6 @@ procedure RegisterWSComponent(const AComponent: TComponentClass;
const AWSPrivate: TWSPrivateClass = nil;
const ANewRegistration: Boolean = False);
{ Get note is recursive, we want to detect if a new node may be an
un registered intermediate in the enacestor class tree }
function GetNode(const AClass: TClass; aParentGet: boolean; aLeaf: boolean): PClassNode;
var
idx: Integer;
OldCount: integer;
lParentNode : PClassNode;
lClassNode : TClassNode; { A temp local node to fake normal processing
of a node that won't be stored aParentGet = 0
and TWSLCLComponentClass = nil }
lInsertNode : boolean; { Indicator that New(Result) has been requested }
begin
if (AClass = nil) or not (AClass.InheritsFrom(TLCLComponent)) then
Exit(nil);
if not WSClassesList.Search(AClass, idx) then begin
if not aParentGet and (AWSComponent = nil) then begin
lInsertNode := False;
Result := @lClassNode;
end
else begin
lInsertNode := True;
New(Result);
end;
Result^.LCLClass := TComponentClass(AClass);
Result^.WSClass := nil;
Result^.VClass := nil;
Result^.VClassName := '';
Result^.VClassNew := aParentGet;
Result^.Child := nil;
lParentNode := GetNode(AClass.ClassParent, True, False);
Result^.Parent := lParentNode;
{ Unregistered Intermediate nodes are patched with the parent information }
if aParentGet then begin
Result^.WSClass := lParentNode^.WSClass;
Result^.VClass := lParentNode^.VClass;
PPointer(Result^.VClass + vmtWSPrivate)^ := PPointer(lParentNode^.VClass + vmtWSPrivate)^;
// Build a VClassName
if aLeaf then
{ Node that has an empty WSRegisterClass procedure }
Result^.VClassName := '(L)' + Result^.WSClass.ClassName
else
{ Internal node needed for tree consistency }
Result^.VClassName := '(I)' + Result^.WSClass.ClassName
end;
if lParentNode = nil then begin
Result^.Sibling := nil;
if aLeaf then
Result^.VClassName := '(ROOT)' + AClass.ClassName
end
else begin
if lInsertNode then begin
Result^.Sibling := lParentNode^.Child;
lParentNode^.Child := Result;
end
else
Result^.Sibling := nil;
end;
if lInsertNode then begin
WSClassesList.Search(aClass, idx);
WSClassesList.Insert(idx, Result);
end
else
Result := nil;
end
else begin
Result := WSClassesList[idx];
end;
end;
procedure UpdateChildren(const ANode: PClassNode; AOldPrivate: TClass);
var
Node: PClassNode;
@ -507,7 +505,7 @@ var
begin
if not Assigned(WSClassesList) then
DoInitialization;
Node := GetNode(AComponent, False or ANewRegistration, True);
Node := GetPClassNode(AComponent, AWSComponent, ANewRegistration, True);
if Node = nil then // No node created
Exit;