library JDGlassLib;
uses
SysUtils,
Classes,
Windows,
Graphics,
Math,
JDGlassCommon in 'JDGlassCommon.pas';
{$R *.res}
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;
// MAIN DRAWING FUNCTION
//--------------------------------------------------------------------------
function JDDrawGlass(const GlassSettings: TGlassSettings): Integer; stdcall;
const
DSTCOPY = $00AA0029;
var
DrawTextFlags: UINT;
C: TCanvas;
S: TGlassSettings;
W: Integer;
H: 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;
function Font: TFont;
begin
Result:= C.Font;
end;
procedure PrepareFonts;
begin
Font.Charset:= S.Font.Charset;
Font.Color:= S.Font.Color;
Font.Height:= S.Font.Height;
Font.Name:= S.Font.Name;
Font.Pitch:= TFontPitch(S.Font.Pitch);
Font.Size:= S.Font.Size;
Font.Style:= [];
if S.Font.Bold then Font.Style:= Font.Style + [fsBold];
if S.Font.Italic then Font.Style:= Font.Style + [fsItalic];
if S.Font.Underline then Font.Style:= Font.Style + [fsUnderline];
if S.Font.StrikeOut then Font.Style:= Font.Style + [fsStrikeOut];
end;
procedure PrepareBitmaps;
begin
Tmp.Width := W;
Tmp.Height := H;
Mem.Canvas.Brush.Color := S.BackColor;
Mem.Width := W;
Mem.Height := H;
Mem.Canvas.Brush.Style := bsClear;
Msk.Width := W;
Msk.Height := H;
Msk.Monochrome := True; //False???
end;
procedure PrepareMask(R: TRect);
var
Radius: Integer;
begin
Radius := (R.Bottom - R.Top) div 2;
Msk.Canvas.Brush.Color := clBlack; //fBorder.Color???
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
JDGlassLib.GradientFill(
Tmp.Canvas.Handle,
R2,
MixColor(S.BackColor, clWhite, 1.0),
MixColor(S.BackColor, 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 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(S.Text), -1, R3, DrawTextFlags);
OffsetRect(R3, -Shadow, Shadow);
Mem.Canvas.Font.Color := Font.Color;
DrawText(Mem.Canvas.Handle, PChar(S.Text), -1, R3, DrawTextFlags);
end;
procedure DrawBorderAlias;
begin
Mem.Canvas.Pen.Color:= S.Border.Color; //MixColor(Color, fBorderColor, 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, S.Left, S.Top, SRCCOPY);
BlendFunc.BlendOp := AC_SRC_OVER;
BlendFunc.BlendFlags := 0;
BlendFunc.SourceConstantAlpha := Round(S.Transparency * 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
Result:= JDGLASS_ERR_NOERROR;
try
S:= GlassSettings;
C:= TCanvas.Create;
try
C.Handle:= GlassSettings.Handle;
if C.Handle <> 0 then begin
//Need to check for WordWrap and Align properties
DrawTextFlags:= DT_CENTER or DT_END_ELLIPSIS or DT_SINGLELINE or DT_VCENTER;
W:= S.Right - S.Left;
H:= S.Bottom - S.Top;
Shadow:= C.Font.Size div 8;
R0:= Rect(S.Left, S.Top, S.Right, S.Bottom);
R1:= Rect(S.Border.Left, S.Border.Top, W - S.Border.Right, H - S.Border.Bottom);
R2:= Rect(R1.Left + S.Border.Left + 1, R1.Top, R1.Right - S.Border.Right - 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(S.ParentHandle);
Tmp:= TBitmap.Create;
Mem:= TBitmap.Create;
Msk:= TBitmap.Create;
try
PrepareFonts;
PrepareBitmaps;
DrawTopGradientEllipse;
DrawCaption;
DrawBorderAlias;
DrawBorder;
DrawCombineParent;
BitBlt(C.Handle, 0, 0, W, H, Mem.Canvas.Handle, 0, 0, SRCCOPY);
finally
Msk.Free;
Mem.Free;
Tmp.Free;
ReleaseDC(S.ParentHandle, ParentDC);
end;
end else begin
Result:= JDGLASS_ERR_INVALIDHANDLE;
raise Exception.Create('Invalid canvas handle');
end;
finally
C.Free;
end;
except
on e: exception do begin
if Result = 0 then Result:= -1;
end;
end;
end;
exports
JDDrawGlass;
begin
end.