{**************************************************************************}
{ TAdvSmoothButton component                                               }
{ for Delphi & C++Builder                                                  }
{ version 1.0                                                              }
{                                                                          }
{ written                                                                  }
{   TMS Software                                                           }
{   copyright © 2008                                                       }
{   Email : info@tmssoftware.com                                           }
{   Web : http://www.tmssoftware.com                                       }
{                                                                          }
{ The source code is given as is. The author is not responsible            }
{ for any possible damage done due to the use of this code.                }
{ The component can be freely used in any application. The complete        }
{ source code remains property of the author and may not be distributed,   }
{ published, given or sold in any form as such. No parts of the source     }
{ code can be included in any other component or application without       }
{ written authorization of the author.                                     }
{**************************************************************************}

unit AdvSmoothButton;

interface

{$I TMSDEFS.INC}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, 
  Math, AdvSmoothGDIP, AdvStyleIF;
  
const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 0; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.   

type
  TAdvSmoothButton = class(TCustomControl, ITMSStyle)
  private
    FColor: TColor;
    FDown: boolean;
    FCaption: string;
    FPicture: TAdvGDIPPicture;
    FBevel: boolean;
    FShadow: boolean;
    FBevelColor: TColor;
    procedure SetCaption(const Value: string);
    procedure SetColor(const Value: TColor);
    procedure SetPicture(const Value: TAdvGDIPPicture);
    procedure SetBevel(const Value: boolean);
    procedure SetShadow(const Value: boolean);
    procedure SetBevelColor(const Value: TColor);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;       
  protected
    procedure Paint; override;
    procedure PictureChanged(Sender: TObject);
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    function GetVersionNr: integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetComponentStyle(AStyle: TTMSStyle);
  published
    property Action;
    property Align;
    property Anchors;
    property Bevel: boolean read FBevel write SetBevel default true;
    property BevelColor: TColor read FBevelColor write SetBevelColor default clWhite;
    property Constraints;
    property Caption: string read FCaption write SetCaption;
    property Color: TColor read FColor write SetColor default clGray;
    property Font;
    property Picture: TAdvGDIPPicture read FPicture write SetPicture;
    property PopupMenu;
    property Shadow: boolean read FShadow write SetShadow default false;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property Version: string read GetVersion write SetVersion;        

    property OnMouseDown;
    property OnMouseUp;
    property OnMouseMove;
    property OnClick;
    property OnDblClick;

  end;

implementation

{ TAdvSmoothButton }

type  
  TWinCtrl = class(TWinControl)
  public
    procedure PaintCtrls(DC: HDC; First: TControl);
  end;

{$IFNDEF DELPHI6_LVL}
const
  Nan = -361.0;

function IsNan(d: double): boolean;
begin
  Result := (d = Nan);
end;
{$ENDIF}

type
  EColorError = class(Exception);

  THSVTriplet = record
    H,S,V: double;
  end;

  TRGBTriplet = record
    R,G,B: double;
  end;

procedure RGBToHSV (const R,G,B: Double; var H,S,V: Double);
var
  Delta: double;
  Min : double;
begin
  Min := MinValue( [R, G, B] );    
  V := MaxValue( [R, G, B] );

  Delta := V - Min;

  // Calculate saturation: saturation is 0 if r, g and b are all 0
  if V = 0.0 then
    S := 0
  else
    S := Delta / V;

  if (S = 0.0) then
    H := NaN    // Achromatic: When s = 0, h is undefined
  else
  begin       // Chromatic
    if (R = V) then
    // between yellow and magenta [degrees]
      H := 60.0 * (G - B) / Delta
    else
      if (G = V) then
       // between cyan and yellow
        H := 120.0 + 60.0 * (B - R) / Delta
      else
        if (B = V) then
        // between magenta and cyan
          H := 240.0 + 60.0 * (R - G) / Delta;

    if (H < 0.0) then
      H := H + 360.0
  end;
end; {RGBtoHSV}


procedure HSVtoRGB (const H,S,V: double; var R,G,B: double);
var
  f : double;
  i : INTEGER;
  hTemp: double; // since H is CONST parameter
  p,q,t: double;
begin
  if (S = 0.0) then    // color is on black-and-white center line
  begin
    if IsNaN(H) then
    begin
      R := V;           // achromatic: shades of gray
      G := V;
      B := V
    end
    else
      raise EColorError.Create('HSVtoRGB: S = 0 and H has a value');
  end
  else
  begin // chromatic color
    if (H = 360.0) then         // 360 degrees same as 0 degrees
      hTemp := 0.0
    else
      hTemp := H;

    hTemp := hTemp / 60;     // h is now IN [0,6)
    i := TRUNC(hTemp);        // largest integer <= h
    f := hTemp - i;                  // fractional part of h

    p := V * (1.0 - S);
    q := V * (1.0 - (S * f));
    t := V * (1.0 - (S * (1.0 - f)));

    case i of
      0: begin R := V; G := t;  B := p  end;
      1: begin R := q; G := V; B := p  end;
      2: begin R := p; G := V; B := t   end;
      3: begin R := p; G := q; B := V  end;
      4: begin R := t;  G := p; B := V  end;
      5: begin R := V; G := p; B := q  end;
    end;
  end;
end; {HSVtoRGB}


function CreateBubbleRectangleConcave(R: TRect; Radius, Delta: Integer): TGPGraphicsPath;
var
  l, t, w, h, d: Integer;
  rs: single;
  alpha1, alpha2: single;
  mid: tpoint;
  ar: tgprectf;
  ri: integer;
begin
  Result := TGPGraphicsPath.Create;
  
  l := R.Left;
  t := R.Top;
  w := R.Right - R.Left;
  h := R.Bottom - R.Top;
  d := Radius shl 1;

  rs := (sqr(w/2) + sqr(Delta)) / (2 * Delta);

  ri := round(rs);

  if (rs - Delta = 0) then
  begin
    alpha1 := 0;
    alpha2 := 180;
  end
  else
  begin
    alpha1 := 90 + RadToDeg(ArcTan( 1/2 * w / (rs - Delta)));
    alpha2 := 180 - alpha1;
  end;

  mid.x := l + w div 2;
  mid.y := t + h + Delta - round(rs);

  ar := MakeRect(mid.x - ri, mid.Y - ri - delta, ri * 2, ri * 2);

  Result.AddArc(ar, alpha1, alpha2 - alpha1);
  Result.AddLine(l + w, t + h - delta, l + w, t + 2 * h - radius); // right
  Result.AddArc(l + w - d,  t + 2 * h - d, d, d, 0, 90); // topleft
  Result.AddLine(l + w - radius, t + 2 * h, l + radius, t + 2 * h ); // right
  Result.AddArc(l,  t + 2 * h - d, d, d, 90, 90); // topleft
  Result.AddLine(l , t + 2 * h - radius, l , t + h - delta ); // right
  Result.CloseFigure();
end;

function CreateBubbleRectangleConvex(R: TRect; Radius, Delta: Integer): TGPGraphicsPath;
var
  l, t, w, h, d: Integer;
  rs: single;
  alpha1, alpha2: single;
  mid: tpoint;
  ar: tgprectf;
  ri: integer;
begin
  Result := TGPGraphicsPath.Create;
  l := R.Left;
  t := R.Top;
  w := R.Right - R.Left;
  h := R.Bottom - R.Top;
  d := Radius shl 1;

  rs := (sqr(w/2) + sqr(Delta)) / (2 * Delta);

  ri := round(rs);

  if (rs - Delta = 0) then
  begin
    alpha1 := 0;
    alpha2 := 180;
  end
  else
  begin
    alpha1 := 90 + RadToDeg(ArcTan( 1/2 * w / (rs - Delta)));
    alpha2 := 180 - alpha1;
  end;

  mid.x := l + w div 2;
  mid.y := t + h + Delta - round(rs);

  ar := MakeRect(mid.x - ri, mid.Y - ri - delta, ri*2, ri*2);

  Result.AddArc(l, t, d, d, 180, 90); // topleft
  Result.AddLine(l + radius, t, l + w - radius, t); // top
  Result.AddArc(l + w - d, t, d, d, 270, 90); // topright
  Result.AddLine(l + w, t + radius, l + w, t + h - delta); // right


  Result.AddArc(ar, alpha1, alpha2 - alpha1);
  Result.AddLine(l, t + h - delta, l, t + radius); // right

  Result.CloseFigure();
end;

function CreateRoundRectangle(R: TRect; Radius: Integer): TGPGraphicsPath;
var
  l, t, w, h, d: Integer;
begin
  Result := TGPGraphicsPath.Create;
  l := R.Left;
  t := R.Top;
  w := R.Right - R.Left;
  h := R.Bottom - R.Top;
  d := Radius shl 1;

  Result.AddArc(l, t + h div 2, d, d, 180, 90); // topleft
  Result.AddLine(l + radius, t +  h div 2, l + w - radius, t + h div 2); // top
  Result.AddArc(l + w - d, t + h div 2, d, d, 270, 90); // topright
  Result.AddLine(l + w, t + radius + h div 2, l + w, t + h - radius); // right
  Result.AddArc(l + w - d, t + h - d, d, d, 0, 90); // bottomright
  Result.AddLine(l + w - radius, t + h, l + radius, t + h); // bottom
  Result.AddArc(l, t + h - d, d, d, 90, 90); // bottomleft
  Result.AddLine(l, t + h - radius, l, t + radius +  h div 2); // left

  Result.CloseFigure();
end;

function CreateRoundLine(R: TRect; Radius: Integer): TGPGraphicsPath;
var
  l, t, w, h, d: Integer;
begin
  Result := TGPGraphicsPath.Create;
  l := R.Left;
  t := R.Top;
  w := R.Right - R.Left;
  h := R.Bottom - R.Top;
  d := Radius shl 1;

  Result.AddArc(l, t, d, d, 180, 90); // topleft
  Result.AddLine(l + radius, t, l + w - radius, t); // top
  Result.AddArc(l + w - d, t, d, d, 270, 90); // topright
  Result.AddLine(l + w, t + radius, l + w, t + h - radius); // right
  Result.AddArc(l + w - d, t + h - d, d, d, 0, 90); // bottomright
  Result.AddLine(l + w - radius, t + h, l + radius, t + h); // bottom
  Result.AddArc(l, t + h - d, d, d, 90, 90); // bottomleft
  Result.AddLine(l, t + h - radius, l, t + radius); // left

  InflateRect(r, -2, -2);

  l := R.Left;
  t := R.Top;
  w := R.Right - R.Left;
  h := R.Bottom - R.Top;
  d := Radius shl 1;

  Result.AddArc(l, t, d, d, 180, 90); // topleft
  Result.AddLine(l + radius, t, l + w - radius, t); // top
  Result.AddArc(l + w - d, t, d, d, 270, 90); // topright
  Result.AddLine(l + w, t + radius, l + w, t + h - radius); // right
  Result.AddArc(l + w - d, t + h - d, d, d, 0, 90); // bottomright
  Result.AddLine(l + w - radius, t + h, l + radius, t + h); // bottom
  Result.AddArc(l, t + h - d, d, d, 90, 90); // bottomleft
  Result.AddLine(l, t + h - radius, l, t + radius); // left
end;

function ChangeColor(Color: TColor; Delta: integer): TColor;
var
  r,g,b: longint;
  l: longint;
begin
  l := ColorToRGB(Color);
  b := ((l AND $FF0000) shr 16);
  g := ((l AND $FF00) shr 8);
  r := (l AND $FF);

  r := Max(0,Min(255,r + Delta));
  g := Max(0,Min(255,g + Delta));
  b := Max(0,Min(255,b + Delta));

//  r := round(Min(255,r * delta /100));
//  g := round(Min(255,g * delta /100));
//  b := round(Min(255,b * delta /100));

  Result := RGB(r,g,b);
end;

constructor TAdvSmoothButton.Create(AOwner: TComponent);
begin
  inherited;
  DoubleBuffered := true;
  FPicture := TAdvGDIPPicture.Create;
  FPicture.OnChange := PictureChanged;
  FColor := clGray;
  FBevel := true;
  FBevelColor := clWhite;
end;

destructor TAdvSmoothButton.Destroy;
begin
  FPicture.Free;
  inherited;
end;

function TAdvSmoothButton.GetVersion: string;
var
  vn: Integer;
begin
  vn := GetVersionNr;
  Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;

function TAdvSmoothButton.GetVersionNr: integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;
procedure TAdvSmoothButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  FDown := true;
  Invalidate;
end;

procedure TAdvSmoothButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  FDown := false;
  Invalidate;
end;

procedure TAdvSmoothButton.Paint;
var
  g: TGPGraphics;
  p: TGPGraphicsPath;
  b: TGPLinearGradientBrush;
  bs: TGPSolidBrush;
  delta: integer;
  ff: TGPFontFamily;
  fs: integer;
  f: TGPFont;
  stringformat: TGPStringFormat;
  l, t: integer;
  DrawColor: TColor;
  colors : array[0..3] of TGPColor;
  positions: array[0..3] of single;
  ph: integer;
  fHSV: THSVTriplet;
  fRGB: TRGBTriplet;

begin

  g := TGPGraphics.Create(Canvas.Handle);

  g.SetSmoothingMode(SmoothingModeAntiAlias);

  if FDown then
  begin
    fRGB.R := GetRed(Color);
    fRGB.G := GetGreen(Color);
    fRGB.B := GetBlue(Color);
    RGBToHSV(fRGB.B, fRGB.G, fRGB.R, fHSV.H, fHSV.S, fHSV.V);
    fHSV.V := 0.8 * fHSV.V;
    HSVToRGB(fHSV.H, fHSV.S, fHSV.V, fRGB.R, fRGB.G, fRGB.B);
    DrawColor := RGB(Round(fRGB.R), Round(fRGB.G), Round(fRGB.B));
  end
  else
    DrawColor := Color;

  ph := Height;

  if Shadow then
  begin
    bs := TGPSolidBrush.Create(ColorToARGB(clBlack));
    p := CreateRoundRectangle(Rect(2,2,Width - 3, Height - 1), 4);
    ph := Height - 2;
    g.FillPath(bs, p);
    bs.Free;
    p.Free;
  end;

  delta := ph div 6;

  bs := TGPSolidBrush.Create(ColorToARGB(ChangeColor(DrawColor,-40)));
  p := TGPGraphicsPath.Create;
  p.AddRectangle(MakeRect(0,ph div 2 - delta,Width - 1,  delta * 2));
  g.FillPath(bs, p);
  bs.Free;
  p.Free;

  p := CreateBubbleRectangleConcave(Rect(0,0,Width - 1, (ph div 2)), 8, delta);

  b := TGPLinearGradientBrush.Create(MakeRect(0,(ph div 2) - delta,Width - 1, (ph div 2) + delta ), ColorToARGB(ChangeColor(DrawColor,-40)), ColorToARGB(ChangeColor(DrawColor,180)),LinearGradientModeVertical);

  b.SetGammaCorrection(true);

  colors[0] := ColorToARGB(ChangeColor(DrawColor,-40));
  colors[1] := ColorToARGB(ChangeColor(DrawColor,100));
  colors[2] := ColorToARGB(ChangeColor(DrawColor,220));
  positions[0] := 0;
  positions[1] := 0.9;
  positions[2] := 1;

  b.SetInterpolationColors(@colors,@positions,3);

  g.FillPath(b,p);

  b.Free;
  p.Free;

  p := CreateBubbleRectangleConvex(Rect(0,0,Width - 1, (ph div 2)), 8, delta);

  b := TGPLinearGradientBrush.Create(MakeRect(0,0,Width - 1, (ph div 2)+ 1) , ColorToARGB(ChangeColor(DrawColor,180)), ColorToARGB(DrawColor),LinearGradientModeVertical);
  b.SetGammaCorrection(true);

  colors[0] := ColorToARGB(ChangeColor(DrawColor,220));
  colors[1] := ColorToARGB(ChangeColor(DrawColor,100));
  colors[2] := ColorToARGB(DrawColor);
  positions[0] := 0;
  positions[1] := 0.2;
  positions[2] := 1;

  b.SetInterpolationColors(@colors,@positions,3);

  g.FillPath(b,p);

  b.Free;
  p.Free;

  if Bevel then
  begin
    p := CreateRoundLine(Rect(0,1,Width - 1, ph -1), 7);
    bs := TGPSolidBrush.Create(MakeColor(160,BevelColor));
    g.FillPath(bs,p);
    bs.Free;
    p.Free;
  end;

  ////Button Caption///
  if Caption <> '' then
  begin
    ff := TGPFontFamily.Create(Font.Name);

    fs := 0;
    if (fsBold in Font.Style) then
      fs := fs + 1;
    if (fsItalic in Font.Style) then
      fs := fs + 2;
    if (fsUnderline in Font.Style) then
      fs := fs + 4;

    stringformat := TGPStringFormat.Create;

    stringformat.SetAlignment(StringAlignmentCenter);
    stringformat.SetLineAlignment(StringAlignmentCenter);

    g.SetTextRenderingHint(TextRenderingHintClearTypeGridFit);

    f := TGPFont.Create(ff, Font.Size , fs, UnitPoint);

    bs := TGPSolidBrush.Create(ColorToARGB(Font.Color));

    if FDown then
      g.DrawString(Caption, Length(Caption), f, MakeRect(1,1,Width,ph), stringformat, bs)
    else
    g.DrawString(Caption, Length(Caption), f, MakeRect(0,0,Width,ph), stringformat, bs);

    bs.Free;
    f.Free;
    ff.Free;
  end;

  if not FPicture.Empty then
  begin
    FPicture.GetImageSizes;
    l := (Width - FPicture.Width) div 2;
    t := (ph - FPicture.Height) div 2;
    if FDown then
    begin
      l := l + 2;
      t := t + 2;
    end;
    FPicture.GDIPDraw(g, Rect(l,t, l + FPicture.Width, t + FPicture.Height));
  end;

  g.Free;
end;

procedure TAdvSmoothButton.PictureChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TAdvSmoothButton.SetBevel(const Value: boolean);
begin
  if (FBevel <> Value) then
  begin
    FBevel := Value;
    Invalidate;
  end;

end;

procedure TAdvSmoothButton.SetBevelColor(const Value: TColor);
begin
  if (FBevelColor <> Value) then
  begin
    FBevelColor := Value;
    Invalidate;
  end;
end;

procedure TAdvSmoothButton.SetCaption(const Value: string);
begin
  if (FCaption <> Value) then
  begin
    FCaption := Value;
    Invalidate;
  end;
end;

procedure TAdvSmoothButton.SetColor(const Value: TColor);
begin
  if (FColor <> Value) then
  begin
    FColor := Value;
    Invalidate;
  end;
end;

procedure TAdvSmoothButton.SetComponentStyle(AStyle: TTMSStyle);
begin
  // TODO : do color settings here
  case astyle of
    tsOffice2003Blue:
      Color := $00E3B28D;
    tsOffice2003Silver:
      Color := $00927476;
    tsOffice2003Olive:
      Color := $447A63; //08CC0B1; 006B7760;
    tsOffice2003Classic:
      Color := $00C9D1D5;
    tsOffice2007Luna:
      Color := $00FDEADA;
    tsOffice2007Obsidian:
      Color := $006E6E6D;
    tsWindowsXP:
      Color := $B9D8DC;
    tsWhidbey:
      Color := $00828F92;
    tsCustom: ;
    tsOffice2007Silver:
      Color := $00E7DCD5;
  end;
end;

procedure TAdvSmoothButton.SetPicture(const Value: TAdvGDIPPicture);
begin
  FPicture.Assign(Value);
end;

procedure TAdvSmoothButton.SetShadow(const Value: boolean);
begin
  if (FShadow <> Value) then
  begin
    FShadow := Value;
    Invalidate;
  end;
end;

procedure TAdvSmoothButton.SetVersion(const Value: string);
begin
end;

procedure TAdvSmoothButton.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TAdvSmoothButton.WMPaint(var Message: TWMPaint);
var
  DC, MemDC: HDC;
  MemBitmap, OldBitmap: HBITMAP;
  PS: TPaintStruct;
  dbl: boolean;
  p: TPoint;
  i: integer;
begin
  if Assigned(Parent) {and (Fill.ShadowOffset > 0) ?} then
  begin
    dbl := Parent.DoubleBuffered;
    Parent.DoubleBuffered := false;
    DC := Message.DC;
    i := SaveDC(DC);
    p := ClientOrigin;
    Windows.ScreenToClient(Parent.Handle, p);
    p.x := -p.x;
    p.y := -p.y;
    MoveWindowOrg(DC, p.x, p.y);
    SendMessage(Parent.Handle, WM_ERASEBKGND, DC, 0);
    SendMessage(Parent.Handle, WM_PAINT, DC, 0);
    if (Parent is TWinCtrl) then
      (Parent as TWinCtrl).PaintCtrls(DC, nil);
    RestoreDC(DC, i);
    Parent.DoubleBuffered := dbl;
  end;

  if not FDoubleBuffered or (Message.DC <> 0) then
  begin
    if not (csCustomPaint in ControlState) and (ControlCount = 0) then
      inherited
    else
      PaintHandler(Message);
  end
  else
  begin
    DC := GetDC(0);
    MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom);
    ReleaseDC(0, DC);
    MemDC := CreateCompatibleDC(0);
    OldBitmap := SelectObject(MemDC, MemBitmap);
    try
      DC := BeginPaint(Handle, PS);
      Perform(WM_ERASEBKGND, MemDC, MemDC);
      Message.DC := MemDC;
      WMPaint(Message);
      Message.DC := 0;
      BitBlt(DC, 0, 0, ClientRect.Right, ClientRect.Bottom, MemDC, 0, 0, SRCCOPY);
      EndPaint(Handle, PS);
    finally
      SelectObject(MemDC, OldBitmap);
      DeleteDC(MemDC);
      DeleteObject(MemBitmap);
    end;
  end;
end;

{ TWinCtrl }

procedure TWinCtrl.PaintCtrls(DC: HDC; First: TControl);
begin
  PaintControls(DC, First);
end;

{$IFDEF FREEWARE}
{$I TRIAL.INC}
{$ENDIF}


end.
