德尔福定制绘图 - 发光玻璃 [英] Delphi custom drawing - glowing glass
本文介绍了德尔福定制绘图 - 发光玻璃的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我一直在尝试一些玻璃状的图像，如下面的图像，我想到有一种方式我可以把它放入代码，所以我可以着色任何我想要的。它不需要像下面的图像一样100％，但是我想编写一些代码来绘制椭圆和玻璃效果（渐变与一些非常花哨的计算）。我必须清楚地注意到我对数学很可怕，我知道这需要一些棘手的公式。
我正在研究的样本：
椭圆的边框是容易的部分，从顶部到底部位于椭圆内的渐变也很容易 - 但是当谈到使边缘褪色时为了使顶部和侧面的玻璃状外观 - 我不知道如何去做这个。
原始左边图像 / p>
是否有人可以指出我有一个很好的教程，或者有人想要展示它，否则将非常感激。
以下是我用于绘制的过程：
/ B =绘制到
的位图// Col =绘制玻璃图像的颜色
程序TForm1.DrawOval（const Col：TColor; var B：TBitmap）;
var
C：TCanvas; //主画布轻松绘制
R：TRect; // Base rect
R2：TRect; //工作rect
X：整数; //主上/下梯度循环
CR，CG，CB：Byte; // Base RGB color values
TR，TG，TB：Byte; //工作RGB颜色值
begin
如果分配（B）然后开始
如果B& nil然后开始
C：= B.Canvas;
R：= C.ClipRect;
C.Pen.Style: = psClear;
C.Brush.Style: = bsSolid;
C.Brush.Color：= B.TransparentColor;
C.FillRect（R）;
C.Pen.Style:= psSolid;
C.Pen.Color：= clBlack;
C.Pen.Width：= 5;
C.Brush.Color：= clBlack;
R2：= R;
为X：= 1到6开始
R2.Bottom：= R2.Bottom - 1;
C.RoundRect（R2.Left，R2.Top，R2.Right，R2.Bottom，
Round（R2.Bottom / 1.5），Round（R2.Bottom / 1.5））;
结束
R2.Left：= R2.Left + 1;
R2.Right：= R2.Right - 1;
C.Brush.Color：= Col;
C.Pen.Width：= 3;
C.RoundRect（R2.Left，R2.Top，R2.Right，R2.Bottom，
Round（R2.Bottom / 1.5），Round（R2.Bottom / 1.5））;
C.Brush.Style: = bsSolid;
C.Pen.Style:= psClear;
R2：= R;
R2.Left：= R2.Left + 13;
R2.Right：= R2.Right - 13;
R2.Top:= 3;
R2.Bottom：=（R2.Bottom div 2） - 18;
CR：= GetRValue（Col）;
CG：= GetGValue（Col）;
CB：= GetBValue（Col）;
for X：= 1 to 16 do begin
TR：= EnsureRange（CR +（X * 4）+25，0，255）;
TG：= EnsureRange（CG +（X * 4）+25，0，255）;
TB：= EnsureRange（CB +（X * 4）+25，0，255）;
C.Brush.Color：= RGB（TR，TG，TB）;
C.RoundRect（R2.Left，R2.Top，R2.Right，R2.Bottom，
Round（R2.Bottom / 1.5），Round（R2.Bottom / 1.5））;
R2.Left：= R2.Left + 2;
R2.Right：= R2.Right - 2;
R2.Bottom：= R2.Bottom - 1;
结束
结束
结束
结束
解决方案
需要配料：
-
AlphaBlend的玻璃效果， -
GradientFill， li>
-
MaskBlt在绘制时排除非矩形已绘制的部分， - 确实有一些数学，很简单。
真的有必要将绘图任务放在小步骤中，并按正确的顺序放置它们。那么这并不是最初似乎可能不可能。
在下面的代码中，我使用三个临时位图来达到最终目标：
- 一个内存位图，其中绘制所有内容以减少闪烁，
- 需要帮助的临时位图，
- 用于存储裁剪形状的掩码位图。
我不喜欢代码中的注释，我期望它会说话：
unit GlassLabel;
接口
使用
类，控件，Windows，图形，数学;
const
DefTransparency = 30;
type
TPercentage = 0..100;
TGlassLabel = class（TGraphicControl）
private
FT透明度：TPercentage;
procedure SetTransparency（Value：TPercentage）;
protected
procedure Paint;覆盖
public
构造函数Create（AOwner：TComponent）;覆盖
程序SetBounds（ALeft，ATop，AWidth，AHeight：Integer）;覆盖
发布
属性Caption;
属性颜色;
属性Font;
属性透明度：TPercentage读取FTransparency
写SetTransparency默认DefTransparency;
结束
实现
类型
PTriVertex = ^ TTriVertex;
TTriVertex = record
X：DWORD;
Y：DWORD;
红色：WORD;
绿色：WORD;
蓝：WORD;
阿尔法：WORD;
结束
TRGB = record
R：字节;
G：字节;
B：字节;
结束
函数GradientFill（DC：HDC;顶点：PTriVertex; NumVertex：ULONG;
网格：指针; NumMesh，模式：ULONG）：BOOL;标准超载;
external msimg32 name'GradientFill';
函数GradientFill（DC：HDC; const ARect：TRect; StartColor，
EndColor：TColor; Vertical：Boolean）：Boolean;超载;
const
模式：数组[布尔] ULONG =（GRADIENT_FILL_RECT_H，GRADIENT_FILL_RECT_V）;
var
顶点：TTriVertex的数组[0..1];
GRect：TGradientRect;
begin
顶点[0] .X：= ARect.Left;
顶点[0] .Y：= ARect.Top;
顶点[0] .Red：= GetRValue（ColorToRGB（StartColor））shl 8;
顶点[0] .Green：= GetGValue（ColorToRGB（StartColor））shl 8;
顶点[0] .Blue：= GetBValue（ColorToRGB（StartColor））shl 8;
顶点[0] .Alpha：= 0;
顶点[1] .X：= ARect.Right;
顶点[1] .Y：= ARect.Bottom;
顶点[1] .Red：= GetRValue（ColorToRGB（EndColor））shl 8;
顶点[1] .Green：= GetGValue（ColorToRGB（EndColor））shl 8;
顶点[1] .Blue：= GetBValue（ColorToRGB（EndColor））shl 8;
顶点[1] .Alpha：= 0;
GRect.UpperLeft：= 0;
GRect.LowerRight：= 1;
结果：= GradientFill（DC，@Vertices，2，@GRect，1，模式[垂直]）;
结束
函数GetRGB（AColor：TColor）：TRGB;
begin
AColor：= ColorToRGB（AColor）;
Result.R：= GetRValue（AColor）;
Result.G：= GetGValue（AColor）;
Result.B：= GetBValue（AColor）;
结束
函数MixColor（Base，MixWith：TColor; Factor：Single）：TColor;
var
FBase：TRGB;
FMixWith：TRGB;
begin
如果因子<= 0则
结果：= Base
如果因子> = 1则
结果：= MixWith
else
begin
FBase：= GetRGB（Base）;
FMixWith：= GetRGB（MixWith）;
with FBase do
begin
R：= R + Round（（FMixWith.R - R）* Factor）;
G：= G + Round（（FMixWith.G - G）*因子）;
B：= B + Round（（FMixWith.B - B）*因子）;
结果：= RGB（R，G，B）;
结束
结束
结束
函数ColorWhiteness（C：TColor）：单个;
begin
结果：=（GetRValue（C）+ GetGValue（C）+ GetBValue（C））/ 255/3;
结束
函数ColorBlackness（C：TColor）：单个;
begin
结果：= 1 - ColorWhiteness（C）;
结束
{TGlassLabel}
构造函数TGlassLabel.Create（AOwner：TComponent）;
begin
继承Create（AOwner）;
ControlStyle：= [csOpaque];
FT透明度：= DefTransparency;
结束
程序TGlassLabel.Paint;
const
DSTCOPY = $ 00AA0029;
DrawTextFlags = DT_CENTER或DT_END_ELLIPSIS或DT_SINGLELINE或DT_VCENTER;
var
W：整数;
H：整数;
BorderTop：整数;
BorderBottom：整数;
BorderSide：整数;
阴影：整数;
R0：TRect; //控制权限
R1：TRect; // Inside border
R2：TRect; //顶部渐变
R3：TRect; // Text
R4：TRect; //穿孔
ParentDC：HDC;
Tmp：TBitmap;
Mem：TBitmap;
Msk：TBitmap;
ShadowFactor：Single;
X：整数;
BlendFunc：TBlendFunction;
procedure PrepareBitmaps;
begin
Tmp.Width：= W;
Tmp.Height：= H;
Mem.Canvas.Brush.Color：=颜色;
Mem.Width：= W;
Mem.Height：= H;
Mem.Canvas.Brush.Style：= bsClear;
Msk.Width：= W;
Msk.Height：= H;
Msk.Monochrome：= True;
结束
procedure PrepareMask（R：TRect）;
var
半径：整数;
begin
Radius：=（R.Bottom - R.Top）div 2;
Msk.Canvas.Brush.Color：= clBlack;
Msk.Canvas.FillRect（R0）;
Msk.Canvas.Brush.Color：= clWhite;
Msk.Canvas.Ellipse（R.Left，R.Top，R.Left + 2 * Radius，R.Bottom）;
Msk.Canvas.Ellipse（R.Right - 2 * Radius，R.Top，R.Right，R.Bottom）;
Msk.Canvas.FillRect（Rect（R.Left + Radius，R.Top，R.Right - Radius，
R.Bottom））;
结束
程序DrawTopGradientEllipse;
begin
GradientFill（Tmp.Canvas.Handle，R2，MixColor（Color，clWhite，1.0），
MixColor（Color，clWhite，0.2），True）;
PrepareMask（R2）;
MaskBlt（Mem.Canvas.Handle，0，0，W，H，Tmp.Canvas.Handle，0，0，
Msk.Handle，0,0，MakeROP4（SRCCOPY，DSTCOPY））;
结束
程序DrawPerforation;
begin
，而R4.Right< （W-H div 2）do
begin
Mem.Canvas.Pen.Color：= MixColor（Color，clBlack，0.9）;
Mem.Canvas.RoundRect（R4.Left，R4.Top，R4.Right，R4.Bottom，H div 7，
H div 7）;
Mem.Canvas.Pen.Color：= MixColor（Color，clBlack，0.5）;
Mem.Canvas.RoundRect（R4.Left + 1，R4.Top + 1，R4.Right - 1，
R4.Bottom - 1，H div 7 - 1，H div 7 - 1） ;
Mem.Canvas.Pen.Color：= MixColor（Color，clWhite，0.33）;
Mem.Canvas.MoveTo（R4.Left + H div 14，R4.Top + 1）;
Mem.Canvas.LineTo（R4.Right - H div 14，R4.Top + 1）;
OffsetRect（R4，R4.Right - R4.Left + H div 12，0）;
结束
结束
程序DrawCaption;
begin
Mem.Canvas.Font：= Font;
ShadowFactor：= 0.6 + 0.4 *（Min（1.0，ColorBlackness（Font.Color）+ 0.3））;
Mem.Canvas.Font.Color：= MixColor（Font.Color，clBlack，ShadowFactor）;
DrawText（Mem.Canvas.Handle，PChar（Caption），-1，R3，DrawTextFlags）;
OffsetRect（R3，-Shadow，Shadow）;
Mem.Canvas.Font.Color：= Font.Color;
DrawText（Mem.Canvas.Handle，PChar（Caption），-1，R3，DrawTextFlags）;
结束
程序DrawBorderAlias;
begin
Mem.Canvas.Pen.Color：= MixColor（Color，clBlack，0.65）;
X：= R1.Left +（R1.Bottom - R1.Top）div 2 + 2;
Mem.Canvas.Arc（R1.Left + 1，R1.Top，R1.Left + R1.Bottom - R1.Top + 1，
R1.Bottom，X，0，X，H） ;
X：= R1.Right - （R1.Bottom - R1.Top）div 2 - 2;
Mem.Canvas.Arc（R1.Right - 1，R1.Top，R1.Right - R1.Bottom + R1.Top - 1，
R1.Bottom，X，H，X，0） ;
结束
程序DrawBorder;
begin
PrepareMask（R1）;
Tmp.Canvas.Brush.Color：= clWhite;
Tmp.Canvas.Draw（0，0，Msk）;
BitBlt（Mem.Canvas.Handle，0，0，W，H，Tmp.Canvas.Handle，0，0，SRCAND）;
结束
程序DrawCombineParent;
begin
BitBlt（Tmp.Canvas.Handle，0，0，W，H，ParentDC，Left，Top，SRCCOPY）;
BlendFunc.BlendOp：= AC_SRC_OVER;
BlendFunc.BlendFlags：= 0;
BlendFunc.SourceConstantAlpha：= Round（FTransparency * High（Byte）/ 100）;
BlendFunc.AlphaFormat：= 0;
AlphaBlend（Mem.Canvas.Handle，0，0，W，H，Tmp.Canvas.Handle，0，0，W，H，
BlendFunc）;
PrepareMask（R0）;
MaskBlt（Mem.Canvas.Handle，0，0，W，H，Tmp.Canvas.Handle，0，0，
Msk.Handle，0，MakeROP4（DSTCOPY，SRCCOPY））;
结束
begin
如果HasParent和（Height> 1）然后
begin
W：= Width;
H：=身高;
BorderTop：= Max（1，H div 30）;
BorderBottom：= Max（2，H div 10）;
BorderSide：=（BorderTop + BorderBottom）div 2;
阴影：= Font.Size div 8;
R0：= ClientRect;
R1：= Rect（BorderSide，BorderTop，W-BorderSide，H-BorderBottom）;
R2：= Rect（R1.Left + BorderSide + 1，R1.Top，R1.Right - BorderSide - 1，
R1.Top + H div 4）;
R3：= Rect（H div 2 + 1 + Shadow，R1.Top + 1，W - H div 2 - 1，
R1.Bottom - Shadow）;
R4：= Bounds（H div 2，R1.Bottom - H div 4 + 1，H div 5，H div 4 - 2）;
ParentDC：= GetDC（Parent.Handle）;
Tmp：= TBitmap.Create;
Mem：= TBitmap.Create;
Msk：= TBitmap.Create;
try
PrepareBitmaps;
DrawTopGradientEllipse;
DrawPerforation;
DrawCaption;
DrawBorderAlias;
DrawBorder;
DrawCombineParent;
BitBlt（Canvas.Handle，0，0，W，H，Mem.Canvas.Handle，0，0，SRCCOPY）;
finally
Msk.Free;
Mem.Free;
Tmp.Free;
ReleaseDC（Parent.Handle，ParentDC）;
结束
结束
结束
程序TGlassLabel.SetBounds（ALeft，ATop，AWidth，AHeight：Integer）;
begin
如果AWidth<然后，然后
AWidth：= AHeight;
继承了SetBounds（ALeft，ATop，AWidth，AHeight）;
结束
程序TGlassLabel.SetTransparency（Value：TPercentage）;
begin
如果FTransparency<>值然后
begin
FTransparency：= Value;
无效;
结束
结束
结束。
生成上述的代码（在背景中放置一个 TImage 控件）：
procedure TForm1.FormCreate（Sender：TObject）;
begin
Font.Size：= 16;
Font.Color：= $ 00A5781B;
Font.Name：='Calibri';
Font.Style：= [fsBold];
with TGlassLabel.Create（Self）do
begin
SetBounds（40，40，550，60）;
颜色：= $ 00271907;
标题：='395天，22小时，0分，54秒';
父母：=自我;
结束
with TGlassLabel.Create（Self）do
begin
SetBounds（40，40 + 119，550，60）;
颜色：= $ 00000097;
标题：='0天，1小时，59分，31秒';
父母：=自我;
结束
结束
根据您的喜好调整。
I have been experimenting a lot with some glassy images, such as the one below, and I got to thinking there's gotta be a way I can put this into code, so I can color it anything I want. It doesn't need to look 100% precisely like the image below, but I'd like to write some code to draw the oval and the glass effect (gradient with some really fancy calculations). I must note clearly that I am horrible with math, and I know this requires some tricky formulas.
Sample of what I'm working on:
The border of the oval is the easy part, the gradient that goes inside the oval from top to bottom is also fairly easy - but when it comes to making the edges fade to make that glassy look along the top and sides - I have no clue how to go about doing this.
Original left edge image:
Whether someone can point me to a good tutorial for this, or if someone wants to demonstrate it, either would be really appreciated.
Here's the procedure I use to draw so far:
//B = Bitmap to draw to
//Col = Color to draw glass image
procedure TForm1.DrawOval(const Col: TColor; var B: TBitmap);
var
C: TCanvas; //Main canvas for drawing easily
R: TRect; //Base rect
R2: TRect; //Working rect
X: Integer; //Main top/bottom gradient loop
CR, CG, CB: Byte; //Base RGB color values
TR, TG, TB: Byte; //Working RGB color values
begin
if assigned(B) then begin
if B <> nil then begin
C:= B.Canvas;
R:= C.ClipRect;
C.Pen.Style:= psClear;
C.Brush.Style:= bsSolid;
C.Brush.Color:= B.TransparentColor;
C.FillRect(R);
C.Pen.Style:= psSolid;
C.Pen.Color:= clBlack;
C.Pen.Width:= 5;
C.Brush.Color:= clBlack;
R2:= R;
for X:= 1 to 6 do begin
R2.Bottom:= R2.Bottom - 1;
C.RoundRect(R2.Left, R2.Top, R2.Right, R2.Bottom,
Round(R2.Bottom / 1.5), Round(R2.Bottom / 1.5));
end;
R2.Left:= R2.Left + 1;
R2.Right:= R2.Right - 1;
C.Brush.Color:= Col;
C.Pen.Width:= 3;
C.RoundRect(R2.Left, R2.Top, R2.Right, R2.Bottom,
Round(R2.Bottom / 1.5), Round(R2.Bottom / 1.5));
C.Brush.Style:= bsSolid;
C.Pen.Style:= psClear;
R2:= R;
R2.Left:= R2.Left + 13;
R2.Right:= R2.Right - 13;
R2.Top:= 3;
R2.Bottom:= (R2.Bottom div 2) - 18;
CR:= GetRValue(Col);
CG:= GetGValue(Col);
CB:= GetBValue(Col);
for X:= 1 to 16 do begin
TR:= EnsureRange(CR + (X * 4)+25, 0, 255);
TG:= EnsureRange(CG + (X * 4)+25, 0, 255);
TB:= EnsureRange(CB + (X * 4)+25, 0, 255);
C.Brush.Color:= RGB(TR, TG, TB);
C.RoundRect(R2.Left, R2.Top, R2.Right, R2.Bottom,
Round(R2.Bottom / 1.5), Round(R2.Bottom / 1.5));
R2.Left:= R2.Left + 2;
R2.Right:= R2.Right - 2;
R2.Bottom:= R2.Bottom - 1;
end;
end;
end;
end;
解决方案
Ingredients needed:
AlphaBlendfor the glassy effect,GradientFillfor the top gradient ellipse,MaskBltto exclude non-rectangular already drawn parts when drawing,- indeed some math, pretty easy though.
It is really necessary to devide the drawing task in small steps and place them in the right order. Then this is not as impossible as it at first may seem.
In the code below, I use three temporary bitmaps to reach the end goal:
- a memory bitmap on which everything is drawn to reduce flicker,
- a temporary bitmap, needed for assistance,
- a mask bitmap for storage of a clipping shape.
I do not like comments in code, but I expect it speaks for itself:
unit GlassLabel;
interface
uses
Classes, Controls, Windows, Graphics, Math;
const
DefTransparency = 30;
type
TPercentage = 0..100;
TGlassLabel = class(TGraphicControl)
private
FTransparency: TPercentage;
procedure SetTransparency(Value: TPercentage);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
property Caption;
property Color;
property Font;
property Transparency: TPercentage read FTransparency
write SetTransparency default DefTransparency;
end;
implementation
type
PTriVertex = ^TTriVertex;
TTriVertex = record
X: DWORD;
Y: DWORD;
Red: WORD;
Green: WORD;
Blue: WORD;
Alpha: WORD;
end;
TRGB = record
R: Byte;
G: Byte;
B: Byte;
end;
function GradientFill(DC: HDC; Vertex: PTriVertex; NumVertex: ULONG;
Mesh: Pointer; NumMesh, Mode: ULONG): BOOL; stdcall; overload;
external msimg32 name 'GradientFill';
function GradientFill(DC: HDC; const ARect: TRect; StartColor,
EndColor: TColor; Vertical: Boolean): Boolean; overload;
const
Modes: array[Boolean] of ULONG = (GRADIENT_FILL_RECT_H, GRADIENT_FILL_RECT_V);
var
Vertices: array[0..1] of TTriVertex;
GRect: TGradientRect;
begin
Vertices[0].X := ARect.Left;
Vertices[0].Y := ARect.Top;
Vertices[0].Red := GetRValue(ColorToRGB(StartColor)) shl 8;
Vertices[0].Green := GetGValue(ColorToRGB(StartColor)) shl 8;
Vertices[0].Blue := GetBValue(ColorToRGB(StartColor)) shl 8;
Vertices[0].Alpha := 0;
Vertices[1].X := ARect.Right;
Vertices[1].Y := ARect.Bottom;
Vertices[1].Red := GetRValue(ColorToRGB(EndColor)) shl 8;
Vertices[1].Green := GetGValue(ColorToRGB(EndColor)) shl 8;
Vertices[1].Blue := GetBValue(ColorToRGB(EndColor)) shl 8;
Vertices[1].Alpha := 0;
GRect.UpperLeft := 0;
GRect.LowerRight := 1;
Result := GradientFill(DC, @Vertices, 2, @GRect, 1, Modes[Vertical]);
end;
function GetRGB(AColor: TColor): TRGB;
begin
AColor := ColorToRGB(AColor);
Result.R := GetRValue(AColor);
Result.G := GetGValue(AColor);
Result.B := GetBValue(AColor);
end;
function MixColor(Base, MixWith: TColor; Factor: Single): TColor;
var
FBase: TRGB;
FMixWith: TRGB;
begin
if Factor <= 0 then
Result := Base
else if Factor >= 1 then
Result := MixWith
else
begin
FBase := GetRGB(Base);
FMixWith := GetRGB(MixWith);
with FBase do
begin
R := R + Round((FMixWith.R - R) * Factor);
G := G + Round((FMixWith.G - G) * Factor);
B := B + Round((FMixWith.B - B) * Factor);
Result := RGB(R, G, B);
end;
end;
end;
function ColorWhiteness(C: TColor): Single;
begin
Result := (GetRValue(C) + GetGValue(C) + GetBValue(C)) / 255 / 3;
end;
function ColorBlackness(C: TColor): Single;
begin
Result := 1 - ColorWhiteness(C);
end;
{ TGlassLabel }
constructor TGlassLabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := [csOpaque];
FTransparency := DefTransparency;
end;
procedure TGlassLabel.Paint;
const
DSTCOPY = $00AA0029;
DrawTextFlags = DT_CENTER or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER;
var
W: Integer;
H: Integer;
BorderTop: Integer;
BorderBottom: Integer;
BorderSide: Integer;
Shadow: Integer;
R0: TRect; //Bounds of control
R1: TRect; //Inside border
R2: TRect; //Top gradient
R3: TRect; //Text
R4: TRect; //Perforation
ParentDC: HDC;
Tmp: TBitmap;
Mem: TBitmap;
Msk: TBitmap;
ShadowFactor: Single;
X: Integer;
BlendFunc: TBlendFunction;
procedure PrepareBitmaps;
begin
Tmp.Width := W;
Tmp.Height := H;
Mem.Canvas.Brush.Color := Color;
Mem.Width := W;
Mem.Height := H;
Mem.Canvas.Brush.Style := bsClear;
Msk.Width := W;
Msk.Height := H;
Msk.Monochrome := True;
end;
procedure PrepareMask(R: TRect);
var
Radius: Integer;
begin
Radius := (R.Bottom - R.Top) div 2;
Msk.Canvas.Brush.Color := clBlack;
Msk.Canvas.FillRect(R0);
Msk.Canvas.Brush.Color := clWhite;
Msk.Canvas.Ellipse(R.Left, R.Top, R.Left + 2 * Radius, R.Bottom);
Msk.Canvas.Ellipse(R.Right - 2 * Radius, R.Top, R.Right, R.Bottom);
Msk.Canvas.FillRect(Rect(R.Left + Radius, R.Top, R.Right - Radius,
R.Bottom));
end;
procedure DrawTopGradientEllipse;
begin
GradientFill(Tmp.Canvas.Handle, R2, MixColor(Color, clWhite, 1.0),
MixColor(Color, clWhite, 0.2), True);
PrepareMask(R2);
MaskBlt(Mem.Canvas.Handle, 0, 0, W, H, Tmp.Canvas.Handle, 0, 0,
Msk.Handle, 0, 0, MakeROP4(SRCCOPY, DSTCOPY));
end;
procedure DrawPerforation;
begin
while R4.Right < (W - H div 2) do
begin
Mem.Canvas.Pen.Color := MixColor(Color, clBlack, 0.9);
Mem.Canvas.RoundRect(R4.Left, R4.Top, R4.Right, R4.Bottom, H div 7,
H div 7);
Mem.Canvas.Pen.Color := MixColor(Color, clBlack, 0.5);
Mem.Canvas.RoundRect(R4.Left + 1, R4.Top + 1, R4.Right - 1,
R4.Bottom - 1, H div 7 - 1, H div 7 - 1);
Mem.Canvas.Pen.Color := MixColor(Color, clWhite, 0.33);
Mem.Canvas.MoveTo(R4.Left + H div 14, R4.Top + 1);
Mem.Canvas.LineTo(R4.Right - H div 14, R4.Top + 1);
OffsetRect(R4, R4.Right - R4.Left + H div 12, 0);
end;
end;
procedure DrawCaption;
begin
Mem.Canvas.Font := Font;
ShadowFactor := 0.6 + 0.4 * (Min(1.0, ColorBlackness(Font.Color) + 0.3));
Mem.Canvas.Font.Color := MixColor(Font.Color, clBlack, ShadowFactor);
DrawText(Mem.Canvas.Handle, PChar(Caption), -1, R3, DrawTextFlags);
OffsetRect(R3, -Shadow, Shadow);
Mem.Canvas.Font.Color := Font.Color;
DrawText(Mem.Canvas.Handle, PChar(Caption), -1, R3, DrawTextFlags);
end;
procedure DrawBorderAlias;
begin
Mem.Canvas.Pen.Color := MixColor(Color, clBlack, 0.65);
X := R1.Left + (R1.Bottom - R1.Top) div 2 + 2;
Mem.Canvas.Arc(R1.Left + 1, R1.Top, R1.Left + R1.Bottom - R1.Top + 1,
R1.Bottom, X, 0, X, H);
X := R1.Right - (R1.Bottom - R1.Top) div 2 - 2;
Mem.Canvas.Arc(R1.Right - 1, R1.Top, R1.Right - R1.Bottom + R1.Top - 1,
R1.Bottom, X, H, X, 0);
end;
procedure DrawBorder;
begin
PrepareMask(R1);
Tmp.Canvas.Brush.Color := clWhite;
Tmp.Canvas.Draw(0, 0, Msk);
BitBlt(Mem.Canvas.Handle, 0, 0, W, H, Tmp.Canvas.Handle, 0, 0, SRCAND);
end;
procedure DrawCombineParent;
begin
BitBlt(Tmp.Canvas.Handle, 0, 0, W, H, ParentDC, Left, Top, SRCCOPY);
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := Round(FTransparency * High(Byte) / 100);
BlendFunc.AlphaFormat := 0;
AlphaBlend(Mem.Canvas.Handle, 0, 0, W, H, Tmp.Canvas.Handle, 0, 0, W, H,
BlendFunc);
PrepareMask(R0);
MaskBlt(Mem.Canvas.Handle, 0, 0, W, H, Tmp.Canvas.Handle, 0, 0,
Msk.Handle, 0, 0, MakeROP4(DSTCOPY, SRCCOPY));
end;
begin
if HasParent and (Height > 1) then
begin
W := Width;
H := Height;
BorderTop := Max(1, H div 30);
BorderBottom := Max(2, H div 10);
BorderSide := (BorderTop + BorderBottom) div 2;
Shadow := Font.Size div 8;
R0 := ClientRect;
R1 := Rect(BorderSide, BorderTop, W - BorderSide, H - BorderBottom);
R2 := Rect(R1.Left + BorderSide + 1, R1.Top, R1.Right - BorderSide - 1,
R1.Top + H div 4);
R3 := Rect(H div 2 + 1 + Shadow, R1.Top + 1, W - H div 2 - 1,
R1.Bottom - Shadow);
R4 := Bounds(H div 2, R1.Bottom - H div 4 + 1, H div 5, H div 4 - 2);
ParentDC := GetDC(Parent.Handle);
Tmp := TBitmap.Create;
Mem := TBitmap.Create;
Msk := TBitmap.Create;
try
PrepareBitmaps;
DrawTopGradientEllipse;
DrawPerforation;
DrawCaption;
DrawBorderAlias;
DrawBorder;
DrawCombineParent;
BitBlt(Canvas.Handle, 0, 0, W, H, Mem.Canvas.Handle, 0, 0, SRCCOPY);
finally
Msk.Free;
Mem.Free;
Tmp.Free;
ReleaseDC(Parent.Handle, ParentDC);
end;
end;
end;
procedure TGlassLabel.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
if AWidth < AHeight then
AWidth := AHeight;
inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;
procedure TGlassLabel.SetTransparency(Value: TPercentage);
begin
if FTransparency <> Value then
begin
FTransparency := Value;
Invalidate;
end;
end;
end.
Sample code to produce the above (place an TImage control in the background):
procedure TForm1.FormCreate(Sender: TObject);
begin
Font.Size := 16;
Font.Color := $00A5781B;
Font.Name := 'Calibri';
Font.Style := [fsBold];
with TGlassLabel.Create(Self) do
begin
SetBounds(40, 40, 550, 60);
Color := $00271907;
Caption := '395 Days, 22 Hours, 0 Minutes, 54 Seconds';
Parent := Self;
end;
with TGlassLabel.Create(Self) do
begin
SetBounds(40, 40 + 119, 550, 60);
Color := $00000097;
Caption := '0 Days, 1 Hours, 59 Minutes, 31 Seconds';
Parent := Self;
end;
end;
Tweak as you like.
这篇关于德尔福定制绘图 - 发光玻璃的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
