unit FlatButton;

(*
 * TFlatButton & TFlatSpeedButton v1.02 (FREEWARE components)
 * ------------------------------------
 * Released 4 Jan 1999
 *
 * TFlatSpeedButton is similar to TSpeedButton in Delphi 3, but can
 * display menu after clicking on this button, send messages OnMenuShow
 * and OnMenuHide and can also display file icon (type HIcon) instead
 * of normal content of the button.
 *
 * TFlatButton is also similar to TSpeedButton in Delphi 3, but this
 * component can receive focus, so it is like normal button only with
 * effects when moving mouse.
 *
 * You can use this component freely in your programs. But if you do so, please
 * send me an e-mail. I would like to know if it is useful.
 *
 * What's new
 * ----------
 * 1.02 - TFlatSpeedButton has now set Flat to True by default (it is FLAT button)
 * 1.01 - I am sorry, but I forgot (again!!) to put some file (ButtonsSupport.pas)
 *        to the archive. It is corrected now.
 * 1.00 - initial version
 *
 * © Vit Kovalcik
 *
 * e-mail: vit.kovalcik@volny.cz
 * www: http://www.fi.muni.cz/~xkovalc
 *)


{$STACKCHECKS OFF}
{$STACKFRAMES OFF}
{$RANGECHECKS OFF}

interface

uses Windows, Messages, Classes, Controls, Graphics, StdCtrls,
  ExtCtrls, ButtonsSupport,Forms,Menus;

type
  TFlatButton = class(TButton)
  private
    FCanvas: TCanvas;
    FGlyph: Pointer;
    FStyle: TButtonStyle;
    FKind: TBitBtnKind;
    FLayout: TButtonLayout;
    FSpacing: Integer;
    FMargin: Integer;
    IsFocused: Boolean;

    FModifiedGlyph: Boolean;
    FBevelWidth:Byte;
    FBevelWidthM:Byte;
    FBevelWidthDown:Byte;
    FBackground:TImage;
    FMouseIn:Boolean;

    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
      
    procedure CMMouseEnter(var Message:TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message:TMessage); message CM_MOUSELEAVE;
    procedure WMKeyDown (var Message:TMessage);message WM_KEYDOWN;
    procedure WMKeyUp (var Message:TMessage);message WM_KEYUP;
    procedure WMMove (var Message:TMessage);message WM_MOVE;

    procedure DrawItem(const DrawItemStruct: TDrawItemStruct);
    procedure SetGlyph(Value: TBitmap);
    function GetGlyph: TBitmap;
    function GetNumGlyphs: TNumGlyphs;
    procedure SetNumGlyphs(Value: TNumGlyphs);

    procedure GlyphChanged(Sender: TObject);
    function IsCustom: Boolean;
    procedure SetStyle(Value: TButtonStyle);
    procedure SetKind(Value: TBitBtnKind);
    function GetKind: TBitBtnKind;
    procedure SetLayout(Value: TButtonLayout);
    procedure SetSpacing(Value: Integer);
    procedure SetMargin(Value: Integer);
    procedure SetBevelWidth(Value:Byte);
    procedure SetBevelWidthM(Value:Byte);
    procedure SetBevelWidthDown(Value:Byte);
    procedure SetBackground(Value:TImage);
  protected
    procedure CreateHandle; override;
    procedure CreateParams(var Params: TCreateParams); override;
    function GetPalette: HPALETTE; override;
    procedure SetButtonStyle(ADefault: Boolean); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
  published
    property Cancel stored IsCustom;
    property Caption {stored IsCustomCaption};
    property Background:TImage read FBackground write SetBackground;
    property BevelWidth:Byte read FBevelWidth write SetBevelWidth;
    property BevelWidthM:Byte read FBevelWidthM write SetBevelWidthM;
    property BevelWidthDown:Byte read FBevelWidthDown write SetBevelWidthDown;
    property Default stored IsCustom;
    property Enabled;
    property Glyph: TBitmap read GetGlyph write SetGlyph stored IsCustom;
    property Kind: TBitBtnKind read GetKind write SetKind default bkCustom;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
    property ModalResult stored IsCustom;
    property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs stored IsCustom default 1;
    property ParentShowHint;
    property ShowHint;
    property Style: TButtonStyle read FStyle write SetStyle default bsAutoDetect;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnEnter;
    property OnExit;
  end;

{Předělaný TSpeedButton}
{DOST změněno od původní verze !! - zpracovává ikony souborů (ZIcon,ZIconWidth,ZIconHeight)
			          - vysílá zprávy OnMenuShow a OnMenuHide
                                  - lze přidat menu (pop-up) při stisku tlačítka}

