创建透明的自定义位图画笔

Posted 2023-02-16

【中文标题】创建透明的自定义位图画笔

【英文标题】：Creating a transparent custom bitmap brush

【发布时间】：2015-07-17 01:20:00

【问题描述】：

问题定义

我正在尝试创建一个具有透明度的自定义位图画笔，但它似乎没有按预期工作。如果你看这个例子。添加代码并连接绘画、创建和销毁事件。

type
  TForm3 = class(TForm)
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    FBitmap: TBitmap;
  end;

// Implementation

function CreateBlockBitmap(const APenColor: TColor): TBitmap;
begin
  Result := TBitmap.Create;
  Result.Transparent := True; 
  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.Brush.Style := bsClear;
  Result.PixelFormat := pf32bit;
  Result.SetSize(20, 20);
  Result.Canvas.Brush.Color := APenColor;
  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0,0,10,10));
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  FBitmap := CreateBlockBitmap(clRed);
end;

procedure TForm3.FormPaint(Sender: TObject);
var
  colNum: Integer;
  rowNum: Integer;
begin
  // Paint the rectangle using the brush
  Canvas.Pen.Color := clGreen;
  Canvas.Brush.Bitmap := FBitmap; // This is using bitmap
  Canvas.Rectangle(50, 50, 250, 250);
  // Draw the block using Canvas.Draw
  for rowNum := 0 to 9 do
    for colNum := 0 to 9 do
      Canvas.Draw(350 + rowNum * 20, 50 + colNum * 20, FBitmap);
end;

此代码生成两个着色块。左侧是使用位图画笔绘制的，右侧是使用多个 Canvas.Draw 调用绘制的。

我需要将画笔涂成透明度，类似于使用阴影画笔时会发生的情况。这个 SO 答案似乎表明它是可能的：

How can I draw a patternBrush with transparent backround (GDI)?

我尝试过的

1) 我尝试使用纯色背景色而不是使用bsClear。这只会使背景变白。

  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.Brush.Style := bsSolid;

如果我使用clFuchsia，那么颜色是紫红色。我还尝试绘制背景clFuchsia，然后将TransparentColor 设置为clFuchsia。 Canvas.Draw 选项使用透明度进行绘制，而画笔则没有。

2) 我尝试直接使用以下代码设置 alpha 通道：

procedure SetAlphaBitmap(const Dest: TBitmap;Color : TColor;Alpha:Byte);
type
  TRGB32 = record
    B, G, R, A: byte;
  end;
  PRGBArray32 = ^TRGBArray32;
  TRGBArray32 = array[0..0] of TRGB32;
var
  x, y:    integer;
  Line, Delta: integer;
  ColorRGB : TColor;
begin
  if Dest.PixelFormat<>pf32bit then  exit;

  ColorRGB := ColorToRGB(Color);
  Line  := integer(Dest.ScanLine[0]);
  Delta := integer(Dest.ScanLine[1]) - Line;
  for y := 0 to Dest.Height - 1 do
  begin
    for x := 0 to Dest.Width - 1 do
      if TColor(RGB(PRGBArray32(Line)[x].R, PRGBArray32(Line)[x].G, PRGBArray32(Line)[x].B)) = ColorRGB then
        PRGBArray32(Line)[x].A := Alpha;
    Inc(Line, Delta);
  end;
end;

然后在使用背景颜色绘制矩形后立即调用此例程。

  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0,0,10,10));
  SetAlphaBitmap(Result, clBlack, 0); // Set the alpha channel
end;

我知道 Alpha 通道正在工作，因为如果我传入 255 的 Alpha 值，那么它在 Canvas.Draw 中也会显示为黑色。

  SetAlphaBitmap(Result, clBlack, 255);

3) 我尝试通过创建图案画笔并指定它而不是位图来进行测试。这会产生完全相同的结果。 FBrush 是一个 HBRUSH。

  FBrush := CreatePatternBrush(FBitmap.Handle);

然后像这样设置画笔：

  Canvas.Brush.Handle := FBrush; 

4) 我尝试调用SetBkMode，如上面的 SO 答案所示。这根本没有区别。

  Canvas.Pen.Color := clGreen;
  Canvas.Brush.Bitmap := FBitmap; 
  SetBkMode(Canvas.Handle, TRANSPARENT); // This doesn't make a difference
  Canvas.Rectangle(50, 50, 250, 250);

编辑

5) 我刚刚用单色位图进行了测试，它也有同样的问题。图像的画笔为白色背景和黑色前景，Canvas.Draw 为透明。

