使用从TCustomControl派生的自编写按钮控件(TMyButton),我想添加一个为MyButton的标题制作发光效果的功能。在Goolge很长一段时间后,我明白创建光晕的最佳方法是使用指定颜色绘制文本,然后模糊所有文本和表面所在的模糊,然后再次绘制文本。只有当表面是实心的时,它才能完美地工作。填充红色。 我创建了使Bitmap模糊的程序,但我的按钮可以有非实体背景,例如可以填充渐变的位图。如果我会模糊那个背景它变得非常糟糕,但发光看起来不错。
我建议使用Scanline解决此任务,但我不知道应该用它做什么。
如果使用位图填充我有这个(" Text"有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;
答案 0 :(得分:0)
使用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,但可能适用于整个画布。