source: branches/gbitmap/Packages/FastGraphics/UFGraphics.pas

unit UFGraphics;

{$mode delphi}

interface

uses
  Classes, SysUtils, Graphics, UGGraphics, UPixmapSpecialized, Contnrs;

type
  TColorName = (cnBlack, cnWhite, cnBlue, cnRed, cnGreen, cnGray, cnSilver);

  IBColor = interface
    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;

  { TBImage }

  TBImage = class
  public
    type
      TGetColorPos = function (Position: TPoint): IBColor of object;
  private
    FSize: TPoint;
  protected
    function GetPixel(X, Y: Integer): IBColor;  virtual;
    procedure SetPixel(X, Y: Integer; AValue: IBColor); virtual;
    procedure SetSize(AValue: TPoint); virtual;
  public
    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;
    constructor Create; virtual;
    property Size: TPoint read FSize write SetSize;
    property Pixels[X, Y: Integer]: IBColor read GetPixel write SetPixel;
  end;

  TBPixmapClass = class of TBImage;

  { 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;

  IFColor = interface
  end;

  { TFColor }

  TFColor = class(TInterfacedObject, IFColor)
  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;

  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 }

  TFPixmap = class(TComponent)
  public
    type
      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): IFColor;
    procedure SetColorFormat(AValue: TColorFormat);
    procedure SetPixel(X, Y: Integer; AValue: IFColor);
    procedure SetSize(AValue: TPoint);
  public
    procedure Fill(Color: IFColor); overload;
    procedure Fill(Func: TGetColorPos); overload;
    procedure PaintToCanvas(Canvas: TCanvas);
    function GetDataSize: Integer;
    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]: IFColor read GetPixel write SetPixel;
  end;

procedure Register;

var
  ColorFormatManager: TColorFormatManager;


implementation

uses
  UColorGray1, UColorGray2,UColorGray4, UColorGray8, UColorRGB8, UColorRGBA8,
  UColorRGB565;

procedure Register;
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;

{ 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;

{ TFColor }

procedure TFColor.SetColorFormat(AValue: TColorFormat);
begin
  if FColorFormat = AValue then Exit;
  FBackend := AValue.GetBackendColor;
  FColorFormat := AValue;
end;

procedure TFColor.SetColorName(ColorName: TColorName);
begin
  FBackend.SetColorName(ColorName);
end;

procedure TFColor.SetRandom;
begin
  FBackend.SetRandom;
end;

constructor TFColor.Create;
begin
  ColorFormat := ColorFormatManager.GetFormat(0);
end;

constructor TFColor.Create(ColorFormat: TColorFormat; ColorName: TColorName);
begin
  Self.ColorFormat := ColorFormat;
  Backend.SetColorName(ColorName);
end;

destructor TFColor.Destroy;
begin
  FColorFormat := nil;
  inherited Destroy;
end;

{ TBImage }

function TBImage.GetPixel(X, Y: Integer): IBColor;
begin
  Result := TBColor.Create;
end;

procedure TBImage.SetPixel(X, Y: Integer; AValue: IBColor);
begin
end;

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: IBColor);
begin
end;

procedure TBImage.Fill(Func: TGetColorPos);
begin
end;

procedure TBImage.Line(P1, P2: TPoint; Color: IBColor);
begin
end;

procedure TBImage.PaintToCanvas(Canvas: TCanvas);
begin
end;

function TBImage.GetDataSize: Integer;
begin
  Result := 0;
end;

constructor TBImage.Create;
begin
  Size := Point(0, 0);
end;

{ TFPixmap }

procedure TFPixmap.SetColorFormat(AValue: TColorFormat);
begin
  if FColorFormat = AValue then Exit;
  FBackend.Free;
  FBackend := AValue.GetBackendImage;
  FBackend.Size := FSize;
  FColorFormat := AValue;
end;

function TFPixmap.FillGetColor(Position: TPoint): IBColor;
begin
  Result := (FillCallBack(Position, ColorFormat) as TFColor).Backend;
end;

function TFPixmap.GetPixel(X, Y: Integer): IFColor;
begin
  Result := TFColor.Create;
  (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;

procedure TFPixmap.SetSize(AValue: TPoint);
begin
  if (FSize.X = AValue.X) and (FSize.Y = AValue.Y) then Exit;
  FSize := AValue;
  FBackend.Size := AValue;
end;

procedure TFPixmap.Fill(Color: IFColor);
begin
  FBackend.Fill((Color as TFColor).Backend);
end;

procedure TFPixmap.Fill(Func: TGetColorPos);
begin
  FillCallBack := Func;
  FBackend.Fill(FillGetColor);
end;

procedure TFPixmap.PaintToCanvas(Canvas: TCanvas);
begin
  FBackend.PaintToCanvas(Canvas);
end;

function TFPixmap.GetDataSize: Integer;
begin
  Result := FBackend.GetDataSize;
end;

constructor TFPixmap.Create(AOwner: TComponent);
begin
  inherited;
  FBackend := TBImage.Create;
  FCanvas := TFCanvas.Create;
  FCanvas.Pixmap := Self;
  ColorFormat := ColorFormatManager.GetFormat(0);
end;

destructor TFPixmap.Destroy;
begin
  FreeAndNil(FCanvas);
  FreeAndNil(FBackend);
  inherited Destroy;
end;


initialization

ColorFormatManager := TColorFormatManager.Create;
with ColorFormatManager do begin
  RegisterFormat(TColorFormat);
  RegisterFormat(TColorFormatGray1);
  RegisterFormat(TColorFormatGray2);
  RegisterFormat(TColorFormatGray4);
  RegisterFormat(TColorFormatGray8);
  RegisterFormat(TColorFormatRGB8);
  RegisterFormat(TColorFormatRGBA8);
  RegisterFormat(TColorFormatRGB565);
end;


finalization

FreeAndNil(ColorFormatManager);


end.