Blending semi-transparent bitmaps containing text with Graphics32

Question

I'm trying to implement a layered painting system inside one of our internal components and I have problems blending bitmaps containing text.

Following code fragment shows the problem:

uses
  GR32;

procedure DrawBitmaps;
var
  bmp1: TBitmap32;
  bmp2: TBitmap32;
begin
  bmp1 := TBitmap32.Create;
  bmp1.Width := 100;
  bmp1.Height := 100;
  bmp1.FillRect(0, 0, 100, 100, clWhite32);
  bmp1.FillRect(0, 0, 80, 80, clTrGreen32);

  bmp1.Font.Size := -16;
  bmp1.Font.Color := clBlack;
  bmp1.TextOut(2, 10, 'Green');

  bmp1.SaveToFile('c:\0\bmp1.bmp');

  bmp2 := TBitmap32.Create;
  bmp2.Width := 80;
  bmp2.Height := 80;
  bmp2.FillRect(0, 0, 80, 80, clTrRed32);

  bmp2.Font.Size := -16;
  bmp2.Font.Color := clBlack;
  bmp2.TextOut(2, 50, 'Red');

  bmp2.SaveToFile('c:\0\bmp2.bmp');

  bmp2.DrawMode := dmBlend;
  bmp2.DrawTo(bmp1, 20, 20);

  bmp1.SaveToFile('c:\0\bmpcombined.bmp');

  bmp1.Free;
  bmp2.Free;
end;

Resulting images:

bmp1: bmp2: bmpcombined:

As you can see, text is painted in black on bmp and bmp2, but appears white on bmpcombined.

I'm guessing the problem lies in TextOut which maps to Windows.ExtTextOut (via GR32_Backends_VCL.pas, TGDIBackend.Textout). That method doesn't handle transparency and paints text with alpha 00 (color is $000000 instead of $FF000000).

As a quick fix, setting bmp2.Font.Color to $FF000000 doesn't help.

bmp2.Font.Color := TColor(clBlack32);

I am using fresh sources from GitHub

How should I paint a non-transparent text on a semi-transparent background so that I could blend this into a larger picture?

Misestimate

Answer 1

As far as I remember the TextOut function was only meant as a direct way to add some text to the bitmap, lacking all the fixes you mentioned above.

In order to remain full control over transparency you might want to use

procedure TBitmap32.RenderText(X, Y: Integer; const Text: string; AALevel: Integer; Color: TColor32);

instead.

It uses the techniques you mentioned in your own answer, but on a more sophisticated level. It also allows you to use anti-aliasing (based on oversampling), but today it's not actually recommended to use any other anti-aliasing technique other than what the font-engine outputs (to take full advantage of font-hinting).

As you are using the latest source code you could also consider to use VPR to render the text (see example 'TextVPR'). It converts the outline of the text as vectors and use the vector drawing capabilities of Graphics32 (by default the engine 'VPR' is used, hence the name) to render it onto the screen. There's also a stripped down engine of AGG included, which itself is based on the FreeType1 engine, which might be slightly faster for fonts.

Speaking of performance: Keep in mind that every other approach than TextOut will obviously decrease the performance. So if you aim for high performance might better cook your own code (based on TextOut).

Otherwise the TextVPR approach leaves you with more freedom, especially when it comes to filling the text (with a gradient for example) or transforming the text (to a curve or such).

Rosado

Thanks! I can't believe I missed this method. – Misestimate

Answer 2

The best solution I could find requires three helper functions.

TransparentToOpaque changes all fully transparent pixels to opaque.

procedure TransparentToOpaque(bmp: TCustomBitmap32);
var
  I: Integer;
  D: PColor32Entry;
begin
  D := PColor32Entry(@bmp.Bits[0]);
  for I := 0 to bmp.Width * bmp.Height - 1 do begin
    if D.A = 0 then
      D.A := $FF;
    Inc(D);
  end;
  bmp.Changed;
end;

FlipTransparency changes all fully transparent pixels to opaque and vice versa.

