From e8b84a2b504fbace69283fb865a77ae3c8c161f4 Mon Sep 17 00:00:00 2001
From: sekelsenmat <sekelsenmat@lazarus-ide.org>
Date: Fri, 5 Aug 2011 08:36:21 +0000
Subject: [PATCH] Adds a new virtual method to allow descendents to override
 their WSClass

git-svn-id: trunk@31868 -
---
 lcl/lclclasses.pp | 24 ++++++++++++++++--------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/lcl/lclclasses.pp b/lcl/lclclasses.pp
index 40055e725e..3c2e4cf525 100644
--- a/lcl/lclclasses.pp
+++ b/lcl/lclclasses.pp
@@ -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);