Changeset 21 for branches/gbitmap/GImage.pas

Timestamp:

Dec 22, 2016, 1:01:41 PM (8 years ago)

Author:

chronos

Message:

• Added: Color format manager.
• Modified: Color formats moved to separate files.

Location:

branches/gbitmap

Files:

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

branches/gbitmap

@@ -4 +4 @@
 project1.res
 project1.exe
+heaptrclog.trc

@@ -4 +4 @@
 project1.res
 project1.exe
+heaptrclog.trc

branches/gbitmap/GImage.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Graphics, GPixmap, UPixmapSpecialized;
+  Classes, SysUtils, Graphics, GPixmap, UPixmapSpecialized, Contnrs;
 
 type
-  TColorFormat = (cfNone, cfGray1, cfGray2, cfGray4, cfGray8, cfGray16, cfGray32,
-    cfRGB8, cfRGB16);
-
   TColorName = (cnBlack, cnWhite, cnBlue, cnRed, cnGreen, cnGray, cnSilver);
 
@@ -19 +16 @@
   end;
 
-  { TBColorNone }
-
-  TBColorNone = class(TInterfacedObject, IBColor)
-    procedure SetColorName(ColorName: TColorName);
-    procedure SetRandom;
-  end;
-
-  { TBColorGray1 }
-
-  TBColorGray1 = class(TInterfacedObject, IBColor)
-    Value: TColorGray1;
-    constructor Create(Color: TColorGray1);
-    procedure SetColorName(ColorName: TColorName);
-    procedure SetRandom;
-  end;
-
-  { TBColorGray2 }
-
-  TBColorGray2 = class(TInterfacedObject, IBColor)
-    Value: TColorGray2;
-    constructor Create(Color: TColorGray2);
-    procedure SetColorName(ColorName: TColorName);
-    procedure SetRandom;
-  end;
+  { TBColor }
+
+  TBColor = class(TInterfacedObject, IBColor)
+    procedure SetColorName(ColorName: TColorName); virtual;
+    procedure SetRandom; virtual;
+  end;
+
+  IBColorClass = class of TBColor;
 
   { TBColorRGB8 }
 
-  TBColorRGB8 = class(TInterfacedObject, IBColor)
+  TBColorRGB8 = class(TBColor)
     Value: TColorRGB8;
     constructor Create(Color: TColorRGB8);
-    procedure SetColorName(ColorName: TColorName);
-    procedure SetRandom;
+    procedure SetColorName(ColorName: TColorName); override;
+    procedure SetRandom; override;
   end;
 
@@ -61 +42 @@
   private
     FSize: TPoint;
+  protected
     function GetPixel(X, Y: Integer): IBColor;  virtual;
     procedure SetPixel(X, Y: Integer; AValue: IBColor); virtual;
-  protected
     procedure SetSize(AValue: TPoint); virtual;
   public
@@ -70 +51 @@
     procedure PaintToCanvas(Canvas: TCanvas); virtual;
     function GetDataSize: Integer; virtual;
+    constructor Create; virtual;
     property Size: TPoint read FSize write SetSize;
     property Pixels[X, Y: Integer]: IBColor read GetPixel write SetPixel;
   end;
 
-  { TBImageGray1 }
-
-  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: IBColor); override;
-    procedure Fill(Func: TGetColorPos); override;
-    procedure PaintToCanvas(Canvas: TCanvas); override;
-    function GetDataSize: Integer; override;
-    constructor Create;
-    destructor Destroy; override;
-  end;
-
-  { TBImageGray2 }
-
-  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: IBColor); override;
-    procedure Fill(Func: TGetColorPos); override;
-    procedure PaintToCanvas(Canvas: TCanvas); override;
-    function GetDataSize: Integer; override;
-    constructor Create;
-    destructor Destroy; override;
-  end;
+  TBPixmapClass = class of TBImage;
 
   { TBImageRGB8 }
@@ -124 +68 @@
     constructor Create;
     destructor Destroy; override;
+  end;
+
+  { TColorFormatChannel }
+
+  TColorFormatChannel = record
+    Name: string;
+    Position: Integer;
+    BitWidth: Integer;
+  end;
+
+  { TColorFormat }
+
+  TColorFormat = class
+    Name: string;
+    BitDepth: Integer;
+    Channels: array of TColorFormatChannel;
+    BackendColorClass: IBColorClass;
+    BackendImageClass: TBPixmapClass;
+    procedure AddChannel(Name: string; Position, BitWidth: Integer);
+    function GetBackendColor: IBColor;
+    function GetBackendImage: TBImage;
+    constructor Create; virtual;
+    function GetChannelStateCount(Channel: Integer): Integer;
+  end;
+
+  TColorFormatClass = class of TColorFormat;
+
+  { TColorFormatManager }
+
+  TColorFormatManager = class
+  private
+    FFormats: TObjectList; // TList<TColorFormat>
+    function GetFormat(Index: Integer): TColorFormat;
+  public
+    constructor Create; virtual;
+     destructor Destroy; override;
+    procedure RegisterFormat(Format: TColorFormatClass);
+    function FormatCount: Integer;
+    property Formats[Index: Integer]: TColorFormat read GetFormat;
   end;
 
@@ -172 +155 @@
   end;
 
+var
+  ColorFormatManager: TColorFormatManager;
+
 
 implementation
 