type
  TFlatSpeedButton = class(TGraphicControl)
  private
    FGroupIndex: Integer;
    FGlyph: Pointer;
    FDown: Boolean;
    FDragging: Boolean;
    FAllowAllUp: Boolean;
    FLayout: TButtonLayout;
    FSpacing: Integer;
    FMargin: Integer;
    FFlat: Boolean;
    FMouseInControl: Boolean;
{ADDED}
      FOnMenuShow,FOnMenuHide:TNotifyEvent;
      FDropDown:TPopupMenu;
      FIcon:HIcon;
      FIconWidth,FIconHeight:Integer;
    procedure GlyphChanged(Sender: TObject);
    procedure UpdateExclusive;
    function GetGlyph: TBitmap;
    procedure SetGlyph(Value: TBitmap);
    function GetNumGlyphs: TNumGlyphs;
    procedure SetNumGlyphs(Value: TNumGlyphs);
    procedure SetDown(Value: Boolean);
    procedure SetFlat(Value: Boolean);
    procedure SetAllowAllUp(Value: Boolean);
    procedure SetGroupIndex(Value: Integer);
    procedure SetLayout(Value: TButtonLayout);
    procedure SetSpacing(Value: Integer);
    procedure SetMargin(Value: Integer);
    procedure SetIcon (Value:HIcon);
    procedure SetIconWidth (Value:Integer);
    procedure SetIconHeight (Value:Integer);
    procedure UpdateTracking;
    procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  protected
    FState: TButtonState;
    function GetPalette: HPALETTE; override;
    procedure Loaded; 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;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Click; override;
{ADDED}
      property Icon:HIcon read FIcon write SetIcon;
      property IconWidth:Integer read FIconWidth write SetIconWidth;
      property IconHeight:Integer read FIconHeight write SetIconHeight;
  published
    property AllowAllUp: Boolean read FAllowAllUp write SetAllowAllUp default False;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property Down: Boolean read FDown write SetDown default False;
    property Caption;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default False;
    property Font;
    property Glyph: TBitmap read GetGlyph write SetGlyph;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: Integer read FMargin write SetMargin default -1;
{ADDED}
      property OnMenuShow:TNotifyEvent read FOnMenuShow write FOnMenuShow;
      property OnMenuHide:TNotifyEvent read FOnMenuHide write FOnMenuHide;
      property DropDownMenu: TPopupMenu read FDropDown write FDropDown stored True;
    property NumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs default 1;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation
{{$R FlatButtonRes.dcr}

uses Consts, SysUtils;

{ TFlatButton }

constructor TFlatButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMouseIn:=False;
  FGlyph := TButtonGlyph.Create;
  TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  FCanvas := TCanvas.Create;
  FStyle := bsAutoDetect;
  FKind := bkCustom;
  FLayout := blGlyphLeft;
  FSpacing := 4;
  FMargin := -1;
  FBevelWidth:=1;
  FBevelWidthM:=2;
  FBevelWidthDown:=1;
  FBackground:=nil;
end;

destructor TFlatButton.Destroy;
begin
  TButtonGlyph(FGlyph).Free;
  FCanvas.Free;
  inherited Destroy;
end;

procedure TFlatButton.CreateHandle;
var
  State: TButtonState;
begin
  if Enabled then
    State := bsUp
  else
    If FBackground<>nil then
      State := bsTranspDisabled
    else
      State := bsDisabled;
  inherited CreateHandle;
  TButtonGlyph(FGlyph).CreateButtonGlyph(State);
end;

procedure TFlatButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;

procedure TFlatButton.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsFocused then
  begin
    IsFocused := ADefault;
    Refresh;
  end;
end;

procedure TFlatButton.Click;
var
  Form: TForm;
  Control: TWinControl;
begin
  case FKind of
    bkClose:
      begin
        Form := TForm(GetParentForm(Self));
        if Form <> nil then Form.Close
        else inherited Click;
      end;
    bkHelp:
      begin
        Control := Self;
        while (Control <> nil) and (Control.HelpContext = 0) do
          Control := Control.Parent;
        if Control <> nil then Application.HelpContext(Control.HelpContext)
        else inherited Click;
      end;
    else
      inherited Click;
  end;
end;

procedure TFlatButton.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemWidth := Width;
    itemHeight := Height;
  end;
end;

procedure TFlatButton.CNDrawItem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;

procedure TFlatButton.DrawItem(const DrawItemStruct: TDrawItemStruct);
var
  IsDown: Boolean;
  State: TButtonState;
  R,R2: TRect;
begin
  If GetParentForm (Self)=nil then
    Exit;
  FCanvas.Handle := DrawItemStruct.hDC;
  with DrawItemStruct do
  begin
    IsDown := (itemState and ODS_SELECTED <> 0) OR
       ((GetKeyState (VK_SPACE) AND 128<>0) AND Focused);
    if not Enabled then
    begin
      If FBackground<>nil then
        State:=bsTranspDisabled
      else
        State := bsDisabled
    end
    else
      if IsDown then
        State := bsDown
      else
        State := bsUp;
  end;

  FCanvas.Font := Self.Font;
  R := ClientRect;
  FCanvas.Brush.Style:=bsClear; 

  If (((Default AND not (GetParentForm(Self).ActiveControl is TButton) AND Enabled)
      OR Focused) AND TabStop) OR ((csDesigning in ComponentState) AND (FBevelWidth=0)) then
  begin
    FCanvas.Pen.Color:=clBlack;
    FCanvas.Rectangle (R.Left,R.Top,R.Right,R.Bottom);
    InflateRect(R, -1, -1);
  end;
  If (FBackground<>nil) AND (FBackground.Picture.Bitmap.Empty=False) then
  begin
    R2.Left:=Left+R.Left-FBackground.Left;
    R2.Top:=Top+R.Top-FBackground.Top;
    R2.Right:=Left+R.Right-FBackground.Left;
    R2.Bottom:=Top+R.Bottom-FBackground.Top;
    If IsDown then
      OffsetRect (R2,-1,-1);
    FCanvas.CopyRect (R,FBackground.Canvas,R2);
  end
  else
  begin
    FCanvas.Brush.Color:=clBtnFace;
    FCanvas.Pen.Color:=clBtnFace;
    FCanvas.Brush.Style:=bsSolid;
    FCanvas.Rectangle (R.Left,R.Top,R.Right,R.Bottom);
  end;

  If IsDown then
    Frame3D (FCanvas,R,clBtnShadow,clBtnHighlight,FBevelWidthDown)
  else
    If FMouseIn AND LeaveMsgSending AND not Focused then
    begin
      Frame3D (FCanvas,R,clBtnHighlight,clBtnShadow,FBevelWidthM);
      InflateRect (R,-1,-1);
    end
    else
      Frame3D (FCanvas,R,clBtnHighlight,clBtnShadow,FBevelWidth);

  If (Focused AND TabStop) then
  begin
    InflateRect (R,-1,-1);
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Color := clBtnFace;
    FCanvas.DrawFocusRect (R);
  end;  

  if IsDown then
    OffsetRect(R, 1, 1);
  TButtonGlyph(FGlyph).Draw(FCanvas, R, Point(0,0), Caption, FLayout, FMargin,
    FSpacing, State, False);

  FCanvas.Handle := 0;
end;

procedure TFlatButton.CMFontChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TFlatButton.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TFlatButton.WMLButtonDblClk(var Message: TWMLButtonDblClk);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos));
end;

