如何在位图上渲染棋盘格？

Question

我在另一个“下方”图像的顶部显示透明图像。

在这种情况下，底部（实心）图像是棋盘格，顶部图像是狮子（透明）：

=

原因是为了更好地显示透明区域，因为通常您看不到哪些区域是透明的。

问题是，位图的尺寸可以是任意大小，因此网格也需要与位图的大小相同。

如果您愿意，一种肮脏的方法是创建一个更大版本的上述棋盘网格，大小为 2000x2000，然后根据您正在使用的位图的大小，您可以调整网格画布的大小以匹配.这并不理想，因为这意味着将大型棋盘格位图与您的应用程序一起存储，然后意味着调整它的大小，这可能无法根据纵横比等给出正确的结果。

我认为正确的方法是以编程方式渲染棋盘网格，例如：

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

end;

这将允许自定义具有不同大小和颜色的网格，而不必担心存储大型棋盘网格位图和调整大小的开销。

但是我不确定如何将网格绘制到位图上？我的一个想法是你需要循环遍历位图的每一行并以这种方式着色？我不确定。

这涉及我不擅长的数学和计算。如果您能告诉我在位图上渲染网格的最有效方法，我将不胜感激。

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

曾几何时，我profiled this specific need。考虑到您的RenderGrid 签名，很可能Bitmap 参数的图像将在绘制位图后绘制。然后在Color1 中绘制整个位图，并且只为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;

---

更新

但是由于您是在谈论 大 位图，所以下面显示的例程甚至还要快 20%。它创建了一个只有 4 个方格的小位图，比如一个 2 x 2 的棋盘，并让目标的画笔属性自动将其展开。 ^*)

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;

为了进一步优化：缓存这个小位图 (Tmp)，并在其大小未更改时重新使用它。

^*) 另见：How to color a bitmap without calling FillRect()?。

Answer 3

Firemonkey 使用此功能

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

您将通过这种方法获得更好的性能。只是不要传递 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;