Changeset 25 for branches/gbitmap/Packages/FastGraphics/UFGraphics.pas

Timestamp:

Dec 22, 2016, 2:34:33 PM (7 years ago)

Author:

chronos

Message:

• Fixed: Memory leaks introduced by TFColor. TFColor now use reference counting as descendant of IFColor.
• Added: Line drawing for TFPixmap class.

File:

• branches/gbitmap/Packages/FastGraphics/UFGraphics.pas (modified) (11 diffs)

branches/gbitmap/Packages/FastGraphics/UFGraphics.pas

@@ -40 +40 @@
     procedure Fill(Color: IBColor); virtual; overload;
     procedure Fill(Func: TGetColorPos); virtual; overload;
+    procedure Line(P1, P2: TPoint; Color: IBColor); virtual;
     procedure PaintToCanvas(Canvas: TCanvas); virtual;
     function GetDataSize: Integer; virtual;
@@ -88 +89 @@
   end;
 
+  IFColor = interface
+  end;
+
   { TFColor }
 
-  TFColor = class
+  TFColor = class(TInterfacedObject, IFColor)
   private
     FBackend: IBColor;
@@ -105 +109 @@
   end;
 
+  TFCanvas = class;
+  TFPixmap = class;
+
+  { TFBrush }
+
+  TFBrush = class
+    Color: IFColor;
+    Canvas: TFCanvas;
+  end;
+
+  { TFPen }
+
+  TFPen = class
+    Position: TPoint;
+    Color: IFColor;
+    Canvas: TFCanvas;
+    procedure MoveTo(Pos: TPoint);
+    procedure LineTo(Pos: TPoint);
+  end;
+
+  { TFCanvas }
+
+  TFCanvas = class
+    Pixmap: TFPixmap;
+    Pen: TFPen;
+    Brush: TFBrush;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
   { TFPixmap }
 
@@ -110 +145 @@
   public
     type
-      TGetColorPos = function (Position: TPoint; ColorFormat: TColorFormat): TFColor of object;
+      TGetColorPos = function (Position: TPoint; ColorFormat: TColorFormat): IFColor of object;
   private
     FBackend: TBImage;
+    FCanvas: TFCanvas;
     FColorFormat: TColorFormat;
     FSize: TPoint;
     FillCallBack: TGetColorPos;
     function FillGetColor(Position: TPoint): IBColor;
-    function GetPixel(X, Y: Integer): TFColor;
+    function GetPixel(X, Y: Integer): IFColor;
     procedure SetColorFormat(AValue: TColorFormat);
-    procedure SetPixel(X, Y: Integer; AValue: TFColor);
+    procedure SetPixel(X, Y: Integer; AValue: IFColor);
     procedure SetSize(AValue: TPoint);
   public
-    procedure Fill(Color: TFColor); overload;
+    procedure Fill(Color: IFColor); overload;
     procedure Fill(Func: TGetColorPos); overload;
     procedure PaintToCanvas(Canvas: TCanvas);
@@ -128 +164 @@
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    property Canvas: TFCanvas read FCanvas;
     property Backend: TBImage read FBackend;
     property ColorFormat: TColorFormat read FColorFormat write SetColorFormat;
     property Size: TPoint read FSize write SetSize;
-    property Pixels[X, Y: Integer]: TFColor read GetPixel write SetPixel;
+    property Pixels[X, Y: Integer]: IFColor read GetPixel write SetPixel;
   end;
 
@@ -149 +186 @@
 begin
   RegisterComponents('FastGraphics', [TFPixmap]);
+end;
+
+{ TFPen }
+
+procedure TFPen.MoveTo(Pos: TPoint);
+begin
+  Position := Pos;
+end;
+
+procedure TFPen.LineTo(Pos: TPoint);
+begin
+  Canvas.Pixmap.Backend.Line(Position, Pos, (Color as TFColor).Backend);
+  Position := Pos;
+end;
+
+{ TFCanvas }
+
+constructor TFCanvas.Create;
+begin
+  Pen := TFPen.Create;
+  Pen.Canvas := Self;
+  Brush := TFBrush.Create;
+  Brush.Canvas := Self;
+end;
+
+destructor TFCanvas.Destroy;
+begin
+  FreeAndNil(Pen);
+  FreeAndNil(Brush);
+  inherited Destroy;
 end;
 
@@ -254 +321 @@
 destructor TFColor.Destroy;
 begin
+  FColorFormat := nil;
   inherited Destroy;
 end;
@@ -279 +347 @@
 
 procedure TBImage.Fill(Func: TGetColorPos);
+begin
+end;
+
+procedure TBImage.Line(P1, P2: TPoint; Color: IBColor);
 begin
 end;
@@ -309 +381 @@
 function TFPixmap.FillGetColor(Position: TPoint): IBColor;
 begin
-  Result := FillCallBack(Position, ColorFormat).Backend;
-end;
-
-function TFPixmap.GetPixel(X, Y: Integer): TFColor;
+  Result := (FillCallBack(Position, ColorFormat) as TFColor).Backend;
+end;
+
+function TFPixmap.GetPixel(X, Y: Integer): IFColor;
 begin
   Result := TFColor.Create;
-  Result.ColorFormat := ColorFormat;
-  Result.FBackend := FBackend.Pixels[X, Y];
-end;
-
-procedure TFPixmap.SetPixel(X, Y: Integer; AValue: TFColor);
-begin
-  FBackend.Pixels[X, Y] := AValue.FBackend;
+  (Result as TFColor).ColorFormat := ColorFormat;
+  (Result as TFColor).FBackend := FBackend.Pixels[X, Y];
+end;
+
+procedure TFPixmap.SetPixel(X, Y: Integer; AValue: IFColor);
+begin
+  FBackend.Pixels[X, Y] := (AValue as TFColor).FBackend;
 end;
 
@@ -331 +403 @@
 end;
 
-procedure TFPixmap.Fill(Color: TFColor);
-begin
-  FBackend.Fill(Color.Backend);
+procedure TFPixmap.Fill(Color: IFColor);
+begin
+  FBackend.Fill((Color as TFColor).Backend);
 end;
 
@@ -349 +421 @@
 function TFPixmap.GetDataSize: Integer;
 begin
-  FBackend.GetDataSize;
-end;
-
-constructor TFPixmap.Create;
+  Result := FBackend.GetDataSize;
+end;
+
+constructor TFPixmap.Create(AOwner: TComponent);
 begin
   inherited;
+  FBackend := TBImage.Create;
+  FCanvas := TFCanvas.Create;
+  FCanvas.Pixmap := Self;
   ColorFormat := ColorFormatManager.GetFormat(0);
-  FBackend := TBImage.Create;
 end;
 
 destructor TFPixmap.Destroy;
 begin
+  FreeAndNil(FCanvas);
   FreeAndNil(FBackend);
   inherited Destroy;