LCL:replace direct call of TXXWidgetset.Create by indirect CreateWidgetset(TXXWidgetset) to move some initialization code from units initialization (from graphics.pp) to that new procedure. This fix memory leaks in lazbuild tool which indirectly uses many lcl units but doesnot work with widgetset.

git-svn-id: trunk@13062 -

lcl/forms.pp

@@ -1348,6 +1348,7 @@ const
      [biSystemMenu, biMinimize, biMaximize]);   // bsSizeToolWin
      
 
+procedure CreateWidgetset(AWidgetsetClass: TWidgetsetClass);
 procedure FreeWidgetSet;
 
 procedure Register;
@@ -1573,6 +1574,13 @@ begin
     Result := Copy(Hint, I + 1, Maxint);
 end;
 
+procedure CreateWidgetset(AWidgetsetClass: TWidgetsetClass);
+begin
+  //debugln('CreateWidgetset');
+  CallInterfaceInitializationHandlers;
+  WidgetSet := AWidgetsetClass.Create;
+end;
+
 procedure FreeWidgetSet;
 begin
   //debugln('FreeWidgetSet');

lcl/graphics.pp

@@ -2078,6 +2078,14 @@ begin
   Result := RGBToColor(R, G, B);
 end;
 
+procedure InterfaceInit;
+begin
+  //debugln('Graphics.InterfaceInit');
+  FontResourceCache:=TFontHandleCache.Create;
+  PenResourceCache:=TPenHandleCache.Create;
+  BrushResourceCache:=TBrushHandleCache.Create;
+end;
+
 procedure InterfaceFinal;
 begin
   //debugln('Graphics.InterfaceFinal');
@@ -2087,11 +2095,9 @@ begin
 end;
 
 initialization
-  FontResourceCache:=TFontHandleCache.Create;
-  PenResourceCache:=TPenHandleCache.Create;
-  BrushResourceCache:=TBrushHandleCache.Create;
   RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
   RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
+  RegisterInterfaceInitializationHandler(@InterfaceInit);
   RegisterInterfaceFinalizationHandler(@InterfaceFinal);
 
 finalization

lcl/interfacebase.pp

@@ -72,7 +72,7 @@ type
     procedure PassCmdLineOptions; virtual;
     function CreateThemeServices: TThemeServices; virtual;
   public
-    constructor Create;
+    constructor Create; virtual;
     destructor Destroy; override;
 
     procedure AppInit(var ScreenInfo: TScreenInfo); virtual; abstract;
@@ -108,6 +108,7 @@ type
     
     property ThemeServices: TThemeServices read FThemeServices;
   end;
+  TWidgetSetClass = class of TWidgetSet;
 
 type
   EInterfaceException = class(Exception);

lcl/interfaces/carbon/carbonint.pas

@@ -77,7 +77,7 @@ type
 
     procedure RegisterEvents;
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
 
     function LCLPlatform: TLCLPlatform; override;

lcl/interfaces/carbon/interfaces.pas

@@ -40,7 +40,7 @@ uses
   CarbonInt, Forms;
 
 initialization
-  WidgetSet:= TCarbonWidgetSet.Create;
+  CreateWidgetset(TCarbonWidgetSet);
 
 finalization
   FreeWidgetSet;

lcl/interfaces/fpgui/fpguiint.pp

@@ -64,7 +64,7 @@ type
 //    procedure AppSetTitle(const ATitle: string); override;
     function LCLPlatform: TLCLPlatform; override;
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
 
     function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;

lcl/interfaces/fpgui/interfaces.pp

@@ -38,11 +38,9 @@ uses
   fpguiint, Forms;
 
 initialization
-
-  WidgetSet := TFpGuiWidgetSet.Create;
+  CreateWidgetset(TFpGuiWidgetSet);
 
 finalization
-
-  WidgetSet.Free;
+  FreeWidgetset;
 
 end.

lcl/interfaces/gtk/gtkint.pp

@@ -277,7 +277,7 @@ type
     // notebook
     procedure AddDummyNoteBookPage(NoteBookWidget: PGtkNoteBook);virtual;
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
     procedure SendCachedLCLMessages; override;
     function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;

lcl/interfaces/gtk/interfaces.pp

@@ -40,7 +40,7 @@ uses
   GTK1Int, Forms;
 
 initialization
-  WidgetSet := TGTK1WidgetSet.Create;
+  CreateWidgetset(TGTK1WidgetSet);
 
 finalization
   FreeWidgetSet;

lcl/interfaces/gtk2/interfaces.pas

@@ -36,7 +36,7 @@ uses
   Gtk2Int, Forms;
 
 initialization
-  WidgetSet := TGtk2WidgetSet.Create;
+  CreateWidgetset(TGtk2WidgetSet);
 
 finalization
   FreeWidgetSet;

lcl/interfaces/qt/interfaces.pp

@@ -38,11 +38,9 @@ uses
   qtint, Forms;
 
 initialization
-
-  WidgetSet := TQtWidgetSet.Create;
+  CreateWidgetset(TQtWidgetSet);
 
 finalization
-
   FreeWidgetset;
 
 end.

lcl/interfaces/qt/qtint.pp

@@ -90,7 +90,7 @@ type
     procedure AppSetTitle(const ATitle: string); override;
     procedure AttachMenuToWindow(AMenuObject: TComponent); override;
   public
