CODEWITHSUNDEEP
delphitextblurglow
Josef Švejk
Josef Švejk

Reputation: 1068

How to make text glow

Having my self-written button control (TMyButton) derived from TCustomControl I want to add an ability to make glow effect for MyButton's caption. After long time in Goolge I understood that the best way to create glow is to draw text with specify color, then blurring all - text and surface on which it is lies, and then draw text again. It will works perfectly only if surface is solid, e.g. fills with red color. I have created procedure that make Bitmap blurred, but my button can have non-solid background, e.g bitmap which can be filled gradient. If I will blur that background it became very awful, but glow looks nice.

I suggest that this task could be solved by using Scanline, but I have no idea what exactly I should do with it.

If use solid fill I have this (filled with clWhite): blur with solid fill

If use bitmap fill I have this ("Text" has clBlack shadow): blurred bitmap

That is how looks blurred bitmap shown above, without blur: original bitmap

Does anybody has any idea how to make glow effect for text without blurring a result bitmap?

P.S. code to blur bitmap

procedure DrawBlurEffect(BmpInOut: TBitmap; Radius: Integer);
var
  A, B, C, D: PRGBArray;
  x, y, i: Integer;
begin
  BmpInOut.PixelFormat := pf24bit;
  for i:=0 to Radius do
    begin
      for y:=2 to BmpInOut.Height - 2 do
        begin
          A := BmpInOut.ScanLine[y-1];
          B := BmpInOut.ScanLine[y];
          C := BmpInOut.ScanLine[y+1];
          D := BmpInOut.ScanLine[y];
          for x:=1 to BmpInOut.Width - 2 do
            begin
              B[x].Red   := Trunc(C[x].Red   + A[x].Red   + B[x-1].Red   + D[x+1].Red)   div 4;
              B[x].Green := Trunc(C[x].Green + A[x].Green + B[x-1].Green + D[x+1].Green) div 4;
              B[x].Blue  := Trunc(C[x].Blue  + A[x].Blue  + B[x-1].Blue  + D[x+1].Blue)  div 4;
            end;
        end;
    end;
end;

Upvotes: 2

Views: 1722

Answers (1)

kwarunek
kwarunek

Reputation: 12587

Draw text on the glass (vista and above) using DrawThemeTextEx with set DTTOPT glow flag.

uses Types, UxTheme, Themes, Graphics;

procedure DrawGlassText(Canvas: TCanvas; GlowSize: Integer; var Rect: TRect;
  var Text: UnicodeString; Format: DWORD); overload;
var
  DTTOpts: TDTTOpts;
begin
  if Win32MajorVersion < 6 then
  begin
    DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), Rect, Format);
    Exit;
  end;
  ZeroMemory(@DTTOpts, SizeOf(DTTOpts));
  DTTOpts.dwSize := SizeOf(DTTOpts);
  DTTOpts.dwFlags := DTT_COMPOSITED or DTT_TEXTCOLOR;
  if Format and DT_CALCRECT = DT_CALCRECT then
    DTTOpts.dwFlags := DTTOpts.dwFlags or DTT_CALCRECT;
  DTTOpts.crText := ColorToRGB(Canvas.Font.Color);
  if GlowSize > 0 then
  begin
    DTTOpts.dwFlags := DTTOpts.dwFlags or DTT_GLOWSIZE;
    DTTOpts.iGlowSize := GlowSize;
  end;
  with ThemeServices.GetElementDetails(teEditTextNormal) do
    DrawThemeTextEx(ThemeServices.Theme[teEdit], Canvas.Handle, Part, State,
      PWideChar(Text), Length(Text), Format, @Rect, DTTOpts);
end;

There is TransparentCanvas that can be used to set glow color.

As a funfact :). I remember, that some components (d2) to mimic glow-effect, used simple (poor) technique - text behind with specific glow color - shadow.

procedure TExampleGlowLabel.DoDrawText( var Rect : TRect; Flags : Word );
var
  Text       : array[ 0..255 ] of Char;
  TmpRect    : TRect;
begin
  GetTextBuf(Text, SizeOf(Text));
  if ( Flags and DT_CALCRECT <> 0) and
     ( ( Text[0] = #0 ) or ShowAccelChar and
       ( Text[0] = '&' ) and
       ( Text[1] = #0 ) ) then
    StrCopy(Text, ' ');

  if not ShowAccelChar then
    Flags := Flags or DT_NOPREFIX;
  Canvas.Font := Font;

  if FGlowing and Enabled then
  begin
    TmpRect := Rect;
    OffsetRect( TmpRect, 1, 1 );
    Canvas.Font.Color := GlowColor;
    DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);

    TmpRect := Rect;
    OffsetRect( TmpRect, -1, -1 );
    Canvas.Font.Color := GlowColor;
    DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);

    TmpRect := Rect;
    OffsetRect( TmpRect, -1, 1 );
    Canvas.Font.Color := GlowColor;
    DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);

    TmpRect := Rect;
    OffsetRect( TmpRect, 1, -1 );
    Canvas.Font.Color := GlowColor;
    DrawText(Canvas.Handle, Text, StrLen(Text), TmpRect, Flags);
  end;

  Canvas.Font.Color := Font.Color;
  if not Enabled then
    Canvas.Font.Color := clGrayText;
  DrawText(Canvas.Handle, Text, StrLen(Text), Rect, Flags);
end;

As mentioned in comment TButton with transparent PNG image and glowing hover effect has answer with some non-free components.

edit

Different approach would be to use FireMonkey Effects (really cool) TGlowEffect, but probably, it applies to whole canvas.

Upvotes: 0

Related Questions