source: trunk/Packages/FastGraphics/ColorFormats/UColorRGB8.pas

unit UColorRGB8;

{$mode delphi}

interface

uses
  Classes, SysUtils, UGGraphics, UFGraphics, Graphics;

type
  { TColorFormatRGB8 }

  TColorFormatRGB8 = class(TColorFormat)
    constructor Create; override;
  end;

  { TColorRGB8 }

  TColorRGB8 = record
    R: Byte;
    B: Byte;
    G: Byte;
    function Create(R, G, B: Byte): TColorRGB8;
  end;

  { TPixmapRGB8 }

  TPixmapRGB8 = class(TGPixmap<TColorRGB8>)
    function RGB8ToColor(Value: TColorRGB8): TColor;
    function ColorToRGB8(Value: TColor): TColorRGB8;
  end;

  { TBColorRGB8 }

  TBColorRGB8 = class(TBColor)
    Value: TColorRGB8;
    constructor Create(Color: TColorRGB8);
    procedure SetColorName(ColorName: TColorName); override;
    procedure SetColor(Color: TColor); override;
    procedure SetRandom; override;
  end;

  { TBPixmapRGB8 }

  TBPixmapRGB8 = class(TBPixmap)
  private
    FillCallBack: TGetColorPos;
    function FillGetColor(Position: TPoint): TColorRGB8;
    function NegativeFunc(Position: TPoint): TColorRGB8;
  protected
    function GetPixel(X, Y: Integer): IBColor;  override;
    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
    procedure SetSize(AValue: TPoint); override;
  public
    Pixmap: TPixmapRGB8;
    procedure Mirror; override;
    procedure Flip; override;
    procedure Negative; override;
    procedure Fill(Color: IBColor); override;
    procedure Fill(Func: TGetColorPos); override;
    procedure Line(P1, P2: TPoint; Color: IBColor); override;
    procedure PaintToCanvas(Canvas: TCanvas); override;
    procedure PaintToCanvas(Canvas: TCanvas; Rect: TRect); override;
    procedure PaintToBitmap(Bitmap: TBitmap; Rect: TRect); override;
    procedure LoadFromCanvas(Canvas: TCanvas); override;
    procedure LoadFromBitmap(Bitmap: TBitmap); override;
    function GetDataSize: Integer; override;
    constructor Create; override;
    destructor Destroy; override;
  end;



implementation

{ TColorFormatRGB8 }

constructor TColorFormatRGB8.Create;
begin
  inherited;
  BitDepth := 24;
  Name := 'RGB8';
  BackendPixmapClass := TBPixmapRGB8;
  BackendColorClass := TBColorRGB8;
  AddChannel('Red', 0, 8);
  AddChannel('Green', 8, 8);
  AddChannel('Blue', 16, 8);
end;

{ TColorRGB8 }

function TColorRGB8.Create(R, G, B: Byte): TColorRGB8;
begin
  Result.R := R;
  Result.G := G;
  Result.B := B;
end;

{ TPixmapRGB8 }

function TPixmapRGB8.RGB8ToColor(Value: TColorRGB8): TColor;
begin
  Result := (Value.R shl 16) or (Value.G shl 8) or (Value.B shl 0);
end;

function TPixmapRGB8.ColorToRGB8(Value: TColor): TColorRGB8;
begin
  Result.R := (Value shr 16) and $ff;
  Result.G := (Value shr 8) and $ff;
  Result.B := (Value shr 0) and $ff;
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.SetColor(Color: TColor);
begin
  Value := TColorRGB8.Create((Color shr 0) and $ff, (Color shr 8) and $ff, (Color shr 16) and $ff);
end;

procedure TBColorRGB8.SetRandom;
begin
  Value := TColorRGB8.Create(Random(256), Random(256), Random(256));
end;

{ TBPixmapRGB8 }

function TBPixmapRGB8.FillGetColor(Position: TPoint): TColorRGB8;
begin
  Result := (FillCallBack(Position) as TBColorRGB8).Value;
end;

function TBPixmapRGB8.NegativeFunc(Position: TPoint): TColorRGB8;
var
  C: TColorRGB8;
begin
  C := Pixmap.Pixels[Position.X, Position.Y];
  Result.R := 255 - C.R;
  Result.G := 255 - C.G;
  Result.B := 255 - C.B;
end;

function TBPixmapRGB8.GetPixel(X, Y: Integer): IBColor;
begin
  Result := TBColorRGB8.Create(Pixmap.Pixels[X, Y]);
end;

procedure TBPixmapRGB8.SetPixel(X, Y: Integer; AValue: IBColor);
begin
  Pixmap.Pixels[X, Y] := (AValue as TBColorRGB8).Value;
end;

procedure TBPixmapRGB8.SetSize(AValue: TPoint);
begin
  inherited;
  Pixmap.Size := AValue;
end;

procedure TBPixmapRGB8.Mirror;
begin
  Pixmap.Mirror;
end;

procedure TBPixmapRGB8.Flip;
begin
  Pixmap.Flip;
end;

procedure TBPixmapRGB8.Negative;
begin
  Pixmap.Fill(NegativeFunc);
end;

procedure TBPixmapRGB8.Fill(Color: IBColor);
begin
  if Color is TBColorRGB8 then
    Pixmap.Fill((Color as TBColorRGB8).Value);
end;

procedure TBPixmapRGB8.Fill(Func: TGetColorPos);
begin
  FillCallBack := Func;
  Pixmap.Fill(FillGetColor);
end;

procedure TBPixmapRGB8.Line(P1, P2: TPoint; Color: IBColor);
begin
  Pixmap.Canvas.Pen.Color := (Color as TBColorRGB8).Value;
  Pixmap.Canvas.Pen.MoveTo(P1);
  Pixmap.Canvas.Pen.LineTo(P2);
end;

procedure TBPixmapRGB8.PaintToCanvas(Canvas: TCanvas);
begin
  Pixmap.PaintToCanvas(Canvas, Pixmap.RGB8ToColor);
end;

procedure TBPixmapRGB8.PaintToCanvas(Canvas: TCanvas; Rect: TRect);
begin
  Pixmap.PaintToCanvas(Canvas, Rect, Pixmap.RGB8ToColor);
end;

procedure TBPixmapRGB8.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
begin
  Pixmap.PaintToBitmap(Bitmap, Rect, Pixmap.RGB8ToColor);
end;

procedure TBPixmapRGB8.LoadFromCanvas(Canvas: TCanvas);
begin
  Pixmap.LoadFromCanvas(Canvas, Pixmap.ColorToRGB8);
end;

procedure TBPixmapRGB8.LoadFromBitmap(Bitmap: TBitmap);
begin
  Pixmap.LoadFromBitmap(Bitmap, Pixmap.ColorToRGB8);
end;

function TBPixmapRGB8.GetDataSize: Integer;
begin
  Result := Pixmap.GetDataSize;
end;

constructor TBPixmapRGB8.Create;
begin
  Pixmap := TPixmapRGB8.Create;
end;

destructor TBPixmapRGB8.Destroy;
begin
  FreeAndNil(Pixmap);
  inherited Destroy;
end;


end.