Changeset 20 for branches/gbitmap/GImage.pas

Timestamp:

Dec 21, 2016, 3:49:27 PM (8 years ago)

Author:

chronos

Message:

• Modified: For single class layer TPixmap and TColor is used. They have TBPixmap and TBColor backends pairs.

File:

• branches/gbitmap/GImage.pas (modified) (16 diffs)

branches/gbitmap/GImage.pas

@@ -9 +9 @@
 
 type
-  TBColor = class
-  end;
-
-  TBColorGray1 = class(TBColor)
+  TColorFormat = (cfNone, cfGray1, cfGray2, cfGray4, cfGray8, cfGray16, cfGray32,
+    cfRGB8, cfRGB16);
+
+  TColorName = (cnBlack, cnWhite, cnBlue, cnRed, cnGreen, cnGray, cnSilver);
+
+  IBColor = interface
+    procedure SetColorName(ColorName: TColorName);
+    procedure SetRandom;
+  end;
+
+  { TBColorNone }
+
+  TBColorNone = class(TInterfacedObject, IBColor)
+    procedure SetColorName(ColorName: TColorName);
+    procedure SetRandom;
+  end;
+
+  { TBColorGray1 }
+
+  TBColorGray1 = class(TInterfacedObject, IBColor)
     Value: TColorGray1;
-  end;
-
-  TBColorGray2 = class(TBColor)
+    constructor Create(Color: TColorGray1);
+    procedure SetColorName(ColorName: TColorName);
+    procedure SetRandom;
+  end;
+
+  { TBColorGray2 }
+
+  TBColorGray2 = class(TInterfacedObject, IBColor)
     Value: TColorGray2;
-  end;
-
-  TBColorRGB8 = class(TBColor)
+    constructor Create(Color: TColorGray2);
+    procedure SetColorName(ColorName: TColorName);
+    procedure SetRandom;
+  end;
+
+  { TBColorRGB8 }
+
+  TBColorRGB8 = class(TInterfacedObject, IBColor)
     Value: TColorRGB8;
+    constructor Create(Color: TColorRGB8);
+    procedure SetColorName(ColorName: TColorName);
+    procedure SetRandom;
   end;
 
@@ -29 +58 @@
   public
     type
-      TGetColorPos = function (Position: TPoint): TBColor of object;
+      TGetColorPos = function (Position: TPoint): IBColor of object;
   private
     FSize: TPoint;
+    function GetPixel(X, Y: Integer): IBColor;  virtual;
+    procedure SetPixel(X, Y: Integer; AValue: IBColor); virtual;
   protected
     procedure SetSize(AValue: TPoint); virtual;
   public
-    procedure Fill(Color: TBColor); virtual; overload;
+    procedure Fill(Color: IBColor); virtual; overload;
     procedure Fill(Func: TGetColorPos); virtual; overload;
     procedure PaintToCanvas(Canvas: TCanvas); virtual;
+    function GetDataSize: Integer; virtual;
     property Size: TPoint read FSize write SetSize;
+    property Pixels[X, Y: Integer]: IBColor read GetPixel write SetPixel;
   end;
 
@@ -44 +77 @@
 
   TBImageGray1 = class(TBImage)
+  private
+    FillCallBack: TGetColorPos;
+    function FillGetColor(Position: TPoint): TColorGray1;
   protected
     procedure SetSize(AValue: TPoint); override;
+    function GetPixel(X, Y: Integer): IBColor;  override;
+    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
   public
     Pixmap: TPixmapGray1;
-    procedure Fill(Color: TBColor); override;
+    procedure Fill(Color: IBColor); override;
     procedure Fill(Func: TGetColorPos); override;
     procedure PaintToCanvas(Canvas: TCanvas); override;
+    function GetDataSize: Integer; override;
     constructor Create;
     destructor Destroy; override;
@@ -58 +97 @@
 
   TBImageGray2 = class(TBImage)
+  private
+    FillCallBack: TGetColorPos;
+    function FillGetColor(Position: TPoint): TColorGray1;
   protected
     procedure SetSize(AValue: TPoint); override;
+    function GetPixel(X, Y: Integer): IBColor;  override;
+    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
   public
     Pixmap: TPixmapGray2;
-    procedure Fill(Color: TBColor); override;
+    procedure Fill(Color: IBColor); override;
+    procedure Fill(Func: TGetColorPos); override;
     procedure PaintToCanvas(Canvas: TCanvas); override;
+    function GetDataSize: Integer; override;
     constructor Create;
     destructor Destroy; override;
@@ -75 +121 @@
   public
     Pixmap: TGPixmap<TColorRGB8>;
