德尔福定制绘图 - 发光玻璃 [英] Delphi custom drawing - glowing glass
本文介绍了德尔福定制绘图 - 发光玻璃的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我已经尝试了很多与一些玻璃状的图像，如下面的一个，我想到有一种方式，我可以把这个代码，所以我可以着色任何我想要的方式。它不需要看起来像下面的图像100％，但我想编写一些代码来绘制椭圆和玻璃效果（渐变与一些真正花哨的计算）。我必须清楚地注意到，我可怕的数学，我知道这需要一些棘手的公式。
我正在做的样本：
椭圆的边界是容易的部分，从上到下进入椭圆内的渐变也是相当容易的 - 但是当它使边缘褪色。
原始左侧图片：
/ p>
无论有人能给我一个很好的教程，或者如果有人想证明它，或者将是非常感激。
这里是我用来画到目前为止的程序：
/ 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; //基本RGB颜色值
TR，TG，TB：Byte; //工作RGB颜色值
开始
如果分配（B）则开始
如果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到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;
解决方案
所需成分：
真正有必要以小步骤来完成绘图任务，并将它们按正确的顺序排列。
在下面的代码中，我使用三个临时位图来达到最终目标：
- 一个内存位图，其中绘制了所有内容以减少闪烁，
- 需要帮助的临时位图，
我不喜欢代码中的注释，我期望它自己说：
单位GlassLabel;
接口
使用
类，控件，窗口，图形，数学;
const
DefTransparency = 30;
type
TPercentage = 0..100;
TGlassLabel = class（TGraphicControl）
private
FTransparency：TPercentage;
procedure SetTransparency（Value：TPercentage）;
protected
procedure Paint;覆盖;
public
constructor Create（AOwner：TComponent）;覆盖;
procedure SetBounds（ALeft，ATop，AWidth，AHeight：Integer）;覆盖;
已发布
property Caption;
property颜色;
property Font;
property透明度：TPercentage read FTransparency
write SetTransparency default DefTransparency;
end;
实现
类型
PTriVertex = ^ TTriVertex;
TTriVertex = record
X：DWORD;
Y：DWORD;
红色：WORD;
绿色：WORD;
蓝色：WORD;
Alpha：WORD;
end;
TRGB = record
R：Byte;
G：Byte;
B：Byte;
end;
函数GradientFill（DC：HDC;顶点：PTriVertex; NumVertex：ULONG;
网格：指针; NumMesh，模式：ULONG） stdcall;超载;
external msimg32 name'GradientFill';
function GradientFill（DC：HDC; const ARect：TRect; StartColor，
EndColor：TColor; Vertical：Boolean）：Boolean;超载;
const
模式：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））sh1 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;
结果：= 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
结果：= Base
else if Factor> = 1 then
结果：= 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）;
结果：= RGB（R，G，B）;
end;
end;
end;
function ColorWhiteness（C：TColor）：Single;
begin
结果：=（GetRValue（C）+ GetGValue（C）+ GetBValue（C））/ 255/3;
end;
function ColorBlackness（C：TColor）：Single;
begin
结果：= 1 - ColorWhiteness（C）;
end;
{TGlassLabel}
构造函数TGlassLabel.Create（AOwner：TComponent）;
begin
inherited Create（AOwner）;
ControlStyle：= [csOpaque];
FTransparency：= DefTransparency;
end;
procedure TGlassLabel.Paint;
const
DSTCOPY = $ 00AA0029;
DrawTextFlags = DT_CENTER或DT_END_ELLIPSIS或DT_SINGLELINE或DT_VCENTER;
var
W：Integer;
H：Integer;
BorderTop：Integer;
BorderBottom：Integer;
BorderSide：Integer;
Shadow：Integer;
R0：TRect; //控制边界
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;
l BlendFunc：TBlendFunction;
程序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;
程序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））;
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;
程序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;
程序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
MemCanvas.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;
过程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
如果HasParent和（Height> 1）then
begin
W：= Width;
H：=高度;
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：=界限（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;
无效;
end;
end;
end。
生成上述代码的示例代码（在后台放置 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;
Caption：='395天，22小时，0分钟，54秒';
父级：=自我;
end;
with TGlassLabel.Create（self）do
begin
SetBounds（40，40 + 119，550，60）;
颜色：= $ 00000097;
Caption：='0 Days，1 Hours，59 Minutes，31 Seconds';
父级：=自我;
end;
end;
根据需要调整。
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屋！
查看全文
