How to render a chessboard grid on a Bitmap? - delphi

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

procedure RenderGrid(Source: TBitmap; Height, Width: Integer;
Size: Integer; Color1, Color2: TColor);
var
y: Integer;
x: Integer;
begin
Source.SetSize(Width, Height);
for y := 0 to Height div Size do
for x := 0 to Width div Size do
begin
if Odd(x) xor Odd(y) then
Source.Canvas.Brush.Color := Color1
else
Source.Canvas.Brush.Color := Color2;
Source.Canvas.FillRect(Rect(x*Size, y*Size, (x+1)*Size, (y+1)*Size));
end;
end;

Answer 2

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 3

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 4

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;