function TFlatButton.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;

procedure TFlatButton.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value as TBitmap;
  FModifiedGlyph := True;
  Invalidate;
end;

function TFlatButton.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

procedure TFlatButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

function TFlatButton.IsCustom: Boolean;
begin
  Result := Kind = bkCustom;
end;

procedure TFlatButton.SetStyle(Value: TButtonStyle);
begin
  if Value <> FStyle then
  begin
    FStyle := Value;
    Invalidate;
  end;
end;

procedure TFlatButton.SetKind(Value: TBitBtnKind);
begin
  if Value <> FKind then
  begin
    if Value <> bkCustom then
    begin
      Default := Value in [bkOK, bkYes];
      Cancel := Value in [bkCancel, bkNo];

      if ((csLoading in ComponentState) and (Caption = '')) or
        (not (csLoading in ComponentState)) then
      begin
{        if BitBtnCaptions[Value] <> nil then
          Caption := LoadResString(BitBtnCaptions[Value]);}
          Caption:='';
      end;

      ModalResult := BitBtnModalResults[Value];
      TButtonGlyph(FGlyph).Glyph := GetBitBtnGlyph(Value);
      NumGlyphs := 2;
      FModifiedGlyph := False;
    end;
    FKind := Value;
    Invalidate;
  end;
end;