function CreateMonochromeBitmap: TBitmap;
begin
  Result := TBitmap.Create;
  Result.Transparent := True;
  Result.Canvas.Brush.Color := clWhite;
  Result.Canvas.Brush.Style := bsSolid;
  Result.PixelFormat := pf1bit;
  Result.SetSize(20, 20);
  Result.Canvas.Brush.Color := clBlack;
  Result.Canvas.Brush.Style := bsSolid;
  Result.Canvas.FillRect(Rect(0,0,10,10));
end;

在构造函数中：

FBitmap := CreateMonochromeBitmap;
FBrush := CreatePatternBrush(FBitmap.Handle);

在绘画中我们设置句柄而不是位图属性。

Canvas.Brush.Handle := FBrush; 

【问题讨论】：

您想要达到的最终效果是什么？你能举个例子吗？您是否尝试过使用特定颜色绘制自己的背景，然后将TBitmap.TransparentColor 设置为该颜色，而不是依赖bsClear 绘制黑色背景？ clFuschia 通常用于此目的。

MCVE 可以帮助任何想帮助你的人

@DavidHeffernan MCVE 添加。

@RemyLebeau 我试过了。不幸的是，这只适用于Canvas.Draw，不适用于画笔。我已更新问题以反映这一点。

【参考方案1】：

尝试在你的绘图循环之前清除画布这个空颜色。

Canvas.Clear(TAlphaColorRec.Null);

您好。 保罗。

【讨论】：

Canvas.Clear 方法仅在 firemonkey 中可用，在 VCL 中不可用。

【参考方案2】：

在填充矩形之前，您需要为透明区域使用白色和SetROP2，如下所示：

Canvas.Brush.Bitmap := FBitmap; // This is using bitmap
SetROP2(Canvas.Handle, R2_MASKPEN); 
Canvas.Rectangle(50, 50, 250, 250);

别忘了恢复之前的 ROP 模式。

祝你好运！

【讨论】：

那不是透明，那是混合。在Paint 方法的最开始添加Canvas.Brush.Color:=clGreen; Canvas.Rectangle(0, 0, 200, 200);，你就会明白我的意思了。

我会说以防万一。如果它是透明的，绿色部分的框仍然是红色的。但是它们是黑色的，这是光栅操作的结果。

让我提醒您，最初的任务是使用位图画笔填充矩形，以使某些区域保持透明，即未填充。混合假设将画笔颜色与基础颜色混合。在我的情况下，没有混合发生，一切都按照主题启动器的要求进行。画笔位图的所有颜色在填充后保持不变，除了白色。

顺便说一下，当你设置画笔颜色时，它会取消画笔位图；）

嘿！如果我的尝试成功，我会发布答案。 :-)

【参考方案3】：

解决了！这是我的解决方案：

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  public
    FBitmap: TBitmap;
  end;

//Implementation

function CreateBlockBitmap: TBitmap;
begin
  Result := TBitmap.Create;
  Result.PixelFormat := pf1bit;  //!! 1-bit
  Result.Width := 20;
  Result.Height := 20;
  Result.Canvas.Brush.Color := clBlack;
  Result.Canvas.FillRect(Rect(0, 0, 10, 10));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FBitmap := CreateBlockBitmap;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FBitmap.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
const
  PatternColor = clRed;   //brush color to be used
var
  R: TRect;
begin
  //filling the background with different colors for test 
  Canvas.Brush.Color := clGreen;
  Canvas.FillRect(Rect(0,0,100,600));
  Canvas.Brush.Color := clAqua;
  Canvas.FillRect(Rect(100,0,200,600));
  Canvas.Brush.Color := clYellow;
  Canvas.FillRect(Rect(200,0,300,600));
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Rect(300,0,400,600));

  //draw the rectangle
  R := Rect(50, 50, 500, 500);
  Canvas.Brush.Color := PatternColor;
  BitBlt(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom, Canvas.Handle, 0, 0, PATINVERT);
  Canvas.Brush.Bitmap := FBitmap;
  SetROP2(Canvas.Handle, R2_MASKPEN);

  Canvas.Rectangle(R);  //draw any figure here

  Canvas.Brush.Color := PatternColor;
  SetROP2(Canvas.Handle, R2_COPYPEN);
  BitBlt(Canvas.Handle, R.Left, R.Top, R.Right, R.Bottom, Canvas.Handle, 0, 0, PATINVERT);
end;

【讨论】：

我今天会尝试看看这个。