(************************************************************************
*    This File is Part of the AHM Triton Tools                          *
*    for Borland Delphi and C++ Builder.                                *
*************************************************************************
* Copyright © 1995-1999 Alexander H. Mehlhorn (AHM) and Tritontools.com *
* All Rights reserved.                                                  *
*                                                                       *
*    For more Information contact us at                                 *
*    E-Mail : support@tritontools.com                                   *
*    URL : http://www.tritontools.com                                   *
*                                                                       *
*    AHM is copyright by Alexander H. Mehlhorn                          *
*    All Parts of this Collection were developed,                       *
*    designed and implemented by AHM                                    *
*                                                                       *
*    Under no Circumstances may you distribute this file                *
*    in this or any other format. This File is supplied                 *
*    as Evaluation of Source only. No Delphi Components may be developed*
*    using extracts or subsets of this code without expressed permission*
*    by AHM.                                                            *
*                                                                       *
*************************************************************************)
unit AHMTRoundButton;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics,Controls,
  AHMEnhancedClass,AHMTBackground,AHMControls;

const
  DefaultWidth = 40;
  DefaultHeight = 40;

type
  TAHMButtonType         = (btNormal,btInset);
  TAHMRoundButton = class(TAHMGraphicControl)
  private
    FDown:             boolean;
    fback : TAHMBackground;
    FMouseDown:        boolean;
    FMouseInside:      boolean;
    fAHMGlyph :TAHMGlyph;
    fun : TColor;
    FOnClick:          TNotifyEvent;
    FRoundBType:       TAHMButtonType;
    FOnMouseEnter:     TNotifyEvent;
    FOnMouseExit:      TNotifyEvent;
    procedure SetRButtonType(newRButtonType: TAHMButtonType);
    procedure SetBack(value : TAHMBackground);
    procedure SetAHMGlyph(value : TAHMGlyph);
    procedure SetUn(Value : TColor);
  protected
    procedure Paint;  override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    function  IsInsideButton(X,Y: Integer): boolean;
    procedure PaintButton;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ButtonType: TAHMButtonType read FRoundBType write SetRButtonType default btNormal;
    property Glyph : TAHMGlyph read fAHMGlyph write SetAHMGlyph;
    property UnUsedColor : TColor read fun write Setun default clLime;
    property Enabled;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnClick:   TNotifyEvent read FOnClick write FOnClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property Background : TAHMBackground read fback write Setback;
    property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
    property OnMouseExit:  TNotifyEvent read FOnMouseExit  write FOnMouseExit;
  end;

implementation

constructor TAHMRoundButton.Create(AOwner: TComponent);
begin
   inherited Create(AOwner);
   Width:=  25;
   Height:= 25;
   fAHMGlyph:=TAHMGlyph.create(self);
   ControlStyle:=[csClickEvents,csCaptureMouse];
   FDown:=  False;
   FMouseInside:= False;
   FMouseDown:= False;
   fun:=cllime;
end;

procedure TAHMRoundButton.Notification(AComponent: TComponent;Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and  (AComponent = Background) then SetBack(nil);
end;

destructor  TAHMRoundButton.Destroy;
begin
  if fback<>nil then fback.OList.remove(self);
  fAHMGlyph.free;
  inherited Destroy;
end;

procedure TAHMRoundButton.SetAHMGlyph(value : TAHMGlyph);
begin
  fAHMGlyph.assign(value);
  Invalidate;
end;

procedure TAHMRoundButton.Setback(Value : TAHMBackground);
begin
  if fback<>nil then fback.OList.remove(self);
  if value<>nil then value.additem(self);
  fback:=value;
  Invalidate;
end;


procedure TAHMRoundButton.Setun(Value : TColor);
begin
  fun:=value;
  Invalidate;
end;


procedure TAHMRoundButton.SetRButtonType(newRButtonType: TAHMButtonType);
begin
  FRoundBType:= newRButtonType;
  Invalidate;
end;


function TAHMRoundButton.IsInsideButton(X,Y: Integer): boolean;
var
   Hypotonuse: integer;
begin
   X:= Abs((Width shr 1) - X);
   Y:= Abs((Height shr 1) - Y);
   Hypotonuse:= Round(Sqrt(Abs((X * X) + (Y * Y))));
   Result:= (Hypotonuse <= (Width shr 1)-1);
end;

procedure TAHMRoundButton.Paint;
var fbitback,fbitfore : TBitmap;
begin
  fbitback:=TBitmap.create;
  fbitback.width:=width;
  fbitback.height:=height;
  fbitfore:=TBitmap.create;
  fbitfore.width:=width;
  fbitfore.height:=height;
  fbitfore.canvas.copyrect(Clientrect,canvas,clientrect);
  if assigned(fback) then fback.draw(fbitback.canvas.Handle,width,height,true);
  with fbitfore.Canvas do
  begin                                   { draw top left edge }
    brush.color:= fun;
    pen.width:=1;
    case FRoundBType of
       btNormal:
       begin
         pen.color:= clBlack;
         Ellipse(0,0,width-1,height-1);
       end;
       btInset:
       begin
         pen.color:= fun;
         Ellipse(1,1,width-2,height-2);
         pen.color:= clBtnShadow;
         Arc(0,0,width-1,height-1,width div 5 * 4,height div 5,width div 5,height div 5 * 4);
         pen.color:= clBtnHighlight;
         Arc(0,0,width-1,height-1,width div 5,height div 5 * 4,width div 5 * 4,height div 5);
       end;
     end;
   end;
   AHMDrawTransParentBitmap(fbitback.canvas,fbitfore,0,0,fun);
   Canvas.copyrect(clientrect,fbitback.canvas,clientrect);
   PaintButton;
   FAHMGlyph.Draw(Canvas,round((fbitfore.width-fAHMGlyph.width)/2),
             Round((fbitfore.height-fAHMGlyph.height)/2)-1,Enabled,FDown,False);
   fbitback.free;
   fbitfore.free;
end;

procedure TAHMRoundButton.PaintButton;
begin
   Canvas.pen.width:=1;
   with Canvas do
   begin                                   { draw top left edge }
      if FDown then  pen.color:= clBtnShadow else pen.color:= clBtnHighlight;
      Arc(1,1,width-2,height-2,width div 5 * 4,height div 5,width div 5,height div 5 * 4);
      if Not FDown then  pen.color:= clBtnShadow else pen.color:= clBtnHighlight;
      Arc(1,1,width-2,height-2,width div 5,height div 5 * 4,width div 5 * 4,height div 5);
   end;
end;

procedure TAHMRoundButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if (Enabled and IsInsideButton(X,Y)) then
   begin
      FDown:= True;
      PaintButton;
   end;
   FMouseDown:= True;
end;

procedure TAHMRoundButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
   if (Enabled and IsInsideButton(X,Y)) then
   begin
      FDown:= False;
      PaintButton;
      if Assigned(FOnClick) then
         FOnClick(Self);
   end;
   FMouseDown:= False;
end;

procedure TAHMRoundButton.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
   if FMouseDown then
   begin
      if Not IsInsideButton(X,Y) then
      begin
         if FDown then
         begin
            FDown:= False;
            PaintButton;
         end;
      end
      else
      begin
         if Not FDown then
         begin
            FDown:= True;
            PaintButton;
         end;
      end;
   end;
end;

end.