function TFlatButton.GetKind: TBitBtnKind;
begin
  if FKind <> bkCustom then
    if ((FKind in [bkOK, bkYes]) xor Default) or
      ((FKind in [bkCancel, bkNo]) xor Cancel) or
      (ModalResult <> BitBtnModalResults[FKind]) or
      FModifiedGlyph then
      FKind := bkCustom;
  Result := FKind;
end;

procedure TFlatButton.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

function TFlatButton.GetNumGlyphs: TNumGlyphs;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;

procedure TFlatButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  if Value < 0 then Value := 1
  else if Value > 4 then Value := 4;
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TFlatButton.SetSpacing(Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TFlatButton.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= - 1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TFlatButton.CMMouseEnter(var Message:TMessage);
begin
  FMouseIn:=True;
  MouseInBtn:=Self;
  If not Focused then
    Invalidate;
end;

procedure TFlatButton.CMMouseLeave(var Message:TMessage);
begin
  MouseInBtn:=nil;
  FMouseIn:=False;
  If not Focused then
    Invalidate;
end;

procedure TFlatButton.WMKeyDown (var Message:TMessage);
begin
  If (Message.wParam=VK_SPACE) AND (LeaveMsgSending=True) then
  begin
    LeaveMsgSending:=False;
    If MouseInBtn<>nil then
      MouseInBtn.Invalidate;
    Invalidate;
  end;
  Message.Result:=0;
end;

procedure TFlatButton.WMKeyUp (var Message:TMessage);
begin
  If (Message.wParam=VK_SPACE) AND (LeaveMsgSending=False) then
  begin
    LeaveMsgSending:=True;
    If MouseInBtn<>nil then
      MouseInBtn.Invalidate;
    Invalidate;
    Click;
  end;
  Message.Result:=0;
end;

procedure TFlatButton.SetBevelWidth(Value:Byte);
begin
  FBevelWidth:=Value;
  Invalidate;
end;

procedure TFlatButton.SetBevelWidthM(Value:Byte);
begin
  FBevelWidthM:=Value;
  Invalidate;
end;

procedure TFlatButton.SetBevelWidthDown(Value:Byte);
begin
  FBevelWidthDown:=Value;
  Invalidate;
end;

procedure TFlatButton.SetBackground(Value:TImage);
begin
  FBackground:=Value;
  Invalidate;
end;

procedure TFlatButton.WMMove (var Message:TMessage);
begin
  If FBackground<>nil then
    Invalidate;
end;

constructor TFlatSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  SetBounds(0, 0, 25, 25);
  ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks];
  FGlyph := TButtonGlyph.Create;
  TButtonGlyph(FGlyph).OnChange := GlyphChanged;
  ParentFont := True;
  FSpacing := 4;
  FMargin := -1;
  FLayout := blGlyphLeft;
  FIcon:=0;
  Inc(ButtonCount);
  SetFlat (True);  
end;

destructor TFlatSpeedButton.Destroy;
begin
  TButtonGlyph(FGlyph).Free;
  Dec(ButtonCount);
  if ButtonCount = 0 then
  begin
    Pattern.Free;
    Pattern := nil;
  end;
  inherited Destroy;
end;

procedure TFlatSpeedButton.Paint;
const
  DownStyles: array[Boolean] of Integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
var
  PaintRect: TRect;
  DrawFlags: Integer;
  Offset: TPoint;
begin
  if not Enabled then
  begin
    FState := bsDisabled;
    FDragging := False;
  end
  else if FState = bsDisabled then
    if FDown and (GroupIndex <> 0) then
      FState := bsExclusive
    else
      FState := bsUp;
  Canvas.Font := Self.Font;
  PaintRect := Rect(0, 0, Width, Height);
  if not FFlat then
  begin
    DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
    if FState in [bsDown, bsExclusive] then
      DrawFlags := DrawFlags or DFCS_PUSHED;
    DrawFrameControl(Canvas.Handle, PaintRect, DFC_BUTTON, DrawFlags);
  end
  else
  begin
    if (FState in [bsDown, bsExclusive]) or
      (FMouseInControl and (FState <> bsDisabled)) or
      (csDesigning in ComponentState) then
      DrawEdge(Canvas.Handle, PaintRect, DownStyles[FState in [bsDown, bsExclusive]],
        FillStyles[FFlat] or BF_RECT);
    InflateRect(PaintRect, -1, -1);
  end;
  if FState in [bsDown, bsExclusive] then
  begin
    if (FState = bsExclusive) and (not FFlat or not FMouseInControl) then
    begin
      if Pattern = nil then CreateBrushPattern;
{      Canvas.Brush.Bitmap := Pattern;
      Canvas.FillRect(PaintRect);}
    end;
    Offset.X := 1;
    Offset.Y := 1;
  end
  else
  begin
    Offset.X := 0;
    Offset.Y := 0;
  end;
  If FIcon<>0 then
    DrawIconEx (Canvas.Handle,
       (PaintRect.Right-PaintRect.Left) div 2-FIconWidth div 2+1,
       (PaintRect.Bottom-PaintRect.Top) div 2-FIconHeight div 2+1,
       FIcon,FIconWidth,FIconHeight,0,0,DI_NORMAL)
  else
    TButtonGlyph(FGlyph).Draw(Canvas, PaintRect, Offset, Caption, FLayout, FMargin,
       FSpacing, FState, FFlat);
