Changeset 19 for branches/gbitmap/GImage.pas

Timestamp:

Dec 20, 2016, 6:02:51 PM (8 years ago)

Author:

chronos

Message:

• Added: Define specialized classes for various usual pixmaxs.

Location:

branches/gbitmap

Files:

• . (modified) (1 prop)
• GImage.pas (modified) (6 diffs)

branches/gbitmap

@@ -3 +3 @@
 project1.lps
 project1.res
+project1.exe

@@ -3 +3 @@
 project1.lps
 project1.res
+project1.exe

branches/gbitmap/GImage.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, GPixmap;
+  Classes, SysUtils, Graphics, GPixmap, UPixmapSpecialized;
 
 type
-  TColorGray8 = Byte;
-
-  { TRGB8 }
-
-  TRGB8 = record
-    R: Byte;
-    B: Byte;
-    G: Byte;
-    function Create(R, G, B: Byte): TRGB8;
-  end;
-
-
   TBColor = class
   end;
 
   TBColorGray1 = class(TBColor)
-    Value: TColorGray8;
+    Value: TColorGray1;
+  end;
+
+  TBColorGray2 = class(TBColor)
+    Value: TColorGray2;
   end;
 
   TBColorRGB8 = class(TBColor)
-    Value: TRGB8;
+    Value: TColorRGB8;
   end;
 
@@ -35 +27 @@
 
   TBImage = class
-    procedure Fill(Color: TBColor); virtual;
+  public
+    type
+      TGetColorPos = function (Position: TPoint): TBColor of object;
+  private
+    FSize: TPoint;
+  protected
+    procedure SetSize(AValue: TPoint); virtual;
+  public
+    procedure Fill(Color: TBColor); virtual; overload;
+    procedure Fill(Func: TGetColorPos); virtual; overload;
+    procedure PaintToCanvas(Canvas: TCanvas); virtual;
+    property Size: TPoint read FSize write SetSize;
   end;
 
@@ -41 +44 @@
 
   TBImageGray1 = class(TBImage)
-    Pixmap: TGPixmap<TColorGray8>;
+  protected
+    procedure SetSize(AValue: TPoint); override;
+  public
+    Pixmap: TPixmapGray1;
     procedure Fill(Color: TBColor); override;
+    procedure Fill(Func: TGetColorPos); override;
+    procedure PaintToCanvas(Canvas: TCanvas); override;
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+  { TBImageGray2 }
+
+  TBImageGray2 = class(TBImage)
+  protected
+    procedure SetSize(AValue: TPoint); override;
+  public
+    Pixmap: TPixmapGray2;
+    procedure Fill(Color: TBColor); override;
+    procedure PaintToCanvas(Canvas: TCanvas); override;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
@@ -48 +71 @@
 
   TBImageRGB8 = class(TBImage)
-    Pixmap: TGPixmap<TRGB8>;
+  protected
+    procedure SetSize(AValue: TPoint); override;
+  public
+    Pixmap: TGPixmap<TColorRGB8>;
     procedure Fill(Color: TBColor); override;
-  end;
-
-
-  TColorFormat = (cfNone, cfGray1, cfRGB8);
-
-  { TImage }
-
-  TImage = class
+    constructor Create;
+    destructor Destroy; override;
+  end;
+
+
+  TColorFormat = (cfNone, cfGray1, cfGray2, cfGray4, cfGray8, cfGray16, cfGray32,
+    cfRGB8, cfRGB16);
+
+  { TGImage }
+
+  TGImage = class
+  public
+    type
+      TGetColorPos = function (Position: TPoint): TBColor of object;
   private
     FBackend: TBImage;
     FColorFormat: TColorFormat;
+    FSize: TPoint;
     procedure SetColorFormat(AValue: TColorFormat);
+    procedure SetSize(AValue: TPoint);
   public
     property Backend: TBImage read FBackend;
     property ColorFormat: TColorFormat read FColorFormat write SetColorFormat;
-    procedure Fill(Color: TBColor);
-    constructor Create;
-    destructor Destroy; override;
-  end;
+    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;
+  end;
+
 
 implementation
 
-{ TRGB8 }
-
-function TRGB8.Create(R, G, B: Byte): TRGB8;
-begin
-  Result.R := R;
-  Result.G := G;
-  Result.B := B;
-end;
+{ TBImageGray2 }
+
+procedure TBImageGray2.SetSize(AValue: TPoint);
+begin
+  inherited;
+  Pixmap.Size := AValue;
+end;
+
+procedure TBImageGray2.Fill(Color: TBColor);
+begin
+  if Color is TBColorGray2 then
+    Pixmap.Fill((Color as TBColorGray2).Value);
+end;
+
+procedure TBImageGray2.PaintToCanvas(Canvas: TCanvas);
+begin
+  Pixmap.PaintToCanvas(Canvas, Pixmap.Gray2ToColor);
+end;
+
+constructor TBImageGray2.Create;
+begin
+  Pixmap := TPixmapGray2.Create;
+end;
+
+destructor TBImageGray2.Destroy;
+begin
+  Pixmap.Free;
+  inherited Destroy;
+end;
+
 
 { TBImageRGB8 }
+
+procedure TBImageRGB8.SetSize(AValue: TPoint);
+begin
+  inherited;
+  Pixmap.Size := AValue;
+end;
 
 procedure TBImageRGB8.Fill(Color: TBColor);
@@ -89 +155 @@
 end;
 
+constructor TBImageRGB8.Create;
+begin
+  Pixmap := TGPixmap<TColorRGB8>.Create;
+end;
+
+destructor TBImageRGB8.Destroy;
+begin
+  Pixmap.Free;
+  inherited Destroy;
+end;
+
 { TBImage }
 
+procedure TBImage.SetSize(AValue: TPoint);
+begin
+  if (FSize.X = AValue.X) and (FSize.Y = AValue.Y) then Exit;
+  FSize := AValue;
+end;
+
 procedure TBImage.Fill(Color: TBColor);
 begin
 end;
 
+procedure TBImage.Fill(Func: TGetColorPos);
+begin
+end;
+
+procedure TBImage.PaintToCanvas(Canvas: TCanvas);
+begin
+end;
+
 { TBImageGray1 }
+
+procedure TBImageGray1.SetSize(AValue: TPoint);
+begin
+  inherited;
+  Pixmap.Size := AValue;
+end;
 
 procedure TBImageGray1.Fill(Color: TBColor);
@@ -103 +200 @@
 end;
 
-{ TImage }
-
-procedure TImage.SetColorFormat(AValue: TColorFormat);
+procedure TBImageGray1.Fill(Func: TGetColorPos);
+begin
+  //Pixmap.Fill();
+end;
+
+procedure TBImageGray1.PaintToCanvas(Canvas: TCanvas);
+begin
+  Pixmap.PaintToCanvas(Canvas, Pixmap.Gray1ToColor);
+end;
+
+constructor TBImageGray1.Create;
+begin
+  Pixmap := TPixmapGray1.Create;
+end;
+
+destructor TBImageGray1.Destroy;
+begin
+  Pixmap.Free;
+  inherited Destroy;
+end;
+
+{ TGImage }
+
+procedure TGImage.SetColorFormat(AValue: TColorFormat);
 begin
   if FColorFormat = AValue then Exit;
   FBackend.Free;
-  if FColorFormat = cfGray1 then
-    FBackend := TBImageGray1.Create;
-  if FColorFormat = cfRGB8 then
-    FBackend := TBImageRGB8.Create;
+  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;
   FColorFormat := AValue;
 end;
 
-procedure TImage.Fill(Color: TBColor);
-begin
-  if Assigned(Backend) then
-    Backend.Fill(Color);
-end;
-
-constructor TImage.Create;
+procedure TGImage.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 TImage.Destroy;
+destructor TGImage.Destroy;
 begin
   if Assigned(FBackend) then FreeAndNil(FBackend);

@@ -3 +3 @@
 project1.lps
 project1.res
+project1.exe