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

unit UColorGray4;

{$mode delphi}

interface

uses
  Classes, SysUtils, UGGraphics, UFGraphics, Graphics;

type
  { TColorFormatGray4 }

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

  TColorGray4 = Byte;

  { TPixmapGray4 }

  TPixmapGray4 = class(TGPixmapBit<TColorGray4>)
    function Gray4ToColor(Value: TColorGray4): TColor;
    function ColorToGray4(Value: TColor): TColorGray4;
  end;

  { TBColorGray4 }

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

  { TBPixmapGray4 }

  TBPixmapGray4 = class(TBPixmap)
  private
    FillCallBack: TGetColorPos;
    function FillGetColor(Position: TPoint): TColorGray4;
    function NegativeFunc(Position: TPoint): TColorGray4;
  protected
    procedure SetSize(AValue: TPoint); override;
    function GetPixel(X, Y: Integer): IBColor;  override;
    procedure SetPixel(X, Y: Integer; AValue: IBColor); override;
  public
    Pixmap: TPixmapGray4;
    procedure Flip; override;
    procedure Mirror; 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

{ TColorFormatGray4 }

constructor TColorFormatGray4.Create;
begin
  inherited;
  Name := 'Gray 4-bit';
  BitDepth := 4;
  BackendColorClass := TBColorGray4;
  BackendPixmapClass := TBPixmapGray4;
  AddChannel('Gray', 0, 4);
end;

{ TPixmapGray4 }

function TPixmapGray4.Gray4ToColor(Value: TColorGray4): TColor;
begin
  Value := (Value and $f) * (255 div (16 - 1));
  Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
end;

function TPixmapGray4.ColorToGray4(Value: TColor): TColorGray4;
begin
  Result := Trunc((((Value shr 16) and $ff) + ((Value shr 8) and $ff) + ((Value shr 0) and $ff)) / $300 * 16);
end;

{ TBColorGray2 }

constructor TBColorGray4.Create(Color: TColorGray4);
begin
  Value := Color;
end;

procedure TBColorGray4.SetColorName(ColorName: TColorName);
begin
  case ColorName of
    cnBlack: Value := 0;
    cnGray: Value := 6;
    cnSilver: Value := 10;
    cnWhite: Value := 15;
    else Value := 0;
  end;
end;

procedure TBColorGray4.SetRandom;
begin
  Value := Random(16);
end;

procedure TBColorGray4.SetColor(Color: TColor);
begin
  Value := ((Color shr 0) and $ff + (Color shr 8) and $ff + (Color shr 16) and $ff) div (3 * 16);
end;

{ TBPixmapGray2 }

function TBPixmapGray4.FillGetColor(Position: TPoint): TColorGray4;
begin
  Result := (FillCallBack(Position) as TBColorGray4).Value;
end;

function TBPixmapGray4.NegativeFunc(Position: TPoint): TColorGray4;
var
  C: TColorGray4;
begin
  C := Pixmap.Pixels[Position.X, Position.Y];
  Result := 16 - (C and $f);
end;

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

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

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

procedure TBPixmapGray4.Flip;
begin
  Pixmap.Flip;
end;

procedure TBPixmapGray4.Mirror;
begin
  Pixmap.Mirror;
end;

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

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

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

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

procedure TBPixmapGray4.PaintToCanvas(Canvas: TCanvas);
begin
  Pixmap.PaintToCanvas(Canvas, Pixmap.Gray4ToColor);
end;

procedure TBPixmapGray4.PaintToCanvas(Canvas: TCanvas; Rect: TRect);
begin
  Pixmap.PaintToCanvas(Canvas, Rect, Pixmap.Gray4ToColor);
end;

procedure TBPixmapGray4.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
begin
  Pixmap.PaintToBitmap(Bitmap, Rect, Pixmap.Gray4ToColor);
end;

procedure TBPixmapGray4.LoadFromCanvas(Canvas: TCanvas);
begin
  Pixmap.LoadFromCanvas(Canvas, Pixmap.ColorToGray4);
end;

procedure TBPixmapGray4.LoadFromBitmap(Bitmap: TBitmap);
begin
  Pixmap.LoadFromBitmap(Bitmap, Pixmap.ColorToGray4);
end;

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

constructor TBPixmapGray4.Create;
begin
  Pixmap := TPixmapGray4.Create;
  Pixmap.BitsPerPixel := 4;
end;

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


end.