end;

procedure TFlatSpeedButton.UpdateTracking;
var
  P: TPoint;
begin
  if FFlat then
  begin
    if Enabled then
    begin
      GetCursorPos(P);
      FMouseInControl := not (FindDragTarget(P, True) = Self);
      if FMouseInControl then
        Perform(CM_MOUSELEAVE, 0, 0)
      else
        Perform(CM_MOUSEENTER, 0, 0);
    end;
  end;
end;

procedure TFlatSpeedButton.Loaded;
var
  State: TButtonState;
begin
  inherited Loaded;
  if Enabled then
    State := bsUp
  else
    State := bsDisabled;
  TButtonGlyph(FGlyph).CreateButtonGlyph(State);
end;

procedure TFlatSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var P:TPoint;
    theMsg: TMsg;
    lpPoint: TPoint;
begin
  inherited MouseDown(Button, Shift, X, Y);
  if (Button = mbLeft) and Enabled then
  begin
{POZOR - přidáno hodně}
    if FDropDown <> nil then
    begin
      FState:=bsDown;
      Invalidate;
      If Assigned (FOnMenuShow) then
        FOnMenuShow (Self);
      p := ClientToScreen(Point(0, Height));
      FDropDown.Popup(p.x, p.y);
      while PeekMessage(theMsg, HWND(0), WM_MOUSEFIRST, WM_MOUSELAST, PM_REMOVE) do
      	;
      if GetCapture <> 0 then
      	SendMessage(GetCapture, WM_CANCELMODE, 0, 0);
      GetCursorPos(lpPoint);
      lpPoint := Parent.ScreenToClient(lpPoint);
      if ((lpPoint.y > top) and (lpPoint.y < top + height)
        and (lpPoint.x > left) and (lpPoint.x < left + width)) then
        FMouseInControl:=True
      else
        FMouseInControl:=False;
      FState:=bsUp;
      Invalidate;
      If Assigned (FOnMenuHide) then
        FOnMenuHide (Self);     

    end
    else
    begin
      if not FDown then
      begin
        FState := bsDown;
        Invalidate;
      end;
      FDragging := True;
    end;
  end;
end;

procedure TFlatSpeedButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  NewState: TButtonState;
begin
  inherited MouseMove(Shift, X, Y);
  if FDragging then
  begin
    if not FDown then NewState := bsUp
    else NewState := bsExclusive;
    if (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight) then
      if FDown then NewState := bsExclusive else NewState := bsDown;
    if NewState <> FState then
    begin
      FState := NewState;
      Invalidate;
    end;
  end;
end;

procedure TFlatSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FDragging then
  begin
    FDragging := False;
    DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight);
    if FGroupIndex = 0 then
    begin
      { Redraw face in-case mouse is captured }
      FState := bsUp;
      FMouseInControl := False;
      if DoClick and not (FState in [bsExclusive, bsDown]) then
        Invalidate;
    end
    else
      if DoClick then
      begin
        SetDown(not FDown);
        if FDown then Repaint;
      end
      else
      begin
        if FDown then FState := bsExclusive;
        Repaint;
      end;
    if DoClick then Click;
    UpdateTracking;
  end;
end;

procedure TFlatSpeedButton.Click;
begin
  inherited Click;
end;

function TFlatSpeedButton.GetPalette: HPALETTE;
begin
  Result := Glyph.Palette;
end;

function TFlatSpeedButton.GetGlyph: TBitmap;
begin
  Result := TButtonGlyph(FGlyph).Glyph;
end;

procedure TFlatSpeedButton.SetGlyph(Value: TBitmap);
begin
  TButtonGlyph(FGlyph).Glyph := Value;
  Invalidate;
end;