-    procedure Fill(Color: TBColor); override;
+    procedure Fill(Color: IBColor); override;
     constructor Create;
     destructor Destroy; override;
   end;
 
-
-  TColorFormat = (cfNone, cfGray1, cfGray2, cfGray4, cfGray8, cfGray16, cfGray32,
-    cfRGB8, cfRGB16);
-
-  { TGImage }
-
-  TGImage = class
+  { TColor }
+
+  TColor = class
+  private
+    FBackend: IBColor;
+    FColorFormat: TColorFormat;
+    procedure SetColorFormat(AValue: TColorFormat);
+  public
+    property Backend: IBColor read FBackend;
+    property ColorFormat: TColorFormat read FColorFormat write SetColorFormat;
+    procedure SetColorName(ColorName: TColorName);
+    procedure SetRandom;
+    constructor Create; overload;
+    constructor Create(ColorFormat: TColorFormat; ColorName: TColorName); overload;
+    destructor Destroy; override;
+  end;
+
+  { TPixmap }
+
+  TPixmap = class
   public
     type
-      TGetColorPos = function (Position: TPoint): TBColor of object;
+      TGetColorPos = function (Position: TPoint; ColorFormat: TColorFormat): TColor of object;
   private
     FBackend: TBImage;
     FColorFormat: TColorFormat;
     FSize: TPoint;
+    FillCallBack: TGetColorPos;
+    function FillGetColor(Position: TPoint): IBColor;
+    function GetPixel(X, Y: Integer): TColor;
     procedure SetColorFormat(AValue: TColorFormat);
+    procedure SetPixel(X, Y: Integer; AValue: TColor);
     procedure SetSize(AValue: TPoint);
   public
+    procedure Fill(Color: TColor); overload;
+    procedure Fill(Func: TGetColorPos); overload;
+    procedure PaintToCanvas(Canvas: TCanvas);
+    function GetDataSize: Integer;
+    constructor Create;
+    destructor Destroy; override;
     property Backend: TBImage read FBackend;
     property ColorFormat: TColorFormat read FColorFormat write SetColorFormat;
     property Size: TPoint read FSize write SetSize;
-    procedure Fill(Color: TBColor); overload;
-    procedure Fill(Func: TGetColorPos); overload;
-    procedure PaintToCanvas(Canvas: TCanvas);
-    constructor Create;
-    destructor Destroy; override;
+    property Pixels[X, Y: Integer]: TColor read GetPixel write SetPixel;
   end;
 
@@ -110 +175 @@
 implementation
 
+{ TBColorNone }
+
+procedure TBColorNone.SetColorName(ColorName: TColorName);
+begin
+end;
+
+procedure TBColorNone.SetRandom;
+begin
+end;
+
+{ TColor }
+
+procedure TColor.SetColorFormat(AValue: TColorFormat);
+begin
+  if FColorFormat = AValue then Exit;
+  if AValue = cfGray1 then FBackend := TBColorGray1.Create(0)
+    else if AValue = cfGray2 then FBackend := TBColorGray2.Create(0)
+    else if AValue = cfRGB8 then FBackend := TBColorRGB8.Create(TColorRGB8.Create(0, 0, 0))
+    else raise Exception.Create('Missing color backend for specified color format');
+  FColorFormat := AValue;
+end;
+
+procedure TColor.SetColorName(ColorName: TColorName);
+begin
+  FBackend.SetColorName(ColorName);
+end;
+
+procedure TColor.SetRandom;
+begin
+  FBackend.SetRandom;
+end;
+
+constructor TColor.Create;
+begin
+  ColorFormat := cfNone;
+end;
+
+constructor TColor.Create(ColorFormat: TColorFormat; ColorName: TColorName);
+begin
+  Self.ColorFormat := ColorFormat;
+  Backend.SetColorName(ColorName);
+end;
+
+destructor TColor.Destroy;
+begin
+  inherited Destroy;
+end;
+
+{ TBColorRGB8 }
+
+constructor TBColorRGB8.Create(Color: TColorRGB8);
+begin
+  Value := Color;
+end;
+
+procedure TBColorRGB8.SetColorName(ColorName: TColorName);
+begin
+  case ColorName of
+    cnBlack: Value := TColorRGB8.Create(0, 0, 0);
+    cnGray: Value := TColorRGB8.Create($80, $80, $80);
+    cnSilver: Value := TColorRGB8.Create($C0, $C0, $C0);
+    cnWhite: Value := TColorRGB8.Create($ff, $ff, $ff);
+    else Value := TColorRGB8.Create(0, 0, 0);;
+  end;
+end;
+
+procedure TBColorRGB8.SetRandom;
+begin
+  Value := TColorRGB8.Create(Random(256), Random(256), Random(256));
+end;
+
+{ TBColorGray2 }
+
+constructor TBColorGray2.Create(Color: TColorGray2);
+begin
+  Value := Color;
+end;
+
+procedure TBColorGray2.SetColorName(ColorName: TColorName);
+begin
+  case ColorName of
+    cnBlack: Value := 0;
+    cnGray: Value := 1;
+    cnSilver: Value := 2;
+    cnWhite: Value := 3;
+    else Value := 0;
+  end;
+end;
+
+procedure TBColorGray2.SetRandom;
+begin
+  Random(4);
+end;
+
+{ TBColorGray1 }
+
+constructor TBColorGray1.Create(Color: TColorGray1);
+begin
+  Value := Color;
+end;
+
+procedure TBColorGray1.SetColorName(ColorName: TColorName);
+begin
+  case ColorName of
+    cnBlack: Value := 0;
+    cnWhite: Value := 1;
+    else Value := 0;
+  end;
+end;
+
+procedure TBColorGray1.SetRandom;
+begin
+  Value := Random(2);
+end;
+
 { TBImageGray2 }
