Delphi custom drawing - luminous glass

Question

I experimented a lot with some glass images, such as below, and I thought that there should be a way that I can put this in code, so I can color it no matter what I want. It doesn’t need to be looked at 100% in the same way as in the image below, but I would like to write code to draw an oval and glass effect (gradient with some really fancy calculations). I must clearly note that I am terrible with math, and I know that this requires some complex formulas.

An example 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 quite simple - but when it comes to the edges fading out to make this glassy view from above and sides - I have no idea how to do this.

Image of the original left edge:

Can someone point me to a good tutorial for this, or if someone wants to demonstrate this, then it will be really appreciated.

Here is the procedure that I use for drawing 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

Essential Ingredients:

• AlphaBlend for a glass effect,
• GradientFill for an ellipse of the upper gradient,
• MaskBlt to exclude non-rectangular parts already drawn when drawing,
• indeed, math is pretty easy.

In fact, you need to deploy the task of drawing in small steps and place them in the correct order. Then it is not as impossible as it might seem at first glance.

In the code below, I use three temporary bitmaps to achieve the final goal:

• a bitmap image of memory, on which everything is done to reduce flicker,
• temporary bitmap needed to help,
• bitmap image of the mask to store the cropping shape.

I don't like the comments in the code, but I expect this to speak 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 create above (put the 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; 

Choose as you like.

Answer 2

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