Factory method to create the Canvas instance used for every Window.

It is now possible for a developer to create a descendant
TfpgCanvas class, and override the DefaultCanvasClass variable to
rather use this new class for all Windows. A nice way to extend
the Canvas capability for your own applications - without modify
the fpGUI library code.

1 files changed, 10 insertions, 1 deletions

diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas
index 46091fa6..76595ea0 100644
--- a/src/corelib/fpg_main.pas
+++ b/src/corelib/fpg_main.pas
@@ -136,6 +136,7 @@ type
     procedure   SetParent(const AValue: TfpgWindow); reintroduce;
     function    GetParent: TfpgWindow; reintroduce;
     function    GetCanvas: TfpgCanvas; reintroduce;
+    function    CreateCanvas: TfpgCanvasBase; virtual;
   public
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
@@ -362,6 +363,8 @@ var
   fpgCaret:  TfpgCaret;   { TODO -ograemeg : move this into fpgApplication }
   fpgImages: TfpgImages;  { TODO -ograemeg : move this into fpgApplication }
 
+  DefaultCanvasClass: TfpgCanvasBaseClass = nil;
+
 // Application & Clipboard singletons
 function  fpgApplication: TfpgApplication;
 function  fpgClipboard: TfpgClipboard;
@@ -1902,6 +1905,11 @@ end;
 
 { TfpgWindow }
 
+function TfpgWindow.CreateCanvas: TfpgCanvasBase;
+begin
+  Result := DefaultCanvasClass.Create(self);
+end;
+
 constructor TfpgWindow.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner); // initialize the platform internals
@@ -1923,7 +1931,7 @@ begin
   else
     FWindowType   := wtWindow;
 
-  FCanvas := TfpgCanvas.Create(self);
+  FCanvas := CreateCanvas;
 end;
 
 destructor TfpgWindow.Destroy;
@@ -2654,6 +2662,7 @@ initialization
   iCallTrace      := -1;
   InitializeDebugOutput;
   fpgInitMsgQueue;
+  DefaultCanvasClass := TfpgCanvas;
 
 finalization
   uClipboard.Free;