* Patches from Mattias Gaertner to include FPCanvas in LCL

fcl/image/fpbrush.inc

@@ -32,7 +32,7 @@ begin
     self.Style := Style;
     self.Image := Image;
     end;
-  inherited;
+  inherited DoCopyProps(From);
 end;
 
 function TFPCustomBrush.CopyBrush : TFPCustomBrush;

fcl/image/fpcanvas.inc

@@ -1,3 +1,4 @@
+{%MainUnit fpcanvas.pp}
 {
     $Id$
     This file is part of the Free Pascal run time library.
@@ -30,17 +31,19 @@ end;
 destructor TFPCustomCanvas.Destroy;
 begin
   FRemovingHelpers := True;
+  // first remove all helper references
+  RemoveHelpers;
+  // then free helpers
   FDefaultFont.Free;
   FDefaultBrush.Free;
   FDefaultPen.Free;
-  RemoveHelpers;
   FHelpers.Free;
   FRemovingHelpers := False;
   inherited;
 end;
 
 procedure TFPCustomCanvas.CheckHelper (AHelper:TFPCanvasHelper);
-var r : integer;
+// remove references to AHelper
 begin
   if AHelper = FPen then
     FPen := nil
@@ -57,9 +60,7 @@ begin
     else if AHelper = FDefaultBrush then
       FDefaultBrush := CreateDefaultBrush;
     end;
-  r := FHelpers.IndexOf (AHelper);
-  if (r >= 0) then
-    FHelpers.delete (r);
+  FHelpers.Remove (AHelper);
 end;
 
 procedure TFPCustomCanvas.RemoveHelpers;
@@ -120,6 +121,11 @@ begin
     end;
 end;
 
+function TFPCustomCanvas.GetClipRect: TRect;
+begin
+  Result:=FClipRect;
+end;
+
 function TFPCustomCanvas.CreateFont : TFPCustomFont;
 begin
   result := DoCreateDefaultFont;
@@ -147,9 +153,14 @@ procedure TFPCustomCanvas.SetFont (AValue:TFPCustomFont);
 begin
   if (AValue <> FFont) and AllowFont(AValue) then
     begin
-    AValue.AllocateResources (self);
-    FFont := AValue;
-    AddHelper (AValue);
+      if FManageResources then
+        FFont.Assign(AValue)
+      else
+        begin
+          AValue.AllocateResources (self);
+          FFont := AValue;
+          AddHelper (AValue);
+        end;
     end;
 end;
 
@@ -178,9 +189,14 @@ procedure TFPCustomCanvas.SetBrush (AValue:TFPCustomBrush);
 begin
   if (AValue <> FBrush) and AllowBrush(AValue) then
     begin
-    AValue.AllocateResources (self);
-    FBrush := AValue;
-    AddHelper (AValue);
+      if FManageResources then
+        FBrush.Assign(AValue)
+      else
+        begin
+          AValue.AllocateResources (self);
+          FBrush := AValue;
+          AddHelper (AValue);
+        end;
     end;
 end;
 
@@ -209,9 +225,14 @@ procedure TFPCustomCanvas.SetPen (AValue:TFPCustomPen);
 begin
   if (AValue <> FPen) and AllowPen (AValue) then
     begin
-    AValue.AllocateResources (self);
-    FPen := AValue;
-    AddHelper (AValue);
+      if FManageResources then
+        FPen.Assign(AValue)
+      else
+        begin
+          AValue.AllocateResources (self);
+          FPen := AValue;
+          AddHelper (AValue);
+        end;
     end;
 end;
 
@@ -223,6 +244,16 @@ begin
     result := FDefaultPen;
 end;
 
+procedure TFPCustomCanvas.SetClipRect(const AValue: TRect);
+begin
+  FClipRect:=AValue;
+end;
+
+procedure TFPCustomCanvas.SetPenPos(const AValue: TPoint);
+begin
+  FPenPos:=AValue;
+end;
+
 function TFPCustomCanvas.DoAllowPen (APen : TFPCustomPen) : boolean;
 begin
   result := false;
@@ -255,6 +286,11 @@ begin
     raise TFPCanvasException.Create (ErrNoLock);
 end;
 
+function TFPCustomCanvas.Locked: boolean;
+begin
+  Result:=FLocks>0;
+end;
+
 procedure TFPCustomCanvas.TextOut (x,y:integer;text:string);
 begin
   if Font is TFPCustomDrawFont then
@@ -293,19 +329,19 @@ end;
 
 procedure TFPCustomCanvas.DoLineTo (x,y:integer);
 begin
-  DoLine (FCurrent.X,FCurrent.y, x,y);
+  DoLine (FPenPos.X,FPenPos.y, x,y);
 end;
 
 procedure TFPCustomCanvas.MoveTo (x,y:integer);
 begin
-  FCurrent.x := x;
-  FCurrent.y := y;
+  FPenPos.x := x;
+  FPenPos.y := y;
   DoMoveTo (x,y);
 end;
 
 procedure TFPCustomCanvas.MoveTo (p:TPoint);
 begin
-  FCurrent := p;
+  FPenPos := p;
   DoMoveTo (p.x,p.y);
 end;
 
@@ -313,11 +349,11 @@ procedure TFPCustomCanvas.LineTo (x,y:integer);
 begin
   if Pen.Style <> psClear then
     if Pen is TFPCustomDrawPen then
-      TFPCustomDrawPen(Pen).DrawLine (FCurrent.x, FCurrent.y, x, y)
+      TFPCustomDrawPen(Pen).DrawLine (FPenPos.x, FPenPos.y, x, y)
     else
       DoLineTo (x,y);
-  FCurrent.x := x;
-  FCurrent.y := y;
+  FPenPos.x := x;
+  FPenPos.y := y;
 end;
 
 procedure TFPCustomCanvas.LineTo (p:TPoint);
@@ -332,11 +368,11 @@ begin
       TFPCustomDrawPen(Pen).DrawLine (x1,y1, x2,y2)
     else
       DoLine (x1,y1, x2,y2);
-  FCurrent.x := x2;
-  FCurrent.y := y2;
+  FPenPos.x := x2;
+  FPenPos.y := y2;
 end;
 
-procedure TFPCustomCanvas.Line (p1,p2:TPoint);
+procedure TFPCustomCanvas.Line (const p1,p2:TPoint);
 begin
   Line (p1.x,p1.y,p2.x,p2.y);
 end;
@@ -354,7 +390,7 @@ begin
      TFPCustomDrawPen(Pen).Polyline (points,false)
    else
      DoPolyline (points);
-  FCurrent := points[high(points)];
+  FPenPos := points[high(points)];
 end;
 
 procedure TFPCustomCanvas.Clear;
@@ -538,7 +574,8 @@ begin
     end;
 end;
 
-procedure TFPCustomCanvas.CopyRect (x,y:integer; canvas:TFPCustomCanvas; SourceRect:TRect);
+procedure TFPCustomCanvas.CopyRect (x,y:integer; canvas:TFPCustomCanvas;
+  SourceRect:TRect);
 var xx,r,t : integer;
 begin
   SortRect (SourceRect);

fcl/image/fpcanvas.pp

@@ -32,8 +32,11 @@ type
 
   TFPCustomCanvas = class;
 
+  { TFPCanvasHelper }
+
   TFPCanvasHelper = class(TPersistent)
   private
+    FDelayAllocate: boolean;
     FFPColor : TFPColor;
     FAllocated,
     FFixedCanvas : boolean;
@@ -41,10 +44,10 @@ type
     FFlags : word;
     FOnChange: TNotifyEvent;
     FOnChanging: TNotifyEvent;
-    function GetAllocated : boolean;
     procedure NotifyCanvas;
   protected
     // flags 0-15 are reserved for FPCustomCanvas
+    function GetAllocated: boolean; virtual;
     procedure SetFlags (index:integer; AValue:boolean); virtual;
     function GetFlags (index:integer) : boolean; virtual;
     procedure CheckAllocated (ValueNeeded:boolean);
@@ -52,17 +55,18 @@ type
     procedure DoAllocateResources; virtual;
     procedure DoDeAllocateResources; virtual;
     procedure DoCopyProps (From:TFPCanvasHelper); virtual;
-    procedure SetFPColor (AValue:TFPColor); virtual;
+    procedure SetFPColor (const AValue:TFPColor); virtual;
     procedure Changing; dynamic;
     procedure Changed; dynamic;
     Procedure Lock;
     Procedure UnLock;
   public
     constructor Create; virtual;
-    destructor destroy; override;
+    destructor Destroy; override;
     // prepare helper for use
-    procedure AllocateResources (ACanvas : TFPCustomCanvas);
-    // free all resource used bby this helper
+    procedure AllocateResources (ACanvas : TFPCustomCanvas;
+                                 CanDelay: boolean = true);
+    // free all resource used by this helper
     procedure DeallocateResources;
     property Allocated : boolean read GetAllocated;
     // properties cannot be changed when allocated
@@ -73,6 +77,7 @@ type
     property FPColor : TFPColor read FFPColor Write SetFPColor;
     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
+    property DelayAllocate: boolean read FDelayAllocate write FDelayAllocate;
   end;
 
   TFPCustomFont = class (TFPCanvasHelper)
@@ -149,9 +154,12 @@ type
   end;
   TFPCustomBrushClass = class of TFPCustomBrush;
 
-  TFPCustomCanvas = class
+  { TFPCustomCanvas }
+
+  TFPCustomCanvas = class(TPersistent)
   private
     FClipping,
+    FManageResources: boolean;
     FRemovingHelpers : boolean;
     FDefaultFont,
     FFont : TFPCustomFont;
@@ -159,7 +167,7 @@ type
     FBrush : TFPCustomBrush;
     FDefaultPen,
     FPen : TFPCustomPen;
-    FCurrent : TPoint;
+    FPenPos : TPoint;
     FClipRect : TRect;
     FHelpers : TList;
     FLocks : integer;
@@ -183,12 +191,15 @@ type
     function  DoAllowFont (AFont : TFPCustomFont) : boolean; virtual;
     function  DoAllowPen (APen : TFPCustomPen) : boolean; virtual;
     function  DoAllowBrush (ABrush : TFPCustomBrush) : boolean; virtual;
-    procedure SetColor (x,y:integer; Value:TFPColor); Virtual; abstract;
+    procedure SetColor (x,y:integer; const Value:TFPColor); Virtual; abstract;
     function  GetColor (x,y:integer) : TFPColor; Virtual; abstract;    
     procedure SetHeight (AValue : integer); virtual; abstract;
     function  GetHeight : integer; virtual; abstract;
     procedure SetWidth (AValue : integer); virtual; abstract;
     function  GetWidth : integer; virtual; abstract;
+    function  GetClipRect: TRect; virtual;
+    procedure SetClipRect(const AValue: TRect); virtual;
+    procedure SetPenPos(const AValue: TPoint); virtual;
     procedure DoLockCanvas; virtual;
     procedure DoUnlockCanvas; virtual;
     procedure DoTextOut (x,y:integer;text:string); virtual; abstract;
@@ -218,6 +229,7 @@ type
     destructor destroy; override;
     procedure LockCanvas;
     procedure UnlockCanvas;
+    function Locked: boolean;
     function CreateFont : TFPCustomFont;
     function CreatePen : TFPCustomPen;
     function CreateBrush : TFPCustomBrush;
@@ -243,7 +255,7 @@ type
     procedure LineTo (x,y:integer);
     procedure LineTo (p:TPoint);
     procedure Line (x1,y1,x2,y2:integer);
-    procedure Line (p1,p2:TPoint);
+    procedure Line (const p1,p2:TPoint);
     procedure Line (const points:TRect);
     // other procedures
     procedure CopyRect (x,y:integer; canvas:TFPCustomCanvas; SourceRect:TRect);
@@ -254,11 +266,12 @@ type
     property Pen : TFPCustomPen read GetPen write SetPen;
     property Brush : TFPCustomBrush read GetBrush write SetBrush;
     property Colors [x,y:integer] : TFPColor read GetColor write SetColor;
-    property ClipRect : TRect read FClipRect write FClipRect;
+    property ClipRect : TRect read GetClipRect write SetClipRect;
     property Clipping : boolean read FClipping write FClipping;
-    property PenPos : TPoint read FCurrent write FCurrent;
+    property PenPos : TPoint read FPenPos write SetPenPos;
     property Height : integer read GetHeight write SetHeight;
     property Width : integer read GetWidth write SetWidth;
+    property ManageResources: boolean read FManageResources write FManageResources;
   end;
 
   TFPCustomDrawFont = class (TFPCustomFont)
@@ -280,12 +293,12 @@ type
   TFPCustomDrawPen = class (TFPCustomPen)
   private
     procedure DrawLine (x1,y1,x2,y2:integer);
-    procedure Polyline (points:array of TPoint; close:boolean);
+    procedure Polyline (const points:array of TPoint; close:boolean);
     procedure Ellipse (left,top, right,bottom:integer);
     procedure Rectangle (left,top, right,bottom:integer);
   protected
     procedure DoDrawLine (x1,y1,x2,y2:integer); virtual; abstract;
-    procedure DoPolyline (points:array of TPoint; close:boolean); virtual; abstract;
+    procedure DoPolyline (const points:array of TPoint; close:boolean); virtual; abstract;
     procedure DoEllipse (left,top, right,bottom:integer); virtual; abstract;
     procedure DoRectangle (left,top, right,bottom:integer); virtual; abstract;
   end;
@@ -298,12 +311,12 @@ type
     procedure Rectangle (left,top, right,bottom:integer);
     procedure FloodFill (x,y:integer);
     procedure Ellipse (left,top, right,bottom:integer);
-    procedure Polygon (points:array of TPoint);
+    procedure Polygon (const points:array of TPoint);
   public
     procedure DoRectangle (left,top, right,bottom:integer); virtual; abstract;
     procedure DoEllipse (left,top, right,bottom:integer); virtual; abstract;
     procedure DoFloodFill (x,y:integer); virtual; abstract;
-    procedure DoPolygon (points:array of TPoint); virtual; abstract;
+    procedure DoPolygon (const points:array of TPoint); virtual; abstract;
   end;
 
   TFPEmptyBrush = class (TFPCustomBrush)

fcl/image/fpcdrawh.inc

@@ -20,7 +20,7 @@ begin
   DoDrawLine (x1,y1,x2,y2);
 end;
 
-procedure TFPCustomDrawPen.Polyline (points:array of TPoint; close:boolean);
+procedure TFPCustomDrawPen.Polyline (const points:array of TPoint; close:boolean);
 begin
   DoPolyLine (points, false);
 end;
@@ -52,7 +52,7 @@ begin
   DoEllipse (left,top,right,bottom);
 end;
 
-procedure TFPCustomDrawBrush.Polygon (points:array of TPoint);
+procedure TFPCustomDrawBrush.Polygon (const points:array of TPoint);
 begin
   DoPolygon (points);
 end;

fcl/image/fphelper.inc

@@ -1,3 +1,4 @@
+{%MainUnit fpcanvas.pp}
 {
     $Id$
     This file is part of the Free Pascal run time library.
@@ -36,17 +37,26 @@ begin
 end;
 
 procedure TFPCanvasHelper.NotifyCanvas;
+// called to unbind from canvas
 begin
-  FCanvas.CheckHelper (self);
+  if FCanvas<>nil then
+    FCanvas.CheckHelper (self);
 end;
 
 procedure TFPCanvasHelper.CheckAllocated (ValueNeeded:boolean);
+
+  procedure RaiseErrAllocation;
+  begin
+    Raise TFPFontException.CreateFmt (ErrAllocation,
+                                      [EFont, ErrAlloc[ValueNeeded]]);
+  end;
+
 begin
   if (Allocated <> ValueNeeded) then
-    Raise TFPFontException.CreateFmt (ErrAllocation, [EFont, ErrAlloc[ValueNeeded]]);
+    RaiseErrAllocation;
 end;
 
-procedure TFPCanvasHelper.SetFPColor (AValue:TFPColor);
+procedure TFPCanvasHelper.SetFPColor(const AValue:TFPColor);
 begin
   FFPColor := AValue;
 end;
@@ -92,12 +102,14 @@ begin
     result := FAllocated;
 end;
 
-procedure TFPCanvasHelper.AllocateResources (ACanvas : TFPCustomCanvas);
+procedure TFPCanvasHelper.AllocateResources (ACanvas : TFPCustomCanvas;
+  CanDelay: boolean);
 begin
   if FFixedCanvas and FAllocated then
     DeallocateResources;
+  FCanvas := ACanvas;
+  if DelayAllocate and CanDelay then exit;
   try
-    FCanvas := ACanvas;
     DoAllocateResources;
     FAllocated := True;
   except
@@ -120,7 +132,6 @@ end;
 
 procedure TFPCanvasHelper.DoCopyProps (From:TFPCanvasHelper);
 begin
-  FCanvas := nil;
   FPColor := from.FPColor;
 end;
 

fcl/image/fpimgcanv.pp

@@ -25,7 +25,7 @@ type
   private
     FImage : TFPCustomImage;
   protected
-    procedure SetColor (x,y:integer; AValue:TFPColor); override;
+    procedure SetColor (x,y:integer; const AValue:TFPColor); override;
     function  GetColor (x,y:integer) : TFPColor; override;
     procedure SetHeight (AValue : integer); override;
     function  GetHeight : integer; override;
@@ -52,7 +52,7 @@ begin
   inherited destroy;
 end;
 
-procedure TFPImageCanvas.SetColor (x,y:integer; AValue:TFPColor);
+procedure TFPImageCanvas.SetColor (x,y:integer; const AValue:TFPColor);
 begin
   if (x >= 0) and (x < width) and (y >= 0) and (y < height) then
     if not clipping or PointInside (x,y, ClipRect) then