Changeset 25 for branches/gbitmap

Timestamp:

Dec 22, 2016, 2:34:33 PM (8 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.

Location:

branches/gbitmap

Files:

• Packages/FastGraphics/ColorFormats/UColorGray1.pas (modified) (2 diffs)
• Packages/FastGraphics/ColorFormats/UColorGray2.pas (modified) (2 diffs)
• Packages/FastGraphics/UFGraphics.pas (modified) (11 diffs)
• Packages/FastGraphics/UGGraphics.pas (modified) (1 diff)
• UFormMain.pas (modified) (3 diffs)

branches/gbitmap/Packages/FastGraphics/ColorFormats/UColorGray1.pas

@@ -46 +46 @@
     procedure Fill(Color: IBColor); override;
     procedure Fill(Func: TGetColorPos); override;
+    procedure Line(P1, P2: TPoint; Color: IBColor); override;
     procedure PaintToCanvas(Canvas: TCanvas); override;
     function GetDataSize: Integer; override;
@@ -132 +133 @@
 end;
 
+procedure TBPixmapGray1.Line(P1, P2: TPoint; Color: IBColor);
+begin
+  Pixmap.Canvas.Pen.Color := (Color as TBColorGray1).Value;
+  Pixmap.Canvas.Pen.MoveTo(P1);
+  Pixmap.Canvas.Pen.LineTo(P2);
+end;
+
 procedure TBPixmapGray1.PaintToCanvas(Canvas: TCanvas);
 begin

branches/gbitmap/Packages/FastGraphics/ColorFormats/UColorGray2.pas

@@ -46 +46 @@
     procedure Fill(Color: IBColor); override;
     procedure Fill(Func: TGetColorPos); override;
+    procedure Line(P1, P2: TPoint; Color: IBColor); override;
     procedure PaintToCanvas(Canvas: TCanvas); override;
     function GetDataSize: Integer; override;
@@ -127 +128 @@
 end;
 
+procedure TBPixmapGray2.Line(P1, P2: TPoint; Color: IBColor);
+begin
+  Pixmap.Canvas.Pen.Color := (Color as TBColorGray2).Value;
+  Pixmap.Canvas.Pen.MoveTo(P1);
+  Pixmap.Canvas.Pen.LineTo(P2);
+end;
+
 procedure TBPixmapGray2.PaintToCanvas(Canvas: TCanvas);
 begin

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;

branches/gbitmap/Packages/FastGraphics/UGGraphics.pas

@@ -192 +192 @@
     ((Canvas as TGCanvas<TGColor>).Bitmap as TGPixmap<TGColor>).Pixels[Trunc(Position.X + I * (Pos.X - Position.X) / Len),
       Trunc(Position.Y + I * (Pos.Y - Position.Y) / Len)] := Color;
+  Position := Pos;
 end;
 

branches/gbitmap/UFormMain.pas

@@ -29 +29 @@
     function RGB8Random(Position: TPoint): TColorRGB8;
     function RGB16Random(Position: TPoint): TColorRGB16;
-    function ColorRandom(Position: TPoint; ColorFormat: TColorFormat): UFGraphics.TFColor;
+    function ColorRandom(Position: TPoint; ColorFormat: TColorFormat): IFColor;
   public
     procedure TestGray1;
@@ -98 +98 @@
 end;
 
-function TForm1.ColorRandom(Position: TPoint; ColorFormat: TColorFormat): UFGraphics.TFColor;
-begin
-  Result := UFGraphics.TFColor.Create;
-  Result.ColorFormat := ColorFormat;
-  Result.SetRandom;
+function TForm1.ColorRandom(Position: TPoint; ColorFormat: TColorFormat): IFColor;
+begin
+  Result := TFColor.Create;
+  (Result as TFColor).ColorFormat := ColorFormat;
+  (Result as TFColor).SetRandom;
 end;
 
@@ -276 +276 @@
   with Image do begin
     Size := Point(100, 100);
-    ColorFormat := ColorFormatManager.Formats[5];
+    ColorFormat := ColorFormatManager.Formats[2];
     Fill(TFColor.Create(ColorFormat, cnWhite));
+    Fill(ColorRandom);
     Pixels[0, 0] := TFColor.Create(ColorFormat, cnBlack);
-    Fill(ColorRandom);
+    Canvas.Pen.Color := TFColor.Create(ColorFormat, cnBlack);
+    Canvas.Pen.MoveTo(Point(10, 20));
+    Canvas.Pen.LineTo(Point(60, 40));
     PaintToCanvas(Image1.Picture.Bitmap.Canvas);
     Label1.Caption := IntToStr(GetDataSize);