-{ TBColorNone }
-
-procedure TBColorNone.SetColorName(ColorName: TColorName);
-begin
-end;
-
-procedure TBColorNone.SetRandom;
-begin
+{ TBColor }
+
+procedure TBColor.SetColorName(ColorName: TColorName);
+begin
+end;
+
+procedure TBColor.SetRandom;
+begin
+end;
+
+{ TColorFormatManager }
+
+function TColorFormatManager.GetFormat(Index: Integer): TColorFormat;
+begin
+  Result := TColorFormat(FFormats[Index]);
+end;
+
+constructor TColorFormatManager.Create;
+begin
+  FFormats := TObjectList.Create;
+end;
+
+destructor TColorFormatManager.Destroy;
+begin
+  FreeAndNil(FFormats);
+  inherited Destroy;
+end;
+
+procedure TColorFormatManager.RegisterFormat(Format: TColorFormatClass);
+begin
+  FFormats.Add(Format.Create);
+end;
+
+function TColorFormatManager.FormatCount: Integer;
+begin
+  Result := FFormats.Count;
+end;
+
+{ TColorFormat }
+
+procedure TColorFormat.AddChannel(Name: string; Position, BitWidth: Integer);
+begin
+  SetLength(Channels, Length(Channels) + 1);
+  Channels[Length(Channels) - 1].Name := Name;
+  Channels[Length(Channels) - 1].Position := Position;
+  Channels[Length(Channels) - 1].BitWidth := BitWidth;
+end;
+
+function TColorFormat.GetBackendColor: IBColor;
+begin
+  Result := BackendColorClass.Create;
+end;
+
+function TColorFormat.GetBackendImage: TBImage;
+begin
+  Result := BackendImageClass.Create;
+end;
+
+constructor TColorFormat.Create;
+begin
+  Name := 'None';
+  BitDepth := 0;
+  BackendColorClass := TBColor;
+  BackendImageClass := TBImage;
+end;
+
+function TColorFormat.GetChannelStateCount(Channel: Integer): Integer;
+begin
+  Result := 1 shl Channels[Channel].BitWidth;
 end;
 
@@ -190 +237 @@
 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');
+  FBackend := AValue.GetBackendColor;
   FColorFormat := AValue;
 end;
@@ -209 +253 @@
 constructor TColor.Create;
 begin
-  ColorFormat := cfNone;
+  ColorFormat := ColorFormatManager.GetFormat(0);
 end;
 
@@ -246 +290 @@
 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);
+{ TBImageRGB8 }
+
+procedure TBImageRGB8.SetSize(AValue: TPoint);
 begin
   inherited;
@@ -303 +298 @@
 end;
 
-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
-    Pixmap.Fill((Color as TBColorGray2).Value);
-end;
-
-procedure TBImageGray2.Fill(Func: TGetColorPos);
-begin
-  FillCallBack := Func;
-  Pixmap.Fill(FillGetColor);
-end;
-
-procedure TBImageGray2.PaintToCanvas(Canvas: TCanvas);
-begin
-  Pixmap.PaintToCanvas(Canvas, Pixmap.Gray2ToColor);
-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
-  FreeAndNil(Pixmap);
-  inherited;
-end;
-
-
-{ TBImageRGB8 }
-
-procedure TBImageRGB8.SetSize(AValue: TPoint);
-begin
-  inherited;
-  Pixmap.Size := AValue;
-end;
-
 procedure TBImageRGB8.Fill(Color: IBColor);
 begin
@@ -377 +319 @@
 function TBImage.GetPixel(X, Y: Integer): IBColor;
 begin
-  Result := TBColorNone.Create;
+  Result := TBColor.Create;
 end;
 
@@ -407 +349 @@
 end;
 
-{ TBImageGray1 }
-
-function TBImageGray1.FillGetColor(Position: TPoint): TColorGray1;
-begin
-  Result := (FillCallBack(Position) as TBColorGray1).Value;
-end;
-
-procedure TBImageGray1.SetSize(AValue: TPoint);
-begin
-  inherited;
-  Pixmap.Size := AValue;
-end;
-
-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
-    Pixmap.Fill((Color as TBColorGray1).Value);
-end;
-
-procedure TBImageGray1.Fill(Func: TGetColorPos);
-begin
-  FillCallBack := Func;
-  Pixmap.Fill(FillGetColor);
-end;
-
-procedure TBImageGray1.PaintToCanvas(Canvas: TCanvas);
-begin
-  Pixmap.PaintToCanvas(Canvas, Pixmap.Gray1ToColor);
-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
-  FreeAndNil(Pixmap);
-  inherited;
+constructor TBImage.Create;
+begin
+  Size := Point(0, 0);
 end;
 
@@ -470 +360 @@
   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 raise Exception.Create('Missing image backend for specified color format');
+  FBackend := AValue.GetBackendImage;
   FBackend.Size := FSize;
   FColorFormat := AValue;
@@ -525 +412 @@
 constructor TPixmap.Create;
 begin
+  ColorFormat := ColorFormatManager.GetFormat(0);
   FBackend := TBImage.Create;
 end;
@@ -534 +422 @@
 end;
 
+
+initialization
+
+ColorFormatManager := TColorFormatManager.Create;
+ColorFormatManager.RegisterFormat(TColorFormat);
+//TColorFormat = (cfNone, cfGray1, cfGray2, cfGray4, cfGray8, cfGray16, cfGray32,
+//  cfRGB8, cfRGB16);
+
+
+finalization
+
+FreeAndNil(ColorFormatManager);
+
+
 end.
-       3
+

@@ -4 +4 @@
 project1.res
 project1.exe
+heaptrclog.trc