+
+function TBImageGray2.FillGetColor(Position: TPoint): TColorGray1;
+begin
+  Result := (FillCallBack(Position) as TBColorGray2).Value;
+end;
 
 procedure TBImageGray2.SetSize(AValue: TPoint);
@@ -118 +303 @@
 end;
 
-procedure TBImageGray2.Fill(Color: TBColor);
+function TBImageGray2.GetPixel(X, Y: Integer): IBColor;
+begin
+  Result := TBColorGray2.Create(Pixmap.Pixels[X, Y]);
+end;
+
+procedure TBImageGray2.SetPixel(X, Y: Integer; AValue: IBColor);
+begin
+  Pixmap.Pixels[X, Y] := (AValue as TBColorGray2).Value;
+end;
+
+procedure TBImageGray2.Fill(Color: IBColor);
 begin
   if Color is TBColorGray2 then
@@ -124 +319 @@
 end;
 
+procedure TBImageGray2.Fill(Func: TGetColorPos);
+begin
+  FillCallBack := Func;
+  Pixmap.Fill(FillGetColor);
+end;
+
 procedure TBImageGray2.PaintToCanvas(Canvas: TCanvas);
 begin
@@ -129 +330 @@
 end;
 
+function TBImageGray2.GetDataSize: Integer;
+begin
+  Result := Pixmap.GetDataSize;
+end;
+
 constructor TBImageGray2.Create;
 begin
   Pixmap := TPixmapGray2.Create;
+  Pixmap.BitsPerPixel := 2;
 end;
 
 destructor TBImageGray2.Destroy;
 begin
-  Pixmap.Free;
-  inherited Destroy;
+  FreeAndNil(Pixmap);
+  inherited;
 end;
 
@@ -149 +356 @@
 end;
 
-procedure TBImageRGB8.Fill(Color: TBColor);
+procedure TBImageRGB8.Fill(Color: IBColor);
 begin
   if Color is TBColorRGB8 then
@@ -162 +369 @@
 destructor TBImageRGB8.Destroy;
 begin
-  Pixmap.Free;
+  FreeAndNil(Pixmap);
   inherited Destroy;
 end;
 
 { TBImage }
+
+function TBImage.GetPixel(X, Y: Integer): IBColor;
+begin
+  Result := TBColorNone.Create;
+end;
+
+procedure TBImage.SetPixel(X, Y: Integer; AValue: IBColor);
+begin
+end;
 
 procedure TBImage.SetSize(AValue: TPoint);
@@ -174 +390 @@
 end;
 
-procedure TBImage.Fill(Color: TBColor);
+procedure TBImage.Fill(Color: IBColor);
 begin
 end;
@@ -186 +402 @@
 end;
 
+function TBImage.GetDataSize: Integer;
+begin
+  Result := 0;
+end;
+
 { TBImageGray1 }
+
+function TBImageGray1.FillGetColor(Position: TPoint): TColorGray1;
+begin
+  Result := (FillCallBack(Position) as TBColorGray1).Value;
+end;
 
 procedure TBImageGray1.SetSize(AValue: TPoint);
@@ -194 +420 @@
 end;
 
