Drawing text on glass background becomes blurred as Alpha is lowered

Question

I'm making several updates to the TIceTabSet (Chrome tabs) component. One of these changes is to add transparency. Everything works fine apart from the text. As the alpha channel of the background gets lower, the text becomes more and more blurred. Here's a screenshot.

enter image description here

Here's the code that draws the tabs. Most of it is the original TIceTabSet code. I've simply added a few changes to make the tabs transparent. The code has also been altered a little for the example screenshot. The DrawText command at the bottom is where the text is drawn to the canvas.

procedure TIceTabSet.InnerDraw(Canvas: TCanvas; TabRect: TRect; Item: TIceTab);
var
  graphics : TGPGraphics;
  Pen: TGPPen;
  Brush: TGPSolidBrush;
  path, linePath: TGPGraphicsPath;
  linGrBrush: TGPLinearGradientBrush;
  font: TGPFont;
  solidBrush: TGPSolidBrush;
  rectF: TGPRectF;
  stringFormat: TGPStringFormat;
  DC: HDC;
  marginRight: integer;
  iconY, iconX: integer;
  textStart: Extended;
  startColor, EndColor, textColor, borderColor: cardinal;
  borderWidth: Integer;
  TabProperties: TIceTabProperties;
  Alpha: Byte;
begin
  DC := Canvas.Handle;

  TabProperties := GetTabProperties(Item);

  Alpha := Item.Index * 50;

  startColor := MakeGDIPColor(TabProperties.TabStyle.StartColor, Alpha);// TabProperties.TabStyle.Alpha);
  endColor := MakeGDIPColor(TabProperties.TabStyle.StopColor, Alpha); //TabProperties.TabStyle.Alpha);
  textColor := MakeGDIPColor(TabProperties.Font.Color, 255); //TabProperties.TabStyle.Alpha);
  borderColor := MakeGDIPColor(TabProperties.BorderColor, TabProperties.TabStyle.Alpha);
  borderWidth := TabProperties.BorderWidth;

  graphics := TGPGraphics.Create(DC);
  Brush := TGPSolidBrush.Create(borderColor);
  Pen:= TGPPen.Create(borderColor);
  Font := GetGDIPFont(Canvas, FTabActive.Font); //TabProperties.Font);
  try
    graphics.SetSmoothingMode(SmoothingModeHighQuality);

    pen.SetWidth(borderWidth);

    path := TGPGraphicsPath.Create();
    try
      path.AddBezier(TabRect.Left, TabRect.Bottom, TabRect.Left + FTabShape.LeftEdgeWidth / 2, TabRect.Bottom, TabRect.Left + FTabShape.LeftEdgeWidth / 2, TabRect.Top, TabRect.Left + FTabShape.LeftEdgeWidth, TabRect.Top);
      path.AddLine(TabRect.Left + FTabShape.LeftEdgeWidth, TabRect.Top, TabRect.Right - FTabShape.RightEdgeWidth, TabRect.Top);
      path.AddBezier(TabRect.Right - FTabShape.RightEdgeWidth, TabRect.Top, TabRect.Right - FTabShape.RightEdgeWidth / 2, TabRect.Top, TabRect.Right - FTabShape.RightEdgeWidth / 2, TabRect.Bottom, TabRect.Right, TabRect.Bottom);

      linePath := TGPGraphicsPath.Create;
      try
        linePath.AddPath(path, false);
        path.AddLine(TabRect.Right, TabRect.Bottom, TabRect.Left, TabRect.Bottom);

        linGrBrush := TGPLinearGradientBrush.Create(
          MakePoint(0, TabRect.Top),
          MakePoint(0, TabRect.Bottom),
          startColor,
          endColor);
        try
          graphics.DrawPath(pen, linePath);

          graphics.FillPath(linGrBrush, path);
        finally
          linGrBrush.Free;
        end;
      finally
        linePath.Free;
      end;
    finally
      path.Free;
    end;

    marginRight := 0;

    if TabDisplaysCloseButton(Item) then
    begin
      if (HighLightTabClose = Item) and
         (FTabCloseButton.ShowCircle) then
      begin
        pen.SetWidth(1);

        pen.SetColor(MakeGDIPColor(FTabCloseButton.CrossColorHotTrack, 255));
        brush.SetColor(MakeGDIPColor(FTabCloseButton.CircleColorHotTrack, 255));

        graphics.FillEllipse(brush, TabRect.Right - FTabShape.RightEdgeWidth - 7 - 2,
                                    TabRect.Top + ((TabRect.Bottom - TabRect.Top - 7) div 2) - 3,
                                    (TabRect.Right - FTabShape.RightEdgeWidth) - (TabRect.Right - FTabShape.RightEdgeWidth - 7) + 6,
                                    (TabRect.Top + ((TabRect.Bottom - TabRect.Top + 7) div 2)) - (TabRect.Top + ((TabRect.Bottom - TabRect.Top - 7) div 2)) + 6);

        graphics.DrawLine(pen, TabRect.Right - FTabShape.RightEdgeWidth - 5, TabRect.Top + ((TabRect.Bottom - TabRect.Top - 5) div 2),
                               TabRect.Right - FTabShape.RightEdgeWidth, TabRect.Top + ((TabRect.Bottom - TabRect.Top + 5) div 2));

        graphics.DrawLine(pen, TabRect.Right - FTabShape.RightEdgeWidth, TabRect.Top + ((TabRect.Bottom - TabRect.Top - 5) div 2),
                               TabRect.Right - FTabShape.RightEdgeWidth - 5, TabRect.Top + ((TabRect.Bottom - TabRect.Top + 5) div 2));
      end
      else
      begin
        pen.SetWidth(2);

        if HighlightTabClose = Item then
          pen.SetColor(MakeGDIPColor(FTabCloseButton.CrossColorHotTrack, 255))
        else
          pen.SetColor(MakeGDIPColor(FTabCloseButton.CrossColorNormal, 255));

        graphics.DrawLine(pen, TabRect.Right - FTabShape.RightEdgeWidth - 7, TabRect.Top + ((TabRect.Bottom - TabRect.Top - 7) div 2),
                               TabRect.Right - FTabShape.RightEdgeWidth, TabRect.Top + ((TabRect.Bottom - TabRect.Top + 7) div 2));

        graphics.DrawLine(pen, TabRect.Right - FTabShape.RightEdgeWidth, TabRect.Top + ((TabRect.Bottom - TabRect.Top - 7) div 2),
                               TabRect.Right - FTabShape.RightEdgeWidth - 7, TabRect.Top + ((TabRect.Bottom - TabRect.Top + 7) div 2));
      end;

      marginRight := 10;
    end;

    solidBrush:= TGPSolidBrush.Create(MakeGDIPColor(textColor, 255));

    stringFormat:= TGPStringFormat.Create;
    stringFormat.SetAlignment(StringAlignmentNear);
    stringFormat.SetLineAlignment(StringAlignmentCenter);
    stringFormat.SetTrimming(StringTrimmingEllipsisCharacter);
    stringFormat.SetFormatFlags(StringFormatFlagsNoWrap);

    SelectClipRgn(Canvas.Handle, 0);
    textStart := TabRect.Left + FTabShape.LeftEdgeWidth;
    iconX := 0;
    iconY := 0;

    if Assigned(Images) and (Item.ImageIndex <> -1) then
    begin
      iconY := TabRect.Top + ((TabRect.Bottom - TabRect.Top - Images.Height) div 2);
      iconX := Round(textStart);
      textStart := textStart + Images.Width + 4;
    end;

    rectF := MakeRect(textStart, TabRect.Top, TabRect.Right - textStart - FTabShape.RightEdgeWidth - marginRight,
      TabRect.Bottom - TabRect.Top);

    // ****** Text is drawn here *******
    if rectF.Width > 10 then
      graphics.DrawString(format('Alpha: %d', [Alpha]), -1, font, rectF, stringFormat, solidBrush);
    // *********************************

  finally
    font.Free;
    solidBrush.Free;
    Pen.Free;
    graphics.Free;
  end;

  if Assigned(Images) and
    (Item.ImageIndex <> -1) then
    Images.Draw(Canvas, iconX, iconY, Item.ImageIndex, true);
