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

Question

问题定义

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

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答案似乎表明它是可能的:

如何使用透明背景(GDI)绘制patternBrush？

我试过了什么

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通道正在工作,因为如果我传入alpha值为255,那么它Canvas.Draw也会显示为黑色.

  SetAlphaBitmap(Result, clBlack, 255);

3)我尝试通过创建模式画笔并分配而不是位图来进行测试.这产生了完全相同的结果.HBrush是一个HBRUSH.

  FBrush := CreatePatternBrush(FBitmap.Handle);

并像这样设置画笔:

  Canvas.Brush.Handle := FBrush; 

4)我尝试SetBkMode按照上面的答案中的说明进行呼叫.这没有任何区别.

  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);

在paint中我们设置句柄而不是位图属性.

Canvas.Brush.Handle := FBrush; 

Answer 1

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

Canvas.Clear(TAlphaColorRec.Null);

问候。保罗。