-procedure TBImageGray1.Fill(Color: TBColor);
+function TBImageGray1.GetPixel(X, Y: Integer): IBColor;
+begin
+  Result := TBColorGray1.Create(Pixmap.Pixels[X, Y]);
+end;
+
+procedure TBImageGray1.SetPixel(X, Y: Integer; AValue: IBColor);
+begin
+  Pixmap.Pixels[X, Y] := (AValue as TBColorGray1).Value;
+end;
+
+procedure TBImageGray1.Fill(Color: IBColor);
 begin
   if Color is TBColorGray1 then
@@ -202 +438 @@
 procedure TBImageGray1.Fill(Func: TGetColorPos);
 begin
-  //Pixmap.Fill();
+  FillCallBack := Func;
+  Pixmap.Fill(FillGetColor);
 end;
 
@@ -210 +447 @@
 end;
 
+function TBImageGray1.GetDataSize: Integer;
+begin
+  Result := Pixmap.GetDataSize;
+end;
+
 constructor TBImageGray1.Create;
 begin
   Pixmap := TPixmapGray1.Create;
+  Pixmap.BitsPerPixel := 1;
 end;
 
 destructor TBImageGray1.Destroy;
 begin
-  Pixmap.Free;
-  inherited Destroy;
-end;
-
-{ TGImage }
-
-procedure TGImage.SetColorFormat(AValue: TColorFormat);
+  FreeAndNil(Pixmap);
+  inherited;
+end;
+
+{ TPixmap }
+
+procedure TPixmap.SetColorFormat(AValue: TColorFormat);
 begin
   if FColorFormat = AValue then Exit;
   FBackend.Free;
   if AValue = cfGray1 then FBackend := TBImageGray1.Create
-  else if AValue = cfGray2 then FBackend := TBImageGray2.Create
-  else if AValue = cfRGB8 then FBackend := TBImageRGB8.Create
-  else FBackend := nil;
-  if Assigned(FBackend) then FBackend.Size := FSize;
+    else if AValue = cfGray2 then FBackend := TBImageGray2.Create
+    else if AValue = cfRGB8 then FBackend := TBImageRGB8.Create
+    else raise Exception.Create('Missing image backend for specified color format');
+  FBackend.Size := FSize;
   FColorFormat := AValue;
 end;
 
-procedure TGImage.SetSize(AValue: TPoint);
+function TPixmap.FillGetColor(Position: TPoint): IBColor;
+begin
+  Result := FillCallBack(Position, ColorFormat).Backend;
+end;
+
+function TPixmap.GetPixel(X, Y: Integer): TColor;
+begin
+  Result := TColor.Create;
+  Result.ColorFormat := ColorFormat;
+  Result.FBackend := FBackend.Pixels[X, Y];
+end;
+
+procedure TPixmap.SetPixel(X, Y: Integer; AValue: TColor);
+begin
+  FBackend.Pixels[X, Y] := AValue.FBackend;
+end;
+
+procedure TPixmap.SetSize(AValue: TPoint);
 begin
   if (FSize.X = AValue.X) and (FSize.Y = AValue.Y) then Exit;
   FSize := AValue;
-  if Assigned(FBackend) then
-    FBackend.Size := AValue;
-end;
-
-procedure TGImage.Fill(Color: TBColor);
-begin
-  if Assigned(FBackend) then FBackend.Fill(Color);
-end;
-
-procedure TGImage.Fill(Func: TGetColorPos);
-begin
-//  if Assigned(FBackend) then FBackend.Fill(Func: TGetColorPos);
-end;
-
-procedure TGImage.PaintToCanvas(Canvas: TCanvas);
-begin
-  if Assigned(FBackend) then FBackend.PaintToCanvas(Canvas);
-end;
-
-constructor TGImage.Create;
-begin
-  FBackend := nil;
-end;
-
-destructor TGImage.Destroy;
-begin
-  if Assigned(FBackend) then FreeAndNil(FBackend);
+  FBackend.Size := AValue;
+end;
+
+procedure TPixmap.Fill(Color: TColor);
+begin
+  FBackend.Fill(Color.Backend);
+end;
+
+procedure TPixmap.Fill(Func: TGetColorPos);
+begin
+  FillCallBack := Func;
+  FBackend.Fill(FillGetColor);
+end;
+
+procedure TPixmap.PaintToCanvas(Canvas: TCanvas);
+begin
+  FBackend.PaintToCanvas(Canvas);
+end;
+
+function TPixmap.GetDataSize: Integer;
+begin
+  FBackend.GetDataSize;
+end;
+
+constructor TPixmap.Create;
+begin
+  FBackend := TBImage.Create;
+end;
+
+destructor TPixmap.Destroy;
+begin
+  FreeAndNil(FBackend);
   inherited Destroy;
 end;
 
 end.
-
+       3