How do I make a more advanced graphic control?

unit JDGlassCommon;

interface

uses            
  Graphics, Windows, SysUtils;

const         
  DefTransparency = 0;

  //Error Codes for JDDrawGlass function
  JDGLASS_ERR_NOERROR =         0;
  JDGLASS_ERR_INVALIDHANDLE =   1;
  JDGLASS_ERR_INVALIDPARENT =   2;

type    
  TPercentage = 0..100;

  TGlassBorder = record
    Left: Integer;
    Top: Integer;
    Right: Integer;
    Bottom: Integer;
    Glow: Integer;
    Color: Integer;
  end;

  TGlassFont = record
    Charset: 0..255;
    Color: Integer;
    Height: Integer;
    Name: PChar;
    Pitch: 0..2;
    Size: Integer;
    Bold: Bool;
    Italic: Bool;
    Underline: Bool;
    StrikeOut: Bool;
  end;

  TGlassSettings = record
    Handle: HDC;          //Canvas handle
    ParentHandle: HWND;   //Parent's handle
    Left: Integer;        //Left-most position
    Top: Integer;         //Top-most position
    Right: Integer;       //Right-most position
    Bottom: Integer;      //Bottom-most position
    RndWidth: Integer;    //Rounded edge width
    RndHeight: Integer;   //Rounded edge height  
    BackColor: Integer;   //Color of background
    Transparency: 0..100; //Amount of transparency
    Text: PChar;          //Text displayed
    Border: TGlassBorder; //Border settings
    Font: TGlassFont;     //Font of text displayed
  end;

implementation
end.

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.

unit JDGlass;

interface

uses
  JDGlassCommon, Classes, SysUtils, Windows, Controls, Graphics, Math,
  Forms;

const
  GLASS_DLL_NAME = 'JDGlassLib.dll';

type
  TJDGlass = class;
  TJDGlassBorder = class;

  TJDGlass = class(TGraphicControl)
  private
    fBorder: TJDGlassBorder;
    fTransparency: TPercentage;
    fRaise3D: Integer;
    procedure SetTransparency(Value: TPercentage);
    function GetCaption: TCaption;
    procedure SetCaption(const Value: TCaption);
    function GetColor: TColor;
    procedure SetColor(const Value: TColor);
    procedure SetRaise3D(const Value: Integer);
    procedure SetBorder(const Value: TJDGlassBorder);
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  published
    property Border: TJDGlassBorder read fBorder write SetBorder;
    property Caption: TCaption read GetCaption write SetCaption;
    property Anchors;
    property Align;
    property ShowHint;
    property Color: TColor read GetColor write SetColor;
    property Font;
    property Transparency: TPercentage
      read fTransparency write SetTransparency default DefTransparency;
    property Raise3D: Integer read fRaise3D write SetRaise3D;
    property OnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

  TJDGlassBorder = class(TPersistent)
  private
    fOwner: TJDGlass;
    fGlow: Integer;
    fBottom: Integer;
    fLeft: Integer;
    fTop: Integer;
    fRight: Integer;
    fColor: TColor;
    fOnEvent: TNotifyEvent;
    fAuto: Bool;
    procedure SetBottom(const Value: Integer);
    procedure SetColor(const Value: TColor);
    procedure SetGlow(const Value: Integer);
    procedure SetLeft(const Value: Integer);
    procedure SetRight(const Value: Integer);
    procedure SetTop(const Value: Integer);
    function GetBottom: Integer;
    function GetLeft: Integer;
    function GetRight: Integer;
    function GetTop: Integer;
    procedure SetAuto(const Value: Bool);
  public
    constructor Create(AOwner: TJDGlass);
    destructor Destroy; override;
    procedure Event;
    procedure Assign(Source: TPersistent); override;
  published
    property Left: Integer read GetLeft write SetLeft default 3;
    property Top: Integer read GetTop write SetTop default 2;
    property Right: Integer read GetRight write SetRight default 3;
    property Bottom: Integer read GetBottom write SetBottom default 4;
    property Color: TColor read fColor write SetColor;
    property Glow: Integer read fGlow write SetGlow default 1;
    property OnEvent: TNotifyEvent read fOnEvent write fOnEvent; 
    property Auto: Bool read fAuto write SetAuto;
  end;
        
function JDDrawGlass(const GlassSettings: TGlassSettings): Integer;
  stdcall; external GLASS_DLL_NAME;

procedure Register;

implementation
                   
procedure Register;
begin
  RegisterComponents('JD Library', [TJDGlass]);
end;

{ TJDGlass }

constructor TJDGlass.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  fBorder:= TJDGlassBorder.Create(Self);
  ControlStyle:= [csOpaque];
  fTransparency:= DefTransparency;
  Color:= clBlue;
  Invalidate;
end;

destructor TJDGlass.Destroy;
begin                            
  FreeAndNil(fBorder);
  inherited;
end;

function TJDGlass.GetCaption: TCaption;
begin
  Result:= inherited Caption;
end;

function TJDGlass.GetColor: TColor;
begin
  Result:= inherited Color;
end;

procedure TJDGlass.Paint;
var
  EC: Integer;
  EM: String;
  S: TGlassSettings;