end;

You can download the full source here. Please be aware that this is a work in progress. The source will be submitted back to the original author when it is complete.

Update 1

Changing the code as TLama suggested certainly helps, but it doesn't completely fix the issue. Here's how the text looks now:

enter image description here

...here's how Google Chrome looks:

enter image description here

Update 2

Here's how it looks with TextRenderingHintSingleBitPerPixelGridFit.

enter image description here

I've tried all the options and TextRenderingHintAntiAlias gives the best results.

Just a few hints about the rest of the code (I know that your work is still in progress) but it seems you mixed font properties in your drawing procedure (I guess you know about it). Also don't forget to implement the `TIceTabProperties.FFont.OnChange` event handler where just `Invalidate` the `FIceTabSet` to reflect the `Font` property changes. And try to keep formatting and order of methods and properties in groups, I mean setters, message handlers and properties is best to see in visibly separated groups. — TLama, Jul 03 '12 at 12:51
@TLama: Thanks for the comment. I'm currently trying to get everything working, then I'm going to tidy up the existing code (which is over two years old and needs quite a bit of attention). — norgepaul, Jul 03 '12 at 12:55
Have you tried the [`TextRenderingHintSingleBitPerPixelGridFit`](http://msdn.microsoft.com/en-us/library/ms534404%28v=vs.85%29.aspx) mode ? — TLama, Jul 03 '12 at 13:09

score 13 · Accepted Answer · edited May 23 '17 at 10:30

As Ian Boyd suggested in his nice post about How to draw ClearType text on Aero glass ? you should apply antialising when you're rendering the text on a sheet of glass. So to fix your problem, try to modify your code this way:

if rectF.Width > 10 then
begin
  if (GetParentForm.GlassFrame.Enabled) and (GetParentForm.GlassFrame.SheetOfGlass) then
    graphics.SetTextRenderingHint(TextRenderingHintAntiAliasGridFit);
  graphics.DrawString(Item.DisplayCaption, -1, font, rectF, stringFormat, solidBrush);
end;

To simulate your problem it's enough to just render the text on the sheet of Aero glass, like the following code does in a 3 different ways:

uses
  GDIPAPI, GDIPOBJ;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Font.Color := clWhite;
  GlassFrame.SheetOfGlass := True;
  GlassFrame.Enabled := True;
end;

procedure TForm1.FormPaint(Sender: TObject);
var
  S: WideString;
  GPFont: TGPFont;
  GPGraphics: TGPGraphics;
  GPSolidBrush: TGPSolidBrush;
  GPGraphicsPath: TGPGraphicsPath;
begin
  S := 'This is a sample text rendered on the sheet of Aero glass!';
  GPFont := TGPFont.Create(Canvas.Handle, Font.Handle);
  GPSolidBrush := TGPSolidBrush.Create(MakeColor(GetRValue(Font.Color),
    GetGValue(Font.Color), GetBValue(Font.Color)));
  GPGraphicsPath := TGPGraphicsPath.Create;
  GPGraphicsPath.AddString(S, Length(S), TGPFontFamily.Create(Font.Name),
    GPFont.GetStyle, GPFont.GetSize, MakePoint(20.0, 60.0), nil);
  try
    GPGraphics := TGPGraphics.Create(Canvas.Handle);
    try
      GPGraphics.SetSmoothingMode(SmoothingModeAntiAlias);
      GPGraphics.FillPath(GPSolidBrush, GPGraphicsPath);
      GPGraphics.DrawString(S, Length(S), GPFont, MakePoint(20.0, 20.0),
        nil, GPSolidBrush);
      GPGraphics.SetTextRenderingHint(
        TextRenderingHintSingleBitPerPixelGridFit);
      GPGraphics.DrawString(S, Length(S), GPFont, MakePoint(20.0, 40.0),
        nil, GPSolidBrush);
    finally
      GPGraphics.Free;
    end;
  finally
    GPFont.Free;
    GPSolidBrush.Free;
    GPGraphicsPath.Free;
  end;
end;

And it results to the following image where:

the first text was rendered by the DrawString function without text antialiasing enabled
the second one was rendered by the DrawString function with text antialiasing enabled, configured to the TextRenderingHintSingleBitPerPixelGridFit mode
the third one was rendered by the path filling, inspired by this article with the smoothing mode set to the SmoothingModeAntiAlias style

The text in your screenshot looks good. The problem seems to be that when text is drawn on a transparent background that is itself drawn on aero glass it starts to look wrong. e.g. Your second line looks the best to me. When I use TextRenderingHintSingleBitPerPixelGridFit on a transparent background it always draws in white, no matter what colour I change the font to. See the image in update 2. — norgepaul, Jul 04 '12 at 20:26
I've accepted this answer although it doesn't work 100% when not drawing directly on the glass. If I figure out the problem I'll post the solution here. — norgepaul, Jul 09 '12 at 07:20

score 6 · Answer 2 · answered Jul 04 '12 at 00:00

As an alternative, you can try drawing with the theme api (Vista and later). Playing with various shadow/border/glow settings, it may be possible to come up with readable text. Some tryout on sheet of glass:

enter image description here

code (XE2):

procedure TForm1.FormPaint(Sender: TObject);
var
  R: TRect;
  ThemeData: HTHEME;
  Opts: TDTTOpts;
begin
  R := Rect(10, 10, 150, 30);
  vcl.themes.DrawGlassText(Canvas.Handle, 'DrawGlassText Sample', R, 0, 3,
      clBlack, TStyleManager.SystemStyle.GetElementDetails(ttsLabel));


  OffsetRect(R, 160, 0);
  ThemeData := OpenThemeData(Handle, 'textstyle');

  Opts.dwSize := SizeOf(Opts);
  Opts.crText := ColorToRGB(clBlack);
  Opts.crShadow := $D0D0B0;
  Opts.iTextShadowType := TST_SINGLE;
  Opts.ptShadowOffset := Point(1, 1);
  Opts.fApplyOverlay := True;
  Opts.iGlowSize := 3;
  Opts.dwFlags := DTT_TEXTCOLOR or DTT_SHADOWTYPE or DTT_SHADOWCOLOR
      or DTT_SHADOWOFFSET or DTT_GLOWSIZE;
  DrawThemeTextEx(ThemeData, Canvas.Handle, TEXT_LABEL, TS_NORMAL,
      'DrawThemeTextEx Sample', -1, 0, @R, Opts);

  OffsetRect(R, 180, 0);
  Opts.crText := ColorToRGB(clBlack);
  Opts.iGlowSize := 4;
  Opts.fApplyOverlay := True;
  Opts.dwFlags := DTT_TEXTCOLOR or DTT_GLOWSIZE;
  DrawThemeTextEx(ThemeData, Canvas.Handle, TEXT_BODYTITLE, 0,
      'Another Sample', -1, 0, @R, Opts);

  CloseThemeData(ThemeData);
end;

+1, I think OP wants to render text without glow, but even this should be possible with the `DrawThemeTextEx` function. — TLama, Jul 04 '12 at 09:12
@TLama - It is possible, but with some settings when you set glow size to 0, the text just disappears. I agree that OP seems to want to render the text without glow, but as far as I could see, without glow it is really difficult to get readable text against all kinds of backgrounds. — Sertac Akyuz, Jul 04 '12 at 09:32
Unfortunately, the glow effect would look out of place when drawn on the tabs. Nice idea though, thanks. — norgepaul, Jul 04 '12 at 20:21
Instead of glow, I think you need to pick the average color of the tab (with transparency included) and then DE-TRANSPARENT-IFY an area 1 pixel on all sides of the text (perhaps by repeatedly painting the text at +1 and -1 offsets in all four directions) and then paint the text in the center position. In short, partially defeat the transparency yourself. — Warren P, Jul 05 '12 at 02:04

Drawing text on glass background becomes blurred as Alpha is lowered

2 Answers2