How to render a chessboard grid on a Bitmap?

Question

I am displaying transparent images on top of another "underneath" image.

In this case the bottom (solid) image is a chessboard grid and the top image is a lion (transparent):

=

The reason is to show transparency areas much better as typically you would not see which areas are transparent.

The problem is, bitmaps can be any size in dimensions, so the grid would also need to be the same size as the bitmap.

A dirty approach if you like would be to create a larger version of the chessboard grid above to a size such as 2000x2000, then depending on the size of the bitmaps you are working with you could resize the canvas of the grid to match. This is not ideal because it means storing the large chessboard grid bitmap with your application, and then it means resizing it which may not give the correct results depending on aspect ratio etc.

The correct approach I feel would be to render the chessboard grid programmatically, something like:

procedure RenderGrid(Source: TBitmap; Height, Width: Integer;
  Size: Integer; Color1, Color2: TColor);
begin

end;

This would allow customising the grid with different sizes and colors, and not worry about the overhead of storing a large chessboard grid bitmap and having to resize it.

However I am not sure how you could draw the grid onto a bitmap? One thought I had was that you need to loop through each alternating row of the bitmap and color it that way? I am not sure.

This involves math and calculations which I am not good with. I would appreciate if you could enlighten me on the most effective way of rendering the grid on a bitmap.

Answer 1

Once upon a time, I profiled this specific need. Considering your RenderGrid signature, it is likely that the Bitmap parameter's image will be drawn after the bitmap is drawn. Then the best performance is got by painting the whole bitmap in Color1, and only paint the squares for Color2:

procedure RenderGrid(Target: TBitmap; Height, Width: Integer; Size: Integer;
  Color1, Color2: TColor);
var
  Col: Integer;
  Row: Integer;
begin
  Target.SetSize(Width, Height)
  Target.Canvas.Brush.Color := Color1;
  Target.Canvas.FillRect(Rect(0, 0, Width, Height));
  Target.Canvas.Brush.Color := Color2;
  for Col := 0 to Width div Size do
    for Row := 0 to Height div Size do
      if Odd(Col + Row) then
        Target.Canvas.FillRect(Bounds(Col * Size, Row * Size, Size, Size));
end;

---

Update

But since you are speaking about large bitmaps, the routine shown below is even another 20% faster. It creates a small bitmap with only 4 squares, say a chessboard of 2 x 2, and lets the target's brush property spread it out automatically. ^*)

procedure RenderGrid(Target: TBitmap; Height, Width: Integer; Size: Integer;
  Color1, Color2: TColor);
var
  Tmp: TBitmap;
begin
  Tmp := TBitmap.Create;
  try
    Tmp.Canvas.Brush.Color := Color1;
    Tmp.Width := 2 * Size;
    Tmp.Height := 2 * Size;
    Tmp.Canvas.Brush.Color := Color2;
    Tmp.Canvas.FillRect(Rect(0, 0, Size, Size));
    Tmp.Canvas.FillRect(Bounds(Size, Size, Size, Size));
    Target.Canvas.Brush.Bitmap := Tmp;
    if Target.Width * Target.Height = 0 then
      Target.SetSize(Width, Height)
    else
    begin
      Target.SetSize(Width, Height)
      Target.Canvas.FillRect(Rect(0, 0, Width, Height));
    end;
  finally
    Tmp.Free;
  end;
end;

To optimize this even further: cache this small bitmap (Tmp), and reuse it when its size hasn't been changed.

^*) See also: How to color a bitmap without calling FillRect()?.

Answer 2

For Firemonkey use this function

procedure PaintChessBrush(const Canvas: TCanvas; const AColor: TAlphaColor; const ARect: TRectF; const AOpacity: Single; const AChessStep: Single = 10);

  procedure MakeChessBrush(ABrushBitmap: TBrushBitmap; const AChessStep: Single);
  var
    BitmapTmp: TBitmap;
  begin
       BitmapTmp := ABrushBitmap.Bitmap;
       with BitmapTmp do
       begin
            SetSize(Trunc(2 * AChessStep), Trunc(2 * AChessStep));
            Clear(TAlphaColorRec.White);
            ClearRect(RectF(0, 0, AChessStep, AChessStep), TAlphaColorRec.Lightgray);
            ClearRect(RectF(AChessStep, AChessStep, 2 * AChessStep, 2 * AChessStep), TAlphaColorRec.Lightgray);
       end;

       ABrushBitmap.WrapMode := TWrapMode.Tile;
  end;

var
  State: TCanvasSaveState;
begin
     State := Canvas.SaveState;
     try
          MakeChessBrush(Canvas.Fill.Bitmap, AChessStep);
          Canvas.Fill.Kind := TBrushKind.Bitmap;
          Canvas.FillRect(ARect, 0, 0, AllCorners, AOpacity);

          Canvas.Fill.Kind := TBrushKind.Solid;
          Canvas.Fill.Color := AColor;
          Canvas.FillRect(ARect, 0, 0, AllCorners, AOpacity);
     finally
        Canvas.RestoreState(State);
     end;
end;

Answer 3

You'll get better performance with this approach. Just don't pass CellSize = 0.

// Color1, Color2 in RRGGBB format (i.e. Red = $00FF0000)
procedure RenderGrid(Source: TBitmap; CellSize: Integer; Color1, Color2: TColorRef);
var
  I, J: Integer;
  Pixel: ^TColorRef;
  UseColor1: Boolean;
begin
  Source.PixelFormat := pf32bit;
  Pixel := Source.ScanLine[Source.Height - 1];
  for I := 0 to Source.Height - 1 do
  begin
    UseColor1 := (I div CellSize) mod 2 = 0;
    for J := 0 to Source.Width - 1 do
    begin
      if J mod CellSize = 0 then UseColor1 := not UseColor1;

      if UseColor1 then
        Pixel^ := Color1
      else
        Pixel^ := Color2;
      Inc(Pixel);
    end;
  end;
end;