在 Firemonkey 上,如何在 canvas 上绘制蒙版位图?
on Firemonkey, how to draw masked bitmap on canvas?
我有位图和遮罩(也是位图)。我想在遮罩上绘制位图(如下图所示)
如何在 Delphi 上使用 Firemonkey 执行此操作?
使用TBitmap.CreateFromBitmapAndMask()
constructor CreateFromBitmapAndMask(const Bitmap, Mask: TBitmap);
文档说:
The created TBitmap has the value of the Alpha channel of each color
pixel equal with the value of the Red channel in the Mask.
还有:
Tip: For a better result, use a grayscale image for Mask. It has an
equal amount of green, red, and blue.
Tip: The mask and the base bitmap must have the same dimensions.
Otherwise the new TBitmap will have the dimensions equal to 0.
在像这样的简单测试中:
procedure TForm19.Button1Click(Sender: TObject);
var
bmp, msk: TBitmap;
begin
bmp := nil;
msk := nil;
try
bmp := TBitmap.Create;
msk := TBitmap.Create;
bmp.LoadFromFile('C:\tmp\Imgs.bmp');
msk.LoadFromFile('C:\tmp\Imgs\TestImage04.bmp');
Image1.Bitmap := bmp;
Image2.Bitmap := msk;
Image3.Bitmap.CreateFromBitmapAndMask(bmp, msk);
finally
bmp.Free;
msk.Free;
end;
end;
结果如下所示:
编辑
为了CreateFromBitmapAndMask(bmp, msk);
的结果在窗体上透明绘制,必须先premultiplied
赋值给Image3
。我们需要以下程序,
procedure PremultiplyBitmapAlpha(bmp:TBitmap);
var
X, Y: Integer;
M: TBitmapData;
C: PAlphaColorRec;
begin
if bmp.Map(TMapAccess.ReadWrite, M) then
try
for Y := 0 to bmp.Height - 1 do
for X := 0 to bmp.Width - 1 do
begin
C := @PAlphaColorArray(M.Data)[Y * (M.Pitch div 4) + X];
C^.Color := PremultiplyAlpha(C^.Color);
end;
finally
bmp.Unmap(M);
end;
end;
和另一个临时位图 res
用于此目的。测试代码现在如下所示:
procedure TForm14.Button1Click(Sender: TObject);
var
bmp, msk, res: TBitmap;
begin
bmp := nil;
msk := nil;
res := nil;
try
bmp := TBitmap.Create;
msk := TBitmap.Create;
bmp.LoadFromFile('C:\tmp\Imgs.bmp');
msk.LoadFromFile('C:\tmp\Imgs\TestImage04.bmp');
Image1.Bitmap := bmp;
Image2.Bitmap := msk;
res := TBitmap.Create;
res.CreateFromBitmapAndMask(bmp, msk);
PremultiplyBitmapAlpha(res);
Image3.Bitmap := res;
finally
bmp.Free;
msk.Free;
res.Free;
end;
end;
和图像(为了更好地展示而修改了背景颜色):
结果图片 - 星号 透明 背景。在蒙版中使用白色来显示图像的可见部分。
入住 Delphi 柏林和 Windows。
procedure TForm1.Button1Click(Sender: TObject);
var
ImageRes: TResourceStream;
Result: TBitmap;
tmpMS : TMemoryStream;
begin
ImageRes := TResourceStream.Create(HInstance, 'IMAGE', RT_RCDATA);
try
Image1.Bitmap.CreateFromStream(ImageRes);
Image2.Bitmap.LoadFromFile('c:\temp\MaskedBitmap\Images\Mask.png');
Result := TBitmap.Create;
Result.CreateFromBitmapAndMask(Image1.Bitmap, Image2.Bitmap);
// applying alpha channel to Bitmap - workaround. If you can improve write here how
tmpMS := TMemoryStream.Create;
Result.SaveToStream(tmpMS);
Result.LoadFromStream(tmpMS);
tmpMS.Free;
Image3.Bitmap.Assign(Result);
finally
ImageRes.Free;
Result.Free;
end;
end;
我有位图和遮罩(也是位图)。我想在遮罩上绘制位图(如下图所示)
如何在 Delphi 上使用 Firemonkey 执行此操作?
使用TBitmap.CreateFromBitmapAndMask()
constructor CreateFromBitmapAndMask(const Bitmap, Mask: TBitmap);
文档说:
The created TBitmap has the value of the Alpha channel of each color pixel equal with the value of the Red channel in the Mask.
还有:
Tip: For a better result, use a grayscale image for Mask. It has an equal amount of green, red, and blue.
Tip: The mask and the base bitmap must have the same dimensions. Otherwise the new TBitmap will have the dimensions equal to 0.
在像这样的简单测试中:
procedure TForm19.Button1Click(Sender: TObject);
var
bmp, msk: TBitmap;
begin
bmp := nil;
msk := nil;
try
bmp := TBitmap.Create;
msk := TBitmap.Create;
bmp.LoadFromFile('C:\tmp\Imgs.bmp');
msk.LoadFromFile('C:\tmp\Imgs\TestImage04.bmp');
Image1.Bitmap := bmp;
Image2.Bitmap := msk;
Image3.Bitmap.CreateFromBitmapAndMask(bmp, msk);
finally
bmp.Free;
msk.Free;
end;
end;
结果如下所示:
编辑
为了CreateFromBitmapAndMask(bmp, msk);
的结果在窗体上透明绘制,必须先premultiplied
赋值给Image3
。我们需要以下程序,
procedure PremultiplyBitmapAlpha(bmp:TBitmap);
var
X, Y: Integer;
M: TBitmapData;
C: PAlphaColorRec;
begin
if bmp.Map(TMapAccess.ReadWrite, M) then
try
for Y := 0 to bmp.Height - 1 do
for X := 0 to bmp.Width - 1 do
begin
C := @PAlphaColorArray(M.Data)[Y * (M.Pitch div 4) + X];
C^.Color := PremultiplyAlpha(C^.Color);
end;
finally
bmp.Unmap(M);
end;
end;
和另一个临时位图 res
用于此目的。测试代码现在如下所示:
procedure TForm14.Button1Click(Sender: TObject);
var
bmp, msk, res: TBitmap;
begin
bmp := nil;
msk := nil;
res := nil;
try
bmp := TBitmap.Create;
msk := TBitmap.Create;
bmp.LoadFromFile('C:\tmp\Imgs.bmp');
msk.LoadFromFile('C:\tmp\Imgs\TestImage04.bmp');
Image1.Bitmap := bmp;
Image2.Bitmap := msk;
res := TBitmap.Create;
res.CreateFromBitmapAndMask(bmp, msk);
PremultiplyBitmapAlpha(res);
Image3.Bitmap := res;
finally
bmp.Free;
msk.Free;
res.Free;
end;
end;
和图像(为了更好地展示而修改了背景颜色):
结果图片 - 星号 透明 背景。在蒙版中使用白色来显示图像的可见部分。
入住 Delphi 柏林和 Windows。
procedure TForm1.Button1Click(Sender: TObject);
var
ImageRes: TResourceStream;
Result: TBitmap;
tmpMS : TMemoryStream;
begin
ImageRes := TResourceStream.Create(HInstance, 'IMAGE', RT_RCDATA);
try
Image1.Bitmap.CreateFromStream(ImageRes);
Image2.Bitmap.LoadFromFile('c:\temp\MaskedBitmap\Images\Mask.png');
Result := TBitmap.Create;
Result.CreateFromBitmapAndMask(Image1.Bitmap, Image2.Bitmap);
// applying alpha channel to Bitmap - workaround. If you can improve write here how
tmpMS := TMemoryStream.Create;
Result.SaveToStream(tmpMS);
Result.LoadFromStream(tmpMS);
tmpMS.Free;
Image3.Bitmap.Assign(Result);
finally
ImageRes.Free;
Result.Free;
end;
end;