delphi - 如何让文字发光

Question

我自己编写的按钮控件 (TMyButton) 源自 TCustomControl，我想添加为 MyButton 的标题制作发光效果的功能。在 Google 工作了很长时间后，我了解到创建发光的最佳方法是使用指定颜色绘制文本，然后模糊所有文本和其所在的表面，然后再次绘制文本。仅当表面是固体时，例如，它才能完美工作。填充红色。我创建了使位图模糊的程序，但我的按钮可以有非纯色背景，例如可以填充渐变的位图。如果我模糊背景，它会变得非常糟糕，但发光看起来不错。

我建议可以使用 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;

Answer 1

使用 DrawThemeTextEx 在玻璃上(vista 及以上)绘制文本带套装DTTOPT发光旗帜。

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 Effects(真的很酷)TGlowEffect ，但可能它适用于整个 Canvas 。