Search code examples
delphifiremonkey

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 ?


Solution

  • 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