procedure FlipTransparency(bmp: TCustomBitmap32);
var
  I: Integer;
  D: PColor32Entry;
begin
  D := PColor32Entry(@bmp.Bits[0]);
  for I := 0 to bmp.Width * bmp.Height - 1 do begin
    if D.A = 0 then
      D.A := $FF
    else if D.A = $FF then
      D.A := 0;
    Inc(D);
  end;
  bmp.Changed;
end;

MakeOpaque marks all pixels as opaque.

procedure MakeOpaque(bmp: TCustomBitmap32);
var
  I: Integer;
  D: PColor32Entry;
begin
  D := PColor32Entry(@bmp.Bits[0]);
  for I := 0 to bmp.Width * bmp.Height - 1 do begin
    D.A := $FF;
    Inc(D);
  end;
  bmp.Changed;
end;

Following tricks can then be applied.

• After drawing text on the main image bmp1 which doesn't contain transparent pixels, code calls TransparentToOpaque to prevent problems with blending later on.

• When drawing on a (semi)transparent bitmap bmp2, code creates yet another bitmap bmp3 and fills it with an opaque version of that (semi)transparent bitmap. This will ensure that font is aliased to correct colors in the TextOut call.

  • After the TextOut bmp3 contains opaque background and transparent text. FlipTransparency is then called to generate opaque text on a transparent background.

  • bmp3 is blended onto bmp2. This gives up opaque text on a (semi)transparent background.

  • bmp2 is blended onto bmp1.

Example code:

procedure TForm53.DrawBitmaps;
var
  bmp1: TBitmap32;
  bmp2: TBitmap32;
  bmp3: TBitmap32;
begin
  bmp1 := TBitmap32.Create;
  bmp1.Width := 100;
  bmp1.Height := 100;
  bmp1.FillRect(0, 0, 100, 100, clWhite32);
  bmp1.FillRect(0, 0, 80, 80, clTrGreen32);

  bmp1.Font.Size := -16;
  bmp1.Font.Color := clBlack;
  bmp1.TextOut(2, 10, 'Green');

  //Mark all fully transparent pixels (generated with TextOut) as opaque.
  TransparentToOpaque(bmp1);

  SaveBitmap32ToPNG(bmp1, 'c:\0\bmp1a.png');

  bmp2 := TBitmap32.Create;
  bmp2.Width := 80;
  bmp2.Height := 80;
  bmp2.FillRect(0, 0, 80, 80, clTrRed32);

  //Create bitmap, large enough to contain drawn text (same size as original bitmap in this example).
  bmp3 := TBitmap32.Create;
  bmp3.Width := bmp2.Width;
  bmp3.Height := bmp2.Height;

  //Copy `bmp2` to `bmp3`.
  bmp2.DrawMode := dmOpaque;
  bmp2.DrawTo(bmp3, 0, 0);

  //Mark all pixels as opaque (alpha = $FF)
  MakeOpaque(bmp3);

  //Draw text on `bmp3`. This will create proper aliasing.
  bmp3.Font.Size := -16;
  bmp3.Font.Color := clBlack;
  bmp3.TextOut(2, 50, 'Red');

  //Make all fully transparent pixels (TextOut) opaque and all fully opaque pixels
  //   (background coming from `bmp2`) transparent.
  FlipTransparency(bmp3);

  SaveBitmap32ToPNG(bmp3, 'c:\0\bmp3a.png');

  //Blend `bmp3` on semi-transparent background (`bmp2`).
  bmp3.DrawMode := dmBlend;
  bmp3.DrawTo(bmp2, 0, 0);

  SaveBitmap32ToPNG(bmp2, 'c:\0\bmp2a.png');

  //Blend background + text onto main image.
  bmp2.DrawMode := dmBlend;
  bmp2.DrawTo(bmp1, 20, 20);

  SaveBitmap32ToPNG(bmp1, 'c:\0\bmpcombineda.png');

  bmp1.Free;
  bmp2.Free;
  bmp3.Free;
end;

Resulting images:

bmp1a: bmp2a: bmp3a: bmpcombineda:

Misestimate