(************************************************************************
*    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 AHMTIEButton;
interface
{$I AHM.INC}
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     Menus, ExtCtrls,AHMEnhancedClass,AHMControls;

type
 TAHMButtonOption  = (opMonoDisplay,opMenuArrow,opTextonly,opBitmapOnly);
 TAHMButtonOptions = set of TAHMButtonOption;
 TAHMButtonKind = (bk97,bkNormal,bkDeep);
 TAHMIEButton = class(TAHMGraphicControl)
 private
   Fdesframe : Boolean;
   FAllowAllUp: Boolean;
   FAHMGlyph : TAHMGlyph;
   FDown: Boolean;
   fbevlooks : TAHMButtonKind;
   FDropDown: TPopupMenu;
   FEnabled: Boolean;
   FGroupIndex: Integer;
   FLayout: TAHMPosition;
   FOptions: TAHMButtonOptions;
   Pushed, MouseIn: Boolean;
   FOnRightMouseDown : TNotifyEvent;
   f3ds : TAHMFont3D;
   procedure GlyphChange(Sender : TObject);
  protected
   procedure Set3Ds(value : TAHMFont3D);
   procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
   procedure DrawPopupMark(x, y: Integer);
   procedure GetLost;
   procedure Notification(AComponent: TComponent; Operation: TOperation); override ;
   procedure Paint; override;
   procedure SetAllowAllUp(value: Boolean);
   procedure SetAHMGlyph(value: TAHMGlyph);
   procedure Setcaption(const value : TCaption);
   function getcaption:TCaption;
   procedure SetBevelLooks(value : TAHMButtonKind);
   procedure SetDown(value: Boolean);
   procedure SetDropDown(value: TPopupMenu);
   procedure Setdesframe(value : Boolean);
   procedure SetEnabled(value: Boolean);{$IFDEF AHMINPRISE4} override; {$ENDIF}
   procedure SetGroupIndex(value: Integer);
   procedure SetLayout(value: TAHMPosition);
   procedure SetOptions(value: TAHMButtonOptions);
   procedure WMRButtonUp(var msg: TWMRButtonUp); message WM_RBUTTONUP;
   procedure WMLButtonDown(var msg: TWMLButtonDown); message WM_LBUTTONDOWN;
   procedure WMRButtonDown(var msg: TWMRButtonDown); message WM_RBUTTONDOWN;
   procedure WMLButtonUp(var msg: TWMLButtonUp); message WM_LBUTTONUP;
   procedure WMMouseMove(var msg: TWMMouseMove); message WM_MOUSEMOVE;
  public
   constructor Create(aOwner: TComponent); override;
   destructor Destroy; override;
  published
   property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp stored True default False;
   property Glyph: TAHMGlyph read FAHMGlyph write SetAHMGlyph stored True;
   property DesignTimeFrame : Boolean read fdesframe write Setdesframe default True;
   property GroupIndex: Integer read FGroupIndex write SetGroupIndex stored True default 0;
   property Down: Boolean read FDown write SetDown stored True default False;
   property DropDownMenu: TPopupMenu read FDropDown write SetDropDown stored True;
   property Enabled: Boolean read FEnabled write SetEnabled default True;
   property Layout: TAHMPosition read FLayout write SetLayout stored True default pTop;
   property Options: TAHMButtonOptions read FOptions write SetOptions stored True default [opMonoDisplay, opMenuArrow];
   Property BevelLooks : TAHMButtonKind read fbevlooks write SetBevelLooks default bk97;
   property Font3D : TAHMFont3D read f3ds write Set3ds;
   property Caption : TCaption read GetCaption write Setcaption;
   property Font;
   property Hint;
   property OnClick;
   property OnMouseDown;
   Property OnMouseUp;
   property OnRightMouseDown : TNotifyevent read FOnRightMouseDown write FOnRightMouseDown;
   Property OnMouseMove;
   property ParentFont;
   property ParentShowHint;
   property ShowHint;
   property Visible;
  end;

implementation

procedure TAHMIEButton.Setcaption(const value : TCaption);
begin
  if GetCaption <> Value then SetTextBuf(PChar(Value));
  Invalidate;
end;

Function TAHMIEButton.Getcaption:TCaption;
var
  Len: Integer;
begin
  Len := GetTextLen;
  SetString(Result, PChar(nil), Len);
  if Len <> 0 then GetTextBuf(Pointer(Result), Len + 1);
end;

constructor TAHMIEButton.Create(aOwner: TComponent);
begin
  FEnabled := True;
  FDesFrame:=True;
  FDropDown := nil;
  FLayout := pTop;
  FAllowAllUp := False;
  FDown := False;
  FGroupIndex := 0;
  FOptions := [opMonoDisplay,opMenuArrow];
  FBevLooks:=bk97;
  inherited Create(aOwner);
  if csdesigning in Componentstate then fdesframe:=true else fdesframe:=false;
  f3ds:=TAHMFont3D.create(self);
  FAHMGlyph := TAHMGlyph.Create(Self);
  ControlStyle := [csClickEvents, csCaptureMouse, csSetCaption];
  Pushed := False;
  MouseIn := False;
  Width := 80;
  Height := 21;
  FAHMGlyph.OnChange:=GlyphChange;
end;

procedure TAHMIEButton.GlyphChange(Sender : TObject);
begin
  Invalidate;
end;

destructor TAHMIEButton.Destroy;
begin
  f3ds.free;
  FAHMGlyph.OnChange:=nil;
  FAHMGlyph.free;
  inherited Destroy;
end;

procedure TAHMIEButton.SetDesframe(value : Boolean);
begin
  fdesframe:=value;
  invalidate;
end;

procedure TAHMIEButton.SetBevelLooks(value : TAHMButtonKind);
begin
  if value<>fbevlooks then
  begin
    fbevlooks:=value;
    invalidate;
  end;
end;

procedure TAHMIEButton.set3Ds(value : TAHMFont3D);
begin
  f3ds:=value;
  invalidate;
end;


procedure TAHMIEButton.CMDialogChar(var Message: TCMDialogChar);
var lpPoint : TPoint;
begin
  with Message do
  if IsAccel(CharCode, Caption) and Enabled and Visible then
  begin
    MouseIn := True;
    Pushed := False;
    Invalidate;
    Application.ProcessMessages;
    WMLButtonDown( TWMLBUTTONDOWN(Message));
    Application.ProcessMessages;
    WMLButtonUp(TWMLBUTTONUP(Message));
    Application.ProcessMessages;
    GetCursorPos(lpPoint);
    lpPoint := GetParentForm(self).ScreenToClient(lpPoint);
    if not ((lpPoint.y > top) and (lpPoint.y < top + height)
   		and (lpPoint.x > left) and (lpPoint.x < left + width)) then
    begin
      MouseIn := False;
      Invalidate;
    end;
    Result := 1;
  end;
end;

procedure TAHMIEButton.DrawPopupMark(x, y: Integer);
var theColor: TColor;
begin
   theColor := Canvas.Font.Color;
   Canvas.Pixels[x    , y - 1] := theColor;
   Canvas.Pixels[x + 1, y - 1] := theColor;
   Canvas.Pixels[x + 2, y - 1] := theColor;
   Canvas.Pixels[x + 3, y - 1] := theColor;
   Canvas.Pixels[x + 4, y - 1] := theColor;
   Canvas.Pixels[x + 5, y - 1] := theColor;
   Canvas.Pixels[x + 6, y - 1] := theColor;
   Canvas.Pixels[x + 1, y    ] := theColor;
   Canvas.Pixels[x + 2, y    ] := theColor;
   Canvas.Pixels[x + 3, y    ] := theColor;
   Canvas.Pixels[x + 4, y    ] := theColor;
   Canvas.Pixels[x + 5, y    ] := theColor;
   Canvas.Pixels[x + 2, y + 1] := theColor;
   Canvas.Pixels[x + 3, y + 1] := theColor;
   Canvas.Pixels[x + 4, y + 1] := theColor;
   Canvas.Pixels[x + 3, y + 2] := theColor;
end;

procedure TAHMIEButton.GetLost;
begin
  if FGroupIndex = 0 then FDown := False;
  Pushed := False;
  MouseIn := False;
  Invalidate;
end;

procedure TAHMIEButton.Notification(AComponent: TComponent; Operation:TOperation);
begin
  if (Operation = opRemove) and (AComponent = FDropDown) then FDropDown := nil ;
end ;

procedure TAHMIEButton.Paint;
var X1,X2,Y1 : integer;
begin
  canvas.brush.style:=bsclear;
  Canvas.pen.width:=1;
  canvas.pen.color:=clblack;
  if (csdesigning in componentstate) and fdesframe then canvas.rectangle(0,0,width,height);
  Canvas.Font:=self.Font;
  if (opMenuArrow in FOptions) and Assigned(FDropDown) then
  begin
    DrawPopupMark(width-13,round(height/2)-2);
    x2:=7;
  end else x2:=0;
  if not(FAHMGlyph.Bitmap.empty) and not(opTextOnly in FOptions) then
  begin
    X1:=round(Width/2) -round(FAHMGlyph.Width/2);
    Y1:=round(Height/2)-round(FAHMGlyph.Height/2);
    if (Length(Caption)=0) or (opBitmapOnly in FOptions) then
    case Layout of
      pTop,pBottom : X1:=round(Width/2) -round(FAHMGlyph.Width /2);
      pLeft,pRight : Y1:=round(Height/2)-round(FAHMGlyph.Height/2)+Integer(Pushed);
    end;
    if not(opBitmapOnly in FOptions) then
    case Layout of
      pTop :
      begin
        Y1:=6+Integer(Pushed);
        F3ds.write(Canvas.Font,Canvas.handle,
          Rect(4,6+FAHMGlyph.height,width-4-x2,height-4),PChar(Caption),
          DT_VCENTER or DT_CENTER or DT_SINGLELINE or DT_END_ELLIPSIS,enabled);
      end;
      pBottom :
      begin
        Y1:=Height-7-FAHMGlyph.Height-Integer(not(Pushed));
        F3ds.write(Canvas.Font,Canvas.handle,
          Rect(4,4,width-4-x2,height-8-FAHMGlyph.height),PChar(Caption),
          DT_VCENTER or DT_CENTER or DT_SINGLELINE or DT_END_ELLIPSIS,enabled);
      end;
      pLeft :
      begin
        X1:=6;
        F3ds.write(Canvas.Font,Canvas.handle,
          Rect(6+FAHMGlyph.width,4,width-4-x2,height-4),PChar(Caption),
          DT_VCENTER or DT_CENTER or DT_SINGLELINE or DT_END_ELLIPSIS,enabled);
      end;
      pRight :
      begin
        X1:=width-6-FAHMGlyph.width-x2;
        F3ds.write(Canvas.Font,Canvas.handle,
          Rect(4,4,width-6-FAHMGlyph.width-x2,height-4),PChar(Caption),
          DT_VCENTER or DT_CENTER or DT_SINGLELINE or DT_END_ELLIPSIS,enabled);
      end;
    end;
    FAHMGlyph.Draw(Canvas,x1,y1,Enabled,False,(not(MouseIn) and (opMonoDisplay in FOptions)));
  end else
     F3ds.write(Canvas.Font,Canvas.handle,Rect(4,4+Integer((Pushed and MouseIn) or Down),
     width-4,height-4+Integer((Pushed and MouseIn) or Down)),PChar(Caption),
     DT_VCENTER or DT_CENTER or DT_SINGLELINE or DT_END_ELLIPSIS,enabled);
  if (MouseIn and not pushed) and enabled then
     AHMDrawButtonFrame(Canvas,width,height,Integer(fbevlooks)+1,False);
  if ((Pushed and MouseIn) or Down) and enabled then
     AHMDrawButtonFrame(Canvas,width,height,Integer(fbevlooks)+1,True);
end;

procedure TAHMIEButton.SetAllowAllUp(value: Boolean);
var i: Integer; otherbutton: TAHMIEButton;
begin
   FAllowAllUp := value;
   if FGroupIndex <> 0 then
   for i := 0 to Parent.ControlCount - 1 do
   begin
     if Parent.Controls[i] is TAHMIEButton then
     begin
      otherbutton := (Parent.Controls[i] as TAHMIEButton);
      if (otherbutton <> Self) and (otherbutton.GroupIndex = GroupIndex) then
          otherbutton.FAllowAllUp := value;
     end
  end;
end;

procedure TAHMIEButton.SetAHMGlyph(value: TAHMGlyph);
begin
  FAHMGlyph.Assign(value);
  Invalidate;
end;


procedure TAHMIEButton.SetDown(value: Boolean);
var i : Integer;
    otherbutton : TAHMIEButton;
begin
  if FGroupIndex <> 0 then
  begin
    FDown := value;
    Invalidate;
    if FDown = True then
    for i := 0 to Parent.ControlCount - 1 do
    begin
      if Parent.Controls[i] is TAHMIEButton then
      begin
        otherbutton := (Parent.Controls[i] as TAHMIEButton);
        if (otherbutton <> Self) and (otherbutton.GroupIndex = GroupIndex)
            and (otherbutton.FDown = True) then
        begin
          otherbutton.FDown := False;
          otherbutton.Invalidate;
        end
      end
    end
  end
end;

procedure TAHMIEButton.SetDropDown(value: TPopupMenu);
begin
  FDropDown:=(value);
  Invalidate;
end;

procedure TAHMIEButton.SetEnabled(value: Boolean);
begin
  FEnabled := value;
  GetLost;
end;

procedure TAHMIEButton.SetGroupIndex(value: Integer);
begin
   FGroupIndex := value;
   if (FGroupIndex = 0) and FDown then
   begin
     FDown := False;
     Invalidate;
   end;
end;

procedure TAHMIEButton.SetLayout(value: TAHMPosition);
begin
  FLayout := value;
  Invalidate;
end;


procedure TAHMIEButton.SetOptions(value: TAHMButtonOptions);
begin
  FOptions := value;
  Invalidate;
end;


procedure TAHMIEButton.WMLButtonDown(var msg: TWMLButtonDown);
var p: TPoint;
begin
  if Enabled and Visible then
  begin
    Pushed := True;
    MouseIn := True;
    Invalidate;
    if FDropDown <> nil then
    begin
      p := ClientToScreen(Point(0, Height));
      FDropDown.Popup(p.x, p.y);
      Pushed := False;
      MouseIn := False;
      Invalidate;
    end;
  end;
end;


procedure TAHMIEButton.WMRButtonDown(var msg: TWMRButtonDown);
begin
  if Enabled and Visible then
  begin
    Pushed := True;
    MouseIn := True;
    Invalidate;
  end;
  if assigned(FOnRightMouseDown) then FOnRightMouseDown(Self);
  inherited;
  Pushed := False;
  MouseIn := False;
  Invalidate;
end;


procedure TAHMIEButton.WMLButtonUp(var msg: TWMLButtonUp);
var i: Integer;
	otherbutton: TAHMIEButton;
begin
  if Enabled and Visible and Pushed then
  begin
    Pushed := False;
    if MouseIn and (GroupIndex <> 0) then
    begin
      if FDown then
      begin
     	if FAllowAllUp then FDown := False;
      end
      else
      begin
        for i := 0 to Parent.ControlCount - 1 do
        begin
          if Parent.Controls[i] is TAHMIEButton then
          begin
            otherbutton := (Parent.Controls[i] as TAHMIEButton);
            if (otherbutton <> Self) and (otherbutton.GroupIndex = GroupIndex)
               and (otherbutton.FDown = True) then
            begin
              otherbutton.Down := False;
              otherbutton.Invalidate;
            end
          end
        end;
        FDown := True;
      end;
    end;
    SetCaptureControl(nil);
    if MouseIn then
    begin
      MouseIn := False;
      Invalidate;
      if (FDropDown = nil) then Click;
    end
  end
end;

procedure TAHMIEButton.WMMouseMove(var msg: TWMMouseMove);
begin
  if not MouseCapture then
  begin
    SetCaptureControl(Self);
    if Enabled and Visible and GetParentForm(Self).Active then
    begin
      MouseIn := True;
      if not FDown then Invalidate;
    end;
  end;
  if MouseCapture and ((msg.XPos < 0) or (msg.YPos < 0) or (msg.XPos > Width) or
   	(msg.YPos > Height)) and MouseIn then
  begin
     MouseIn := False;
     if (not FDown) and enabled then Invalidate;
     if not Pushed then	SetCaptureControl(nil);
  end;
  if MouseCapture and ((msg.XPos >= 0) and (msg.YPos >= 0) and (msg.XPos <= Width) and
                      (msg.YPos <= Height)) and not MouseIn then
  begin
    MouseIn := True;
    if (not FDown) and enabled then Invalidate;
  end;
end;

procedure TAHMIEButton.WMRButtonUp(var msg: TWMRButtonUp);
begin
  msg.Result := 0;
end;

end.
