Question

使用从TCustomControl派生的自编写按钮控件（TMyButton），我想添加一个为MyButton的标题制作发光效果的功能。在Goolge很长一段时间后，我明白创建光晕的最佳方法是使用指定颜色绘制文本，然后模糊所有文本和表面所在的模糊，然后再次绘制文本。只有当表面是实心的时，它才能完美地工作。填充红色。我创建了使Bitmap模糊的程序，但我的按钮可以有非实体背景，例如可以填充渐变的位图。如果我会模糊那个背景它变得非常糟糕，但发光看起来不错。

我建议使用Scanline解决此任务，但我不知道应该用它做什么。

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

如果使用位图填充我有这个（＆＃34; Text＆＃34;有clBlack阴影）：

这就是上面显示的模糊位图，没有模糊：

是否有人知道如何在不模糊结果位图的情况下为文本制作发光效果？

P.S。用于模糊位图的代码

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设置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 Effects（非常酷）TGlowEffect，但可能适用于整个画布。

如何使文字发光

1 个答案: