(************************************************************************
*    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 AHMTArrowButton;
interface

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

type
  TAHMDirection   = (dUp, dRight, dLeft, dDown);
  TAHMButtonRaise = 1..4;
  TAHMArrowButton = class(TAHMGraphicControl)
  private
    kDirection: TAHMDirection;
    fback : TAHMBackground;
    kButtonDown: boolean;
    kpnts   : array[1..3] of TPoint;
    FButtonBorder : TAHMButtonRaise;
    kRgn    : HRgn;
    fAHMGlyph : TAHMGlyph;
    procedure SetDirection(value: TAHMDirection);
    procedure Setback(value : TAHMBackground);
    procedure SetButtonBorder(Value : TAHMButtonRaise);
    procedure SetAHMGlyph(value : TAHMGlyph);
    procedure FreeRegion;
  protected
    procedure Paint; override;
    procedure DrawUpArrow; virtual;
    procedure DrawRightArrow; virtual;
    procedure DrawDownArrow; virtual;
    procedure DrawLeftArrow; virtual;
    procedure MoveButton; virtual;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
    procedure Notification(AComponent: TComponent;Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Background : TAHMBackground read fback write setback;
    property ButtonType: TAHMDirection read kDirection write SetDirection default dUp;
    property ButtonRaise : TAHMButtonRaise read FButtonBorder write SetButtonBorder default 1;
    property Glyph : TAHMGlyph read FAHMGlyph write SetAHMGlyph;
    property Enabled;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnClick;
  end;

implementation

const S_OFFSET = 2;

constructor TAHMArrowButton.Create(AOwner: TComponent);
begin
  FButtonBorder := 1;
  kDirection    := dUp;
  inherited Create(AOwner);
  FAHMGlyph      := TAHMGlyph.create(self);
  ControlStyle := [csClickEvents, csCaptureMouse];
  Width        := 52;
  Height       := 28;
  kRgn         := 0;
  kButtonDown  := False;
end;

destructor TAHMArrowButton.Destroy;
begin
  if fback<>nil then fback.OList.remove(self);
  if kRgn <> 0  then FreeRegion;
  FAHMGlyph.free;
  inherited Destroy;
end;

procedure TAHMArrowButton.SetAHMGlyph(value : TAHMGlyph);
begin
  FAHMGlyph.assign(value);
  invalidate;
end;

procedure TAHMArrowButton.Paint;
begin
  inherited Paint;
  FreeRegion;
  case kDirection of
    dUp    : DrawUpArrow;
    dRight : DrawRightArrow;
    dDown  : DrawDownArrow;
    dLeft  : DrawLeftArrow;
  end;
end;

procedure TAHMArrowButton.DrawUpArrow;
begin
  Canvas.Pen.width:=2;
  Canvas.Pen.Color := clBlack;
  kpnts[1] := Point(Width div 2, S_OFFSET);
  kpnts[2] := Point(Width - S_OFFSET, Height - S_OFFSET);
  kpnts[3] := Point(S_OFFSET, Height - S_OFFSET);
  kRgn := CreatePolygonRgn(kpnts, 3, ALTERNATE);
  Canvas.Brush.Color := clBlack;
  offsetrgn(krgn,2,2);
  FrameRgn(Canvas.Handle, kRgn, Canvas.Brush.Handle, 1, 1);
  offsetrgn(krgn,-2,-2);
  Canvas.Brush.Color := clwhite;
  Fillrgn(Canvas.Handle, kRgn, Canvas.Brush.Handle);
  if assigned(fback) then fback.drawtrans(Canvas,width,height,true,clwhite);
  FAHMGlyph.Draw(Canvas,round((width-fAHMGlyph.width)/2)+1,(height-fAHMGlyph.height)-FButtonBorder,Enabled,False,False);
  MoveButton;
end;

procedure TAHMArrowButton.DrawRightArrow;
begin
  Canvas.Pen.width:=2;
  Canvas.Pen.Color := clBlack;
  kpnts[1] := Point(S_OFFSET, S_OFFSET);
  kpnts[2] := Point(Width - S_OFFSET, Height div 2);
  kpnts[3] := Point(S_OFFSET, Height - S_OFFSET);
  kRgn := CreatePolygonRgn(kpnts, 3, ALTERNATE);
  Canvas.Brush.Color := clBlack;
  offsetrgn(krgn,2,2);
  FrameRgn(Canvas.Handle, kRgn, Canvas.Brush.Handle, 1, 1);
  offsetrgn(krgn,-2,-2);
  Canvas.Brush.Color := clwhite;
  Fillrgn(Canvas.Handle, kRgn, Canvas.Brush.Handle);
  if assigned(fback) then fback.drawTrans(Canvas,width,height,true,clwhite);
  FAHMGlyph.Draw(Canvas,FButtonBorder+2,round((height-fAHMGlyph.height)/2)+1,Enabled,False,False);
  MoveButton;
end;

procedure TAHMArrowButton.DrawDownArrow;
begin
  Canvas.Pen.width:=2;
  Canvas.Pen.Color := clBlack;
  kpnts[1] := Point(Width - S_OFFSET, S_OFFSET);
  kpnts[2] := Point(Width div 2, Height - S_OFFSET);
  kpnts[3] := Point(S_OFFSET, S_OFFSET);
  kRgn := CreatePolygonRgn(kpnts, 3, ALTERNATE);
  Canvas.Brush.Color := clBlack;
  offsetrgn(krgn,2,2);
  FrameRgn(Canvas.Handle, kRgn, Canvas.Brush.Handle, 1, 1);
  offsetrgn(krgn,-2,-2);
  Canvas.Brush.Color := clwhite;
  Fillrgn(Canvas.Handle, kRgn, Canvas.Brush.Handle);
  if assigned(fback) then fback.drawTrans(Canvas,width,height,true,clwhite);
  FAHMGlyph.Draw(Canvas,round((width-fAHMGlyph.width)/2)+1,FButtonBorder+2,Enabled,False,False);
  MoveButton;
end;

procedure TAHMArrowButton.DrawLeftArrow;
begin
  Canvas.Pen.width:=2;
  Canvas.Pen.Color := clBlack;
  kpnts[1] := Point(Width - S_OFFSET, S_OFFSET);
  kpnts[2] := Point(Width - S_OFFSET, Height - S_OFFSET);
  kpnts[3] := Point(S_OFFSET, Height div 2);
  kRgn := CreatePolygonRgn(kpnts, 3, ALTERNATE);
  Canvas.Brush.Color := clBlack;
  offsetrgn(krgn,2,2);
  FrameRgn(Canvas.Handle, kRgn, Canvas.Brush.Handle, 1, 1);
  offsetrgn(krgn,-2,-2);
  Canvas.Brush.Color := clwhite;
  Fillrgn(Canvas.Handle, kRgn, Canvas.Brush.Handle);
  if assigned(fback) then fback.drawTrans(Canvas,width,height,true,clwhite);
  FAHMGlyph.Draw(Canvas,(width-fAHMGlyph.width)-FButtonBorder+1,
      round((height-fAHMGlyph.height)/2)+1,Enabled,False,False);
 MoveButton;
end;

procedure TAHMArrowButton.MoveButton;
begin
  Canvas.Pen.width:=FButtonBorder;
  if not(kButtonDown) then
  with Canvas do
  begin
    Pen.Color := clBtnshadow;
    MoveTo(kpnts[1].X, kpnts[1].Y);
    LineTo(kpnts[2].X, kpnts[2].Y);
    MoveTo(kpnts[2].X, kpnts[2].Y);
    LineTo(kpnts[3].X, kpnts[3].Y);
    Pen.Color := clbtnhighlight;
    MoveTo(kpnts[1].X, kpnts[1].Y);
    LineTo(kpnts[3].X, kpnts[3].Y);
  end
  else
  with Canvas do
  begin
    Pen.Color := clBtnshadow;
    MoveTo(kpnts[1].X, kpnts[1].Y);
    LineTo(kpnts[3].X, kpnts[3].Y);
    Pen.Color := clbtnhighlight;
    MoveTo(kpnts[1].X, kpnts[1].Y);
    LineTo(kpnts[2].X, kpnts[2].Y);
    MoveTo(kpnts[2].X, kpnts[2].Y);
    LineTo(kpnts[3].X, kpnts[3].Y);
  end;
end;

procedure TAHMArrowButton.SetDirection(value: TAHMDirection);
begin
  if value <> kDirection then
  begin
    kDirection := value;
    Invalidate;
  end;
end;

procedure TAHMArrowButton.SetBack(Value: TAHMBackground);
begin
  if fback<>nil then fback.OList.remove(self);
  if value<>nil then value.additem(self);
  fback:=Value;
  invalidate;
end;

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


procedure TAHMArrowButton.SetButtonBorder(Value : TAHMButtonRaise);
begin
  FButtonBorder := Value;
  invalidate;
end;

procedure TAHMArrowButton.FreeRegion;
begin
  if kRgn <> 0 then DeleteObject(kRgn);
  kRgn := 0;
end;

procedure TAHMArrowButton.WMLButtonDown(var Message: TWMLButtonDown);
begin
  if not PtInRegion(kRgn, Message.xPos, Message.yPos) then Exit;
  kButtonDown := True;
  MoveButton;
  inherited;
end;

procedure TAHMArrowButton.WMLButtonUp(var Message: TWMLButtonUp);
begin
  if not kButtonDown then Exit;
  kButtonDown := False;
  MoveButton;
  inherited;
end;

end.