-    constructor Create;
+    constructor Create; override;
     destructor Destroy; override;
 
     function  DCGetPixel(CanvasHandle: HDC; X, Y: integer): TGraphicsColor; override;

lcl/interfaces/win32/interfaces.pp

@@ -37,7 +37,7 @@ uses
   Win32Int, Forms;
 
 initialization
-  WidgetSet := TWin32WidgetSet.Create;
+  CreateWidgetset(TWin32WidgetSet);
 
 finalization
   FreeWidgetSet;

lcl/interfaces/win32/win32int.pp

@@ -174,9 +174,9 @@ type
     procedure RemoveCallbacks(Sender: TObject); virtual;
 
     { Constructor of the class }
-    constructor Create;
+    constructor Create; override;
     { Destructor of the class }
-    destructor Destroy; Override;
+    destructor Destroy; override;
 
     function LCLPlatform: TLCLPlatform; override;
 

lcl/interfaces/win32/win32object.inc

@@ -28,9 +28,9 @@
 
   Constructor for the class.
  ------------------------------------------------------------------------------}
-Constructor TWin32WidgetSet.Create;
-Begin
-  Inherited Create;
+constructor TWin32WidgetSet.Create;
+begin
+  inherited Create;
   FTimerData  := TList.Create;
   FMetrics.cbSize := SizeOf(FMetrics);
   FMetricsFailed := not Windows.SystemParametersInfo(SPI_GETNONCLIENTMETRICS,
@@ -42,7 +42,7 @@ Begin
   OnClipBoardRequest := nil;
   Pointer(InitCommonControlsEx) := GetProcAddress(GetModuleHandle(comctl32), 'InitCommonControlsEx');
   FCommonControlsVersion := GetFileVersion(comctl32);
-End;
+end;
 
 {------------------------------------------------------------------------------
   Method: TWin32WidgetSet.Destroy
@@ -51,11 +51,11 @@ End;
 
   Destructor for the class.
  ------------------------------------------------------------------------------}
-Destructor TWin32WidgetSet.Destroy;
+destructor TWin32WidgetSet.Destroy;
 var
   n: integer;
   TimerInfo : PWin32TimerInfo;
-Begin
+begin
   Assert(False, 'Trace:TWin32WidgetSet is being destroyed');
 
   n := FTimerData.Count;
@@ -78,7 +78,7 @@ Begin
 
   Windows.UnregisterClass(@ClsName, System.HInstance);
   inherited Destroy;
-End;
+end;
 
 {------------------------------------------------------------------------------
   Method: TWin32WidgetSet.AppInit

lcl/interfaces/wince/interfaces.pp

@@ -37,7 +37,7 @@ uses
   Windows,WinCEInt, Forms;
 
 initialization
-  WidgetSet := TWinCEWidgetSet.Create;
+  CreateWidgetset(TWinCEWidgetSet);
 
 finalization
   FreeWidgetSet;

lcl/interfaces/wince/winceint.pp

@@ -135,9 +135,9 @@ type
     Procedure RemoveCallbacks(Sender: TObject); virtual;
 
     { Constructor of the class }
-    Constructor Create;
+    constructor Create; override;
     { Destructor of the class }
-    Destructor Destroy; Override;
+    destructor Destroy; override;
 
     function LCLPlatform: TLCLPlatform; override;
 

lcl/lclproc.pas

@@ -146,6 +146,8 @@ procedure FreeThenNil(var AnObject: TObject);
 { the LCL interfaces finalization sections are called before the finalization
   sections of the LCL. Those parts, that should be finalized after the LCL, can
   be registered here. }
+procedure RegisterInterfaceInitializationHandler(p: TProcedure);
+procedure CallInterfaceInitializationHandlers;
 procedure RegisterInterfaceFinalizationHandler(p: TProcedure);
 procedure CallInterfaceFinalizationHandlers;
 
@@ -329,6 +331,7 @@ implementation
 
 
 var
+  InterfaceInitializationHandlers,
   InterfaceFinalizationHandlers: TFPList;
   DebugTextAllocated: boolean;
   DebugText: ^Text;
@@ -611,6 +614,19 @@ begin
   end;
 end;
 
+procedure RegisterInterfaceInitializationHandler(p: TProcedure);
+begin
+  InterfaceInitializationHandlers.Add(p);
+end;
+
+procedure CallInterfaceInitializationHandlers;
+var
+  i: Integer;
+begin
+  for i:=0 to InterfaceInitializationHandlers.Count-1 do
+    TProcedure(InterfaceInitializationHandlers[i])();
+end;
+
 procedure RegisterInterfaceFinalizationHandler(p: TProcedure);
 begin
   InterfaceFinalizationHandlers.Add(p);
@@ -3303,11 +3319,14 @@ end;
 
 initialization
   InitializeDebugOutput;
-  InterfaceFinalizationHandlers:=TFPList.Create;
+  InterfaceInitializationHandlers := TFPList.Create;
+  InterfaceFinalizationHandlers := TFPList.Create;
   {$IFDEF DebugLCLComponents}
   DebugLCLComponents:=TDebugLCLItems.Create;
   {$ENDIF}
 finalization
+  InterfaceInitializationHandlers.Free;
+  InterfaceInitializationHandlers:=nil;
   InterfaceFinalizationHandlers.Free;
   InterfaceFinalizationHandlers:=nil;
   {$IFDEF DebugLCLComponents}