function TFlatSpeedButton.GetNumGlyphs: TNumGlyphs;
begin
  Result := TButtonGlyph(FGlyph).NumGlyphs;
end;

procedure TFlatSpeedButton.SetNumGlyphs(Value: TNumGlyphs);
begin
  if Value < 0 then Value := 1
  else if Value > 4 then Value := 4;
  if Value <> TButtonGlyph(FGlyph).NumGlyphs then
  begin
    TButtonGlyph(FGlyph).NumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.GlyphChanged(Sender: TObject);
begin
  Invalidate;
end;

procedure TFlatSpeedButton.UpdateExclusive;
var
  Msg: TMessage;
begin
  if (FGroupIndex <> 0) and (Parent <> nil) then
  begin
    Msg.Msg := CM_BUTTONPRESSED;
    Msg.WParam := FGroupIndex;
    Msg.LParam := Longint(Self);
    Msg.Result := 0;
    Parent.Broadcast(Msg);
  end;
end;

procedure TFlatSpeedButton.SetDown(Value: Boolean);
begin
  if FGroupIndex = 0 then Value := False;
  if Value <> FDown then
  begin
    if FDown and (not FAllowAllUp) then Exit;
    FDown := Value;
    if Value then
    begin
      if FState = bsUp then Invalidate;
      FState := bsExclusive
    end
    else
    begin
      FState := bsUp;
      Repaint;
    end;
    if Value then UpdateExclusive;
  end;
end;

procedure TFlatSpeedButton.SetFlat(Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    if Value then
      ControlStyle := ControlStyle - [csOpaque] else
      ControlStyle := ControlStyle + [csOpaque];
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetGroupIndex(Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
  end;
end;

procedure TFlatSpeedButton.SetLayout(Value: TButtonLayout);
begin
  if FLayout <> Value then
  begin
    FLayout := Value;
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetMargin(Value: Integer);
begin
  if (Value <> FMargin) and (Value >= -1) then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetSpacing(Value: Integer);
begin
  if Value <> FSpacing then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetAllowAllUp(Value: Boolean);
begin
  if FAllowAllUp <> Value then
  begin
    FAllowAllUp := Value;
    UpdateExclusive;
  end;
end;

procedure TFlatSpeedButton.WMLButtonDblClk(var Message: TWMLButtonDown);
begin
  inherited;
  if FDown then DblClick;
end;

procedure TFlatSpeedButton.CMEnabledChanged(var Message: TMessage);
const
  NewState: array[Boolean] of TButtonState = (bsDisabled, bsUp);
begin
  TButtonGlyph(FGlyph).CreateButtonGlyph(NewState[Enabled]);
  UpdateTracking;
  Repaint;
end;

procedure TFlatSpeedButton.CMButtonPressed(var Message: TMessage);
var
  Sender: TFlatSpeedButton;
begin
  if Message.WParam = FGroupIndex then
  begin
    Sender := TFlatSpeedButton(Message.LParam);
    if Sender <> Self then
    begin
      if Sender.Down and FDown then
      begin
        FDown := False;
        FState := bsUp;
        Invalidate;
      end;
      FAllowAllUp := Sender.AllowAllUp;
    end;
  end;
end;

procedure TFlatSpeedButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

procedure TFlatSpeedButton.CMFontChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TFlatSpeedButton.CMTextChanged(var Message: TMessage);
begin
  Invalidate;
end;

procedure TFlatSpeedButton.CMSysColorChange(var Message: TMessage);
begin
  with TButtonGlyph(FGlyph) do
  begin
    Invalidate;
    CreateButtonGlyph(FState);
  end;
end;

procedure TFlatSpeedButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  if FFlat and not FMouseInControl and Enabled then
  begin
    FMouseInControl := True;
    Repaint;
  end;
end;

procedure TFlatSpeedButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FFlat and FMouseInControl and Enabled and not FDragging then
  begin
    FMouseInControl := False;
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetIcon (Value:HIcon);
begin
  If FIcon<>Value then
  begin
    FIcon:=Value;
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetIconWidth (Value:Integer);
begin
  If FIconWidth<>Value then
  begin
    FIconWidth:=Value;
    Invalidate;
  end;
end;

procedure TFlatSpeedButton.SetIconHeight (Value:Integer);
begin
  If FIconHeight<>Value then
  begin
    FIconHeight:=Value;
    Invalidate;
  end;
end;

procedure Register;
begin
  RegisterComponents ('Samples',[TFlatButton,TFlatSpeedButton]);
end;

end.
