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

unit UColorGray1;

{$mode delphi}

interface

uses
  Classes, SysUtils, Graphics, UFGraphics, UGGraphics;

type
  { TColorFormatGray1 }

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

  TColorGray1 = Byte;

  { TPixmapGray1 }

  TPixmapGray1 = class(TGPixmapBit<TColorGray1>)
    function Gray1ToColor(Value: TColorGray1): TColor;
    function ColorToGray1(Value: TColor): TColorGray1;
  end;

  { TBColorGray1 }

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

  { TBPixmapGray1 }

  TBPixmapGray1 = class(TBPixmap)
  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 Mirror; override;
    procedure Flip; 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

{ TColorFormatGray1 }

constructor TColorFormatGray1.Create;
begin
  inherited;
  Name := 'Gray 1-bit';
  BitDepth := 1;
  BackendColorClass := TBColorGray1;
  BackendPixmapClass := TBPixmapGray1;
  AddChannel('Gray', 0, 1);
end;

{ TPixmapGray1 }

function TPixmapGray1.Gray1ToColor(Value: TColorGray1): TColor;
begin
  Value := (Value and $1) * $ff;
  Result := (Value shl 16) or (Value shl 8) or (Value shl 0);
end;

function TPixmapGray1.ColorToGray1(Value: TColor): TColorGray1;
begin
  Result := Trunc((((Value shr 16) and $ff) + ((Value shr 8) and $ff) + ((Value shr 0) and $ff)) / $300 * 2);
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.SetColor(Color: TColor);
begin
  Value := Trunc((((Color shr 16) and $ff) + ((Color shr 8) and $ff) + ((Color shr 0) and $ff)) / $300 * 2)
end;

procedure TBColorGray1.SetRandom;
begin
  Value := Random(2);
end;

{ TBPixmapGray1 }

function TBPixmapGray1.FillGetColor(Position: TPoint): TColorGray1;
begin
  Result := (FillCallBack(Position) as TBColorGray1).Value;
end;

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

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

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

procedure TBPixmapGray1.Mirror;
begin
  Pixmap.Mirror;
end;

procedure TBPixmapGray1.Flip;
begin
  Pixmap.Flip;
end;

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

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

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

procedure TBPixmapGray1.PaintToCanvas(Canvas: TCanvas);
begin
  Pixmap.PaintToCanvas(Canvas, Pixmap.Gray1ToColor);
end;

procedure TBPixmapGray1.PaintToCanvas(Canvas: TCanvas; Rect: TRect);
begin
  Pixmap.PaintToCanvas(Canvas, Rect, Pixmap.Gray1ToColor);
end;

procedure TBPixmapGray1.PaintToBitmap(Bitmap: TBitmap; Rect: TRect);
begin
  Pixmap.PaintToBitmap(Bitmap, Rect, Pixmap.Gray1ToColor);
end;

procedure TBPixmapGray1.LoadFromCanvas(Canvas: TCanvas);
begin
  Pixmap.LoadFromCanvas(Canvas, Pixmap.ColorToGray1);
end;

procedure TBPixmapGray1.LoadFromBitmap(Bitmap: TBitmap);
begin
  Pixmap.LoadFromBitmap(Bitmap, Pixmap.ColorToGray1);
end;

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

constructor TBPixmapGray1.Create;
begin
  Pixmap := TPixmapGray1.Create;
  Pixmap.BitsPerPixel := 1;
end;

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


end.