user8614758
user8614758

Reputation:

on Firemonkey, how to draw masked bitmap on canvas?

I have a bitmap and a mask (a bitmap also). I would like to draw the bitmap on the mask (like on the picture below)

drawing bitmap on a mask

How to do this on Delphi with Firemonkey ?

Upvotes: 5

Views: 2198

Answers (2)

Tom Brunberg
Tom Brunberg

Reputation: 21033

Use TBitmap.CreateFromBitmapAndMask()

constructor CreateFromBitmapAndMask(const Bitmap, Mask: TBitmap);

The documentation says:

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.

And further:

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.

In a simple test like:

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;

the result looks like this:

enter image description here

Edit

In order for the result of CreateFromBitmapAndMask(bmp, msk); to be drawn transparently on the form, it must be premultiplied before assigned to Image3. We need the following procedure,

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;

and another temporary bitmap res for the purpose. The test code looks now as follows:

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;

And the image (with a modified bg color for better demonstration):

enter image description here

Upvotes: 7

alitrun
alitrun

Reputation: 1217

enter image description here

Result image - star with transparent background. Use white color in your mask to show the visible part of image.
Checked in Delphi Berlin and 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

Upvotes: 2

Related Questions