在Firemonkey上,如何在画布上绘制蒙版位图?

时间:2017-09-15 14:25:33

标签: delphi firemonkey

我有一个位图和一个掩码(也是一个位图)。我想在掩码上绘制位图(如下图所示)

drawing bitmap on a mask

如何使用 Firemonkey 在Delphi上执行此操作?

2 个答案:

答案 0 :(得分:4)

使用TBitmap.CreateFromBitmapAndMask()

constructor CreateFromBitmapAndMask(const Bitmap, Mask: TBitmap);

文档说:

  

创建的TBitmap具有每种颜色的Alpha通道的值   像素等于Mask中红色通道的值。

进一步说:

  

提示:为获得更好的效果,请使用蒙版的灰度图像。它有一个   等量的绿色,红色和蓝色。

     

提示:蒙版和基本位图必须具有相同的尺寸。   否则,新的TBitmap将具有等于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\4.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;

结果如下:

enter image description here

修改

为了在表单上透明地绘制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\4.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;

图像(带有修改的bg颜色以便更好地演示):

enter image description here

答案 1 :(得分:0)

enter image description here

结果图片-带有透明背景的星标。在蒙版中使用白色以显示图像的可见部分。
已在Delphi Berlin和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;

Sample project