Delphi custom drawing - glowing glass - delphi

Question

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;

Answer 1

Ingredients needed:
AlphaBlend for the glassy effect,
GradientFill for the top gradient ellipse,
MaskBlt to 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.

Answer 2

First you need to draw some image. It can have gradients, transparency, etc. Then you will need to convert it to bitmap and for each pixel use GraphUtil.ColorRGBToHLS/ColorHLSToRGB functions. In your case you will need to change only hue of each pixel.