fcl-image: Adds a new object-oriented and extensible approach to regions and add more text/drawing methods from TCanvas

git-svn-id: trunk@19766 -

packages/fcl-image/src/fpcanvas.inc

@@ -18,7 +18,6 @@
 constructor TFPCustomCanvas.Create;
 begin
   inherited create;
-  FClipRect := Rect(-1,-1,-1,-1);
   FClipping := false;
   FRemovingHelpers := false;
   FHelpers := TList.Create;
@@ -127,7 +126,8 @@ end;
 
 function TFPCustomCanvas.GetClipRect: TRect;
 begin
-  Result:=FClipRect;
+  if FClipRegion = nil then Result := Bounds(0, 0, 0, 0)
+  else Result:=FClipRegion.GetBoundingRect();
 end;
 
 function TFPCustomCanvas.CreateFont : TFPCustomFont;
@@ -254,8 +254,13 @@ begin
 end;
 
 procedure TFPCustomCanvas.SetClipRect(const AValue: TRect);
+var
+  lNewRegion: TFPRectRegion;
 begin
-  FClipRect:=AValue;
+  lNewRegion := TFPRectRegion.Create;
+  lNewRegion.Rect := AValue;
+  if FClipRegion <> nil then FClipRegion.Free;
+  FClipRegion := lNewRegion;
 end;
 
 procedure TFPCustomCanvas.SetPenPos(const AValue: TPoint);
@@ -317,6 +322,16 @@ begin
 end;
 
 function TFPCustomCanvas.GetTextHeight (text:string) : integer;
+begin
+  Result := TextHeight(Text);
+end;
+
+function TFPCustomCanvas.GetTextWidth (text:string) : integer;
+begin
+  Result := TextWidth(Text);
+end;
+
+function TFPCustomCanvas.TextHeight(const Text: string): Integer;
 begin
   if Font is TFPCustomDrawFont then
     result := TFPCustomDrawFont(Font).GetTextHeight (text)
@@ -324,7 +339,7 @@ begin
     result := DoGetTextHeight (Text);
 end;
 
-function TFPCustomCanvas.GetTextWidth (text:string) : integer;
+function TFPCustomCanvas.TextWidth(const Text: string): Integer;
 begin
   if Font is TFPCustomDrawFont then
     result := TFPCustomDrawFont(Font).GetTextWidth (text)
@@ -332,6 +347,18 @@ begin
     result := DoGetTextWidth (Text);
 end;
 
+procedure TFPCustomCanvas.Arc(ALeft, ATop, ARight, ABottom, Angle16Deg,
+  Angle16DegLength: Integer);
+begin
+
+end;
+
+procedure TFPCustomCanvas.Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX,
+  EY: Integer);
+begin
+
+end;
+
 procedure TFPCustomCanvas.DoMoveTo (x,y:integer);
 begin
 end;

packages/fcl-image/src/fpcanvas.pp

@@ -193,6 +193,21 @@ type
     function MaxSupport : double; override;
   end;
 
+  TFPCustomRegion = class
+  public
+    function GetBoundingRect: TRect; virtual; abstract;
+    function IsPointInRegion(AX, AY: Integer): Boolean; virtual; abstract;
+  end;
+
+  { TFPRectRegion }
+
+  TFPRectRegion = class(TFPCustomRegion)
+  public
+    Rect: TRect;
+    function GetBoundingRect: TRect; override;
+    function IsPointInRegion(AX, AY: Integer): Boolean; override;
+  end;
+
   { TFPCustomCanvas }
 
   TFPCustomCanvas = class(TPersistent)
@@ -218,7 +233,7 @@ type
     FDefaultBrush, FBrush : TFPCustomBrush;
     FDefaultPen, FPen : TFPCustomPen;
     FPenPos : TPoint;
-    FClipRect : TRect;
+    FClipRegion : TFPCustomRegion;
     function DoCreateDefaultFont : TFPCustomFont; virtual; abstract;
     function DoCreateDefaultPen : TFPCustomPen; virtual; abstract;
     function DoCreateDefaultBrush : TFPCustomBrush; virtual; abstract;
@@ -277,11 +292,15 @@ type
     function CreatePen : TFPCustomPen;
     function CreateBrush : TFPCustomBrush;
     // using font
-    procedure TextOut (x,y:integer;text:string);
+    procedure TextOut (x,y:integer;text:string); virtual;
     procedure GetTextSize (text:string; var w,h:integer);
     function GetTextHeight (text:string) : integer;
     function GetTextWidth (text:string) : integer;
+    function TextHeight(const Text: string): Integer; virtual;
+    function TextWidth(const Text: string): Integer; virtual;
     // using pen and brush
+    procedure Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer); virtual;
+    procedure Arc(ALeft, ATop, ARight, ABottom, SX, SY, EX, EY: Integer); virtual;
     procedure Ellipse (Const Bounds:TRect);
     procedure Ellipse (left,top,right,bottom:integer);
     procedure EllipseC (x,y:integer; rx,ry:longword);
@@ -322,6 +341,7 @@ type
     property Interpolation : TFPCustomInterpolation read FInterpolation write FInterpolation;
     property Colors [x,y:integer] : TFPColor read GetColor write SetColor;
     property ClipRect : TRect read GetClipRect write SetClipRect;
+    property ClipRegion : TFPCustomRegion read FClipRegion write FClipRegion;
     property Clipping : boolean read GetClipping write SetClipping;
     property PenPos : TPoint read FPenPos write SetPenPos;
     property Height : integer read GetHeight write SetHeight;
@@ -427,6 +447,19 @@ begin
     end;
 end;
 
+{ TFPRectRegion }
+
+function TFPRectRegion.GetBoundingRect: TRect;
+begin
+  Result := Rect;
+end;
+
+function TFPRectRegion.IsPointInRegion(AX, AY: Integer): Boolean;
+begin
+  Result := (AX >= Rect.Left) and (AX <= Rect.Right) and
+    (AY >= Rect.Top) and (AY <= Rect.Bottom);
+end;
+
 {$i FPHelper.inc}
 {$i FPFont.inc}
 {$i FPPen.inc}