如何确定PaintBox的TCanvas中实际绘图区域的范围？

我完全懂你这个痛点——用PaintBox画完图直接存整个画布的话，那些大片空白会让ListBox里的图标缩得特别小，只截取实际有内容的区域才是正确的做法。下面给你两种实用的解决方案，还有代码示例：

方法1：实时跟踪绘制边界（推荐） #

这种方法效率更高，核心是在你调用Rect、Polygon等绘图方法时，同步记录所有图形的边界范围，最后合并出整体的有效区域。

具体步骤： #

• 先初始化一个边界矩形，比如设为Rect(MaxInt, MaxInt, 0, 0)，表示初始没有任何绘图内容。
• 每次绘制图形前，计算当前图形的边界矩形，然后用UnionRect函数把它和已有的边界矩形合并（取并集）。
• 绘图完成后，这个最终的矩形就是你的有效绘图区域。

代码示例： #

var
  DrawingBounds: TRect;
begin
  // 初始化边界：初始状态下没有任何内容
  DrawingBounds := Rect(MaxInt, MaxInt, 0, 0);

  // 示例1：绘制一个矩形并更新边界
  Canvas.Rect(10, 10, 50, 50);
  UnionRect(DrawingBounds, DrawingBounds, Rect(10, 10, 50, 50));

  // 示例2：绘制一个多边形并更新边界
  var PolyPoints: array of TPoint = [(100, 20), (120, 60), (80, 60)];
  Canvas.Polygon(PolyPoints);
  
  // 先计算当前多边形的边界
  var PolyBounds: TRect := Rect(MaxInt, MaxInt, 0, 0);
  for var P in PolyPoints do
  begin
    if P.X < PolyBounds.Left then PolyBounds.Left := P.X;
    if P.Y < PolyBounds.Top then PolyBounds.Top := P.Y;
    if P.X > PolyBounds.Right then PolyBounds.Right := P.X;
    if P.Y > PolyBounds.Bottom then PolyBounds.Bottom := P.Y;
  end;
  // 合并到总边界
  UnionRect(DrawingBounds, DrawingBounds, PolyBounds);

  // 检查是否有有效绘图内容
  if (DrawingBounds.Left > DrawingBounds.Right) or (DrawingBounds.Top > DrawingBounds.Bottom) then
    Exit;

  // 截取有效区域生成位图，添加到ListBox
  var Bmp: TBitmap := TBitmap.Create;
  try
    Bmp.SetSize(DrawingBounds.Right - DrawingBounds.Left, DrawingBounds.Bottom - DrawingBounds.Top);
    Bmp.Canvas.CopyRect(Rect(0, 0, Bmp.Width, Bmp.Height), PaintBox1.Canvas, DrawingBounds);
    
    // 注意：ListBox的Style要设为lbOwnerDrawFixed/lbOwnerDrawVariable才能显示位图
    ListBox1.Items.AddObject('', Bmp);
    Bmp := nil; // 避免后续被Free释放
  finally
    Bmp.Free;
  end;
end;

方法2：事后扫描Canvas像素（适合无法跟踪绘制过程的场景） #

如果你的绘图逻辑太复杂，没法实时跟踪边界，可以扫描整个PaintBox的像素，找出所有非背景色区域的最小边界。

具体步骤： #

• 遍历Canvas的每一个像素，记录第一个和最后一个出现非背景色的X、Y坐标。
• 这些坐标组成的矩形就是有效区域。

代码示例： #

// 获取Canvas的有效绘图边界
function GetCanvasEffectiveBounds(ACanvas: TCanvas; const BackgroundColor: TColor): TRect;
var
  X, Y: Integer;
  PixelColor: TColor;
begin
  Result := Rect(MaxInt, MaxInt, 0, 0);
  if not Assigned(ACanvas) or (ACanvas.Width = 0) or (ACanvas.Height = 0) then
    Exit;

  for Y := 0 to ACanvas.Height - 1 do
  begin
    for X := 0 to ACanvas.Width - 1 do
    begin
      PixelColor := ACanvas.Pixels[X, Y];
      if PixelColor <> BackgroundColor then
      begin
        // 更新边界范围
        if X < Result.Left then Result.Left := X;
        if Y < Result.Top then Result.Top := Y;
        if X > Result.Right then Result.Right := X;
        if Y > Result.Bottom then Result.Bottom := Y;
      end;
    end;
  end;

  // 调整边界（TRect是左闭右开结构，所以Right和Bottom要+1）
  Inc(Result.Right);
  Inc(Result.Bottom);

  // 检查是否有有效区域
  if (Result.Left >= Result.Right) or (Result.Top >= Result.Bottom) then
    Result := Rect(0, 0, 0, 0);
end;

// 使用示例
var
  EffectiveBounds: TRect;
  Bmp: TBitmap;
begin
  // 假设PaintBox的背景色是白色，根据实际情况修改
  EffectiveBounds := GetCanvasEffectiveBounds(PaintBox1.Canvas, clWhite);
  if (EffectiveBounds.Width <= 0) or (EffectiveBounds.Height <= 0) then
    Exit;

  Bmp := TBitmap.Create;
  try
    Bmp.SetSize(EffectiveBounds.Width, EffectiveBounds.Height);
    Bmp.Canvas.CopyRect(Rect(0, 0, Bmp.Width, Bmp.Height), PaintBox1.Canvas, EffectiveBounds);
    ListBox1.Items.AddObject('', Bmp);
    Bmp := nil;
  finally
    Bmp.Free;
  end;
end;

额外注意事项 #

• 优先用方法1，因为像素扫描（方法2）的效率较低，尤其是大尺寸Canvas时。
• 如果使用方法2，要确保背景色的准确性——如果背景不是纯色或有半透明像素，需要调整像素判断逻辑（比如检查Alpha通道）。
• ListBox必须设置为自绘模式（Style设为lbOwnerDrawFixed或lbOwnerDrawVariable），并在OnDrawItem事件中手动绘制位图，否则只会显示空条目。

内容的提问来源于stack exchange，提问作者Ashlar