问题定义
我正在尝试创建一个具有透明度的自定义位图画笔,但它似乎没有按预期工作.如果你看一下这个例子.添加代码并连接绘制,创建和销毁事件.
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,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调用绘制.
我需要刷涂上透明度,类似于使用舱口刷时会发生的情况.这个答案似乎表明它是可能的:
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,10)); SetAlphaBitmap(Result,clBlack,0); // Set the alpha channel end;
我知道alpha通道正在工作,因为如果我传入alpha值为255,那么它也会在Canvas.Draw中以黑色显示.
SetAlphaBitmap(Result,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,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,10)); end;
在构造函数中:
FBitmap := CreateMonochromeBitmap; FBrush := CreatePatternBrush(FBitmap.Handle);
在paint中我们设置句柄而不是位图属性.
Canvas.Brush.Handle := FBrush;
解决方法
尝试在绘制循环之前清除画布此null颜色.
Canvas.Clear(TAlphaColorRec.Null);
问候.保罗.