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

Adds a new virtual method to allow descendents to override their WSClass

Browse Source 
git-svn-id: trunk@31868 -
This commit is contained in:
sekelsenmat 2011-08-05 08:36:21 +00:00
parent 8ce1ae04fd
commit e8b84a2b50
1 changed files with 16 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
lcl/lclclasses.pp
View File

@ -41,6 +41,7 @@ type
FLCLRefCount: integer;
protected
class procedure WSRegisterClass; virtual;
class function GetWSComponentClass(ASelf: TLCLComponent): TWSLCLComponentClass; virtual;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
@ -89,6 +90,20 @@ begin
//
end;
// This method allows descendents to override the FWidgetSetClass
class function TLCLComponent.GetWSComponentClass(ASelf: TLCLComponent): TWSLCLComponentClass;
begin
Result := FindWSComponentClass(Self);
if Result = nil then
begin
{$IFDEF VerboseLCL}
DebugLn(['TLCLComponent.NewInstance WARNING: missing FWidgetSetClass ',ClassName]);
{$ENDIF}
Result := TWSLCLComponent;
end;
end;
constructor TLCLComponent.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
@ -115,15 +130,8 @@ class function TLCLComponent.NewInstance: TObject;
begin
Result := inherited NewInstance;
WSRegisterClass;
TLCLComponent(Result).FWidgetSetClass := FindWSComponentClass(Self);
if TLCLComponent(Result).FWidgetSetClass = nil then
begin
{$IFDEF VerboseLCL}
DebugLn(['TLCLComponent.NewInstance WARNING: missing FWidgetSetClass ',ClassName]);
{$ENDIF}
TLCLComponent(Result).FWidgetSetClass := TWSLCLComponent;
end;
TLCLComponent(Result).FWidgetSetClass := GetWSComponentClass(TLCLComponent(Result));
end;
procedure TLCLComponent.RemoveAllHandlersOfObject(AnObject: TObject);