diff --git a/lcl/forms.pp b/lcl/forms.pp index 2ceb47fc4a..07a54aba20 100644 --- a/lcl/forms.pp +++ b/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'); diff --git a/lcl/graphics.pp b/lcl/graphics.pp index 598a5a6bbd..ec4091583d 100644 --- a/lcl/graphics.pp +++ b/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 diff --git a/lcl/interfacebase.pp b/lcl/interfacebase.pp index c4339e17ff..4451f851ea 100644 --- a/lcl/interfacebase.pp +++ b/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); diff --git a/lcl/interfaces/carbon/carbonint.pas b/lcl/interfaces/carbon/carbonint.pas index c876752d81..97271677dd 100644 --- a/lcl/interfaces/carbon/carbonint.pas +++ b/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; diff --git a/lcl/interfaces/carbon/interfaces.pas b/lcl/interfaces/carbon/interfaces.pas index 3bfb95f1ef..24979eec7b 100644 --- a/lcl/interfaces/carbon/interfaces.pas +++ b/lcl/interfaces/carbon/interfaces.pas @@ -40,7 +40,7 @@ uses CarbonInt, Forms; initialization - WidgetSet:= TCarbonWidgetSet.Create; + CreateWidgetset(TCarbonWidgetSet); finalization FreeWidgetSet; diff --git a/lcl/interfaces/fpgui/fpguiint.pp b/lcl/interfaces/fpgui/fpguiint.pp index 3e2444c386..ef2f13ede0 100644 --- a/lcl/interfaces/fpgui/fpguiint.pp +++ b/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; diff --git a/lcl/interfaces/fpgui/interfaces.pp b/lcl/interfaces/fpgui/interfaces.pp index f667a98a90..293666a406 100644 --- a/lcl/interfaces/fpgui/interfaces.pp +++ b/lcl/interfaces/fpgui/interfaces.pp @@ -38,11 +38,9 @@ uses fpguiint, Forms; initialization - - WidgetSet := TFpGuiWidgetSet.Create; + CreateWidgetset(TFpGuiWidgetSet); finalization - - WidgetSet.Free; + FreeWidgetset; end. diff --git a/lcl/interfaces/gtk/gtkint.pp b/lcl/interfaces/gtk/gtkint.pp index 2744eaa33f..0a762193f7 100644 --- a/lcl/interfaces/gtk/gtkint.pp +++ b/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; diff --git a/lcl/interfaces/gtk/interfaces.pp b/lcl/interfaces/gtk/interfaces.pp index 1d975ee8d6..ff8955786c 100644 --- a/lcl/interfaces/gtk/interfaces.pp +++ b/lcl/interfaces/gtk/interfaces.pp @@ -40,7 +40,7 @@ uses GTK1Int, Forms; initialization - WidgetSet := TGTK1WidgetSet.Create; + CreateWidgetset(TGTK1WidgetSet); finalization FreeWidgetSet; diff --git a/lcl/interfaces/gtk2/interfaces.pas b/lcl/interfaces/gtk2/interfaces.pas index 224371e775..6dc550b2ef 100644 --- a/lcl/interfaces/gtk2/interfaces.pas +++ b/lcl/interfaces/gtk2/interfaces.pas @@ -36,7 +36,7 @@ uses Gtk2Int, Forms; initialization - WidgetSet := TGtk2WidgetSet.Create; + CreateWidgetset(TGtk2WidgetSet); finalization FreeWidgetSet; diff --git a/lcl/interfaces/qt/interfaces.pp b/lcl/interfaces/qt/interfaces.pp index f9970230c3..adfdfca248 100644 --- a/lcl/interfaces/qt/interfaces.pp +++ b/lcl/interfaces/qt/interfaces.pp @@ -38,11 +38,9 @@ uses qtint, Forms; initialization - - WidgetSet := TQtWidgetSet.Create; + CreateWidgetset(TQtWidgetSet); finalization - FreeWidgetset; end. diff --git a/lcl/interfaces/qt/qtint.pp b/lcl/interfaces/qt/qtint.pp index 0c555ff0cc..d9b4d51e8c 100644 --- a/lcl/interfaces/qt/qtint.pp +++ b/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; diff --git a/lcl/interfaces/win32/interfaces.pp b/lcl/interfaces/win32/interfaces.pp index b8930e106c..c360fb9cd1 100644 --- a/lcl/interfaces/win32/interfaces.pp +++ b/lcl/interfaces/win32/interfaces.pp @@ -37,7 +37,7 @@ uses Win32Int, Forms; initialization - WidgetSet := TWin32WidgetSet.Create; + CreateWidgetset(TWin32WidgetSet); finalization FreeWidgetSet; diff --git a/lcl/interfaces/win32/win32int.pp b/lcl/interfaces/win32/win32int.pp index 0a1b3f3512..8820cefa2e 100644 --- a/lcl/interfaces/win32/win32int.pp +++ b/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; diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index 1358f909a4..4ce2cdfa5b 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/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 diff --git a/lcl/interfaces/wince/interfaces.pp b/lcl/interfaces/wince/interfaces.pp index bf92d8195b..ddac35ea52 100644 --- a/lcl/interfaces/wince/interfaces.pp +++ b/lcl/interfaces/wince/interfaces.pp @@ -37,7 +37,7 @@ uses Windows,WinCEInt, Forms; initialization - WidgetSet := TWinCEWidgetSet.Create; + CreateWidgetset(TWinCEWidgetSet); finalization FreeWidgetSet; diff --git a/lcl/interfaces/wince/winceint.pp b/lcl/interfaces/wince/winceint.pp index f78b66b66a..505acf6420 100644 --- a/lcl/interfaces/wince/winceint.pp +++ b/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; diff --git a/lcl/lclproc.pas b/lcl/lclproc.pas index 102b4a2310..64ee000062 100644 --- a/lcl/lclproc.pas +++ b/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}