begin
  if Self.HasParent then begin
    S.Handle:= Self.Canvas.Handle;
    S.ParentHandle:= Self.Parent.Handle;
    S.Transparency:= fTransparency;
    S.Left:= 0;
    S.Top:= 0;
    S.Right:= Width;
    S.Bottom:= Height;
    S.RndWidth:= Height div 2;
    S.RndHeight:= Height div 2;
    S.BackColor:= Color;
    S.Border.Left:= fBorder.Left;
    S.Border.Top:= fBorder.Top;
    S.Border.Right:= fBorder.Right;
    S.Border.Bottom:= fBorder.Bottom;
    S.Border.Glow:= fBorder.Glow;
    S.Border.Color:= fBorder.Color;
    S.Text:= PChar(Self.Caption);
    S.Font.Charset:= Self.Font.Charset;
    S.Font.Color:= Self.Font.Color;
    S.Font.Height:= Self.Font.Height;
    S.Font.Name:= PChar(Self.Font.Name);
    S.Font.Pitch:= Integer(Self.Font.Pitch);
    S.Font.Size:= Self.Font.Size;
    S.Font.Bold:= (fsBold in Self.Font.Style);
    S.Font.Italic:= (fsItalic in Self.Font.Style);
    S.Font.Underline:= (fsUnderline in Self.Font.Style);
    S.Font.StrikeOut:= (fsStrikeOut in Self.Font.Style);
    EC:= JDDrawGlass(S);
    if EC <> JDGLASS_ERR_NOERROR then begin  
      case EC of
        JDGLASS_ERR_INVALIDHANDLE:      EM:= 'Invalid canvas handle'; 
        JDGLASS_ERR_INVALIDPARENT:      EM:= 'Invalid parent handle';
        else                            EM:= 'Unknown error';
      end;
      EM:= EM + ' (Error Code: '+IntToStr(EC)+')';
      raise Exception.Create(EM);
    end;
  end;
end;

procedure TJDGlass.SetBorder(const Value: TJDGlassBorder);
begin
  fBorder.Assign(Value);
  Invalidate;
end;

procedure TJDGlass.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if AWidth < AHeight then
    AWidth:= AHeight;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

procedure TJDGlass.SetCaption(const Value: TCaption);
begin
  if Value <> inherited Caption then begin
    inherited Caption:= Value;
    Invalidate;
  end;
end;

procedure TJDGlass.SetColor(const Value: TColor);
begin
  if Value <> inherited Color then begin
    inherited Color:= Value;
    Invalidate;
  end;
end;

procedure TJDGlass.SetRaise3D(const Value: Integer);
begin
  if Value <> fRaise3D then begin
    fRaise3D := Value;
    Invalidate;
  end;
end;

procedure TJDGlass.SetTransparency(Value: TPercentage);
begin
  if FTransparency <> Value then begin
    fTransparency:= Value;
    Invalidate;
  end;
end;

{ TJDGlassBorder }

procedure TJDGlassBorder.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  Event;
end;

constructor TJDGlassBorder.Create(AOwner: TJDGlass);
begin
  fOwner:= AOwner;
  fAuto:= True;
  fColor:= clBlack;
  fGlow:= 1;
  Event;
end;

destructor TJDGlassBorder.Destroy;
begin

  inherited;
end;

procedure TJDGlassBorder.Event;
begin
  if assigned(fOwner) then 
    if fOwner <> nil then
      fOwner.Invalidate;
  if assigned(fOnEvent) then
    fOnEvent(Self);
end;

function TJDGlassBorder.GetBottom: Integer;
begin       
  Result:= fBottom;
  if fAuto then begin
    if assigned(fOwner) then begin
      if fOwner <> nil then begin
        Result:= Max(2, fOwner.Height div 10);
        fBottom:= Result;
      end;
    end;
  end;
end;

function TJDGlassBorder.GetLeft: Integer;
begin       
  Result:= fLeft;
  if fAuto then begin
    if assigned(fOwner) then begin
      if fOwner <> nil then begin
        Result:= (Top + Bottom) div 2;
        fLeft:= Result;
      end;
    end;
  end;
end;

function TJDGlassBorder.GetRight: Integer;
begin         
  Result:= fRight;
  if fAuto then begin
    if assigned(fOwner) then begin
      if fOwner <> nil then begin
        Result:= (Top + Bottom) div 2;
        fRight:= Result;
      end;
    end;
  end;
end;

function TJDGlassBorder.GetTop: Integer;
begin   
  Result:= fTop;
  if fAuto then begin
    if assigned(fOwner) then begin
      if fOwner <> nil then begin
        Result:= Max(1, fOwner.Height div 30);
        fTop:= Result;
      end;
    end;
  end;
end;

procedure TJDGlassBorder.SetAuto(const Value: Bool);
begin
  fAuto := Value;
  Event;
end;

procedure TJDGlassBorder.SetBottom(const Value: Integer);
begin
  if Value <> fBottom then begin
    fAuto:= False;
    fBottom := Value;
    Event;
  end;
end;

procedure TJDGlassBorder.SetColor(const Value: TColor);
begin
  fColor := Value;  
  Event;
end;

procedure TJDGlassBorder.SetGlow(const Value: Integer);
begin
  fGlow := Value;  
  Event;
end;

procedure TJDGlassBorder.SetLeft(const Value: Integer);
begin    
  if Value <> fLeft then begin
    fAuto:= False;
    fLeft := Value;
    Event; 
  end;
end;

procedure TJDGlassBorder.SetRight(const Value: Integer);
begin
  if Value <> fRight then begin
    fAuto:= False;
    fRight := Value;
    Event;  
  end;
end;

procedure TJDGlassBorder.SetTop(const Value: Integer);
begin
  if Value <> fTop then begin
    fAuto:= False;
    fTop := Value;
    Event;
  end;
end;

end.