Show a basic storage type to handle a simple RGB raster graphics image,
and some primitive associated functions.

If possible provide a function to allocate an uninitialised image,
given its width and height, and provide 3 additional functions:

   one to fill an image with a plain RGB color,
   one to set a given pixel with a color,
   one to get the color of a pixel.


(If there are specificities about the storage or the allocation, explain those.)

These functions are used as a base for the articles in the category raster graphics operations, 
and a basic output function to check the results
is available in the article write ppm file.




 
program BitmapTest;
 
{$APPTYPE CONSOLE}
 
type
  TColor = record
  private
    function GetColor: Cardinal;
    procedure SetColor(const Value: Cardinal);
  public
    Red, Green, Blue, Alpha: Byte;
    property Color: Cardinal read GetColor write SetColor;
  end;
 
  TBitmap = class
  private
    FPixels: array of array of TColor;
    FHeight: Integer;
    FWidth: Integer;
    function GetPixel(X, Y: integer): TColor;
  public
    procedure Fill(aColor: TColor); overload;
    procedure Fill(aColor: Cardinal); overload;
    procedure SetSize(w, h: Integer);
    constructor Create(); overload;
    constructor Create(w, h: Integer); overload;
    property Height: Integer read FHeight;
    property Width: Integer read FWidth;
    property Pixel[X, Y: integer]: TColor read GetPixel;
  end;
 
{ TColor }
 
function TColor.GetColor: Cardinal;
begin
  Result := (alpha shl 24) + (red shl 16) + (green shl 8) + blue;
end;
 
procedure TColor.SetColor(const Value: Cardinal);
begin
  blue := (Value and $FF);
  green := ((Value shr 8) and $FF);
  red := ((Value shr 16) and $FF);
  alpha := ((Value shr 24) and $FF);
end;
 
{ TBitmap }
 
constructor TBitmap.Create;
begin
  inherited;
  FHeight := 0;
  FWidth := 0;
end;
 
constructor TBitmap.Create(w, h: Integer);
begin
  Create;
  SetSize(w, h);
end;
 
procedure TBitmap.Fill(aColor: Cardinal);
var
  x, y: Integer;
begin
  if (Width > 0) and (Height > 0) then
    for x := 0 to width - 1 do
      for y := 0 to height - 1 do
        FPixels[x, y].Color := aColor;
end;
 
procedure TBitmap.Fill(aColor: TColor);
begin
  Fill(aColor.Color);
end;
 
function TBitmap.GetPixel(X, Y: integer): TColor;
begin
  Result := FPixels[X, Y];
end;
 
procedure TBitmap.SetSize(w, h: Integer);
var
  i: Integer;
begin
  if (h = 0) or (w = 0) then
  begin
    h := 0;
    w := 0;
  end;
 
  FHeight := h;
  FWidth := w;
  SetLength(FPixels, w);
  if w > 0 then
    for i := 0 to w - 1 do
      SetLength(FPixels[i], h);
end;
 
var
  bmp: TBitmap;
  x, y: Integer;
 
begin
  bmp := TBitmap.Create(200, 200);
  bmp.Fill($00FF0000);
  for y := 0 to bmp.Height - 1 do
    for x := 0 to bmp.Width - 1 do
    begin
      if x mod 2 = 1 then
        bmp.Pixel[x, y].Color := $0000FF;
    end;
  bmp.Free;
end.