delphi - 如何使文字发光

我的自写按钮控件（TMyButton）从TCustomControl派生而来，我想添加一种使MyButton标题具有发光效果的功能。在Goolge中工作了很长时间之后，我了解到创建发光效果的最佳方法是绘制具有指定颜色的文本，然后将所有内容（包括文本和其所在的表面）模糊化，然后再次绘制文本。仅当表面是固体时，例如充满红色。
我创建了使位图模糊的过程，但是我的按钮可以具有非固定背景，例如可以填充渐变的位图。如果我要模糊那个背景，它会变得很糟糕，但是发光看起来不错。

我建议可以使用Scanline解决此任务，但是我不知道该怎么做。

如果使用实心填充，我有这个（用clWhite填充）：

如果使用位图填充，我有这个（“文本”具有clBlack阴影）：

这就是上面显示的模糊位图看起来没有模糊的样子：

有谁知道如何在不模糊结果位图的情况下使文本发光效果？

附言
代码模糊位图

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;

最佳答案

使用设置了DrawThemeTextEx发光标志的DTTOPT在玻璃（vista及以上）上绘制文本。

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;

有TransparentCanvas可用于设置发光颜色。

作为一个功能:)。我记得，有些组件（d2）模仿发光效果，使用了简单的（较差）技术-带有特定发光颜色的文字后面-阴影。

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;

如评论中所述，TButton with transparent PNG image and glowing hover effect对于某些非自由组件有答案。

编辑

另一种方法是使用FireMonkey效果（确实很酷）TGlowEffect，但可能适用于整个画布。

关于delphi - 如何使文字发光，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/34163779/