{==============================================================================

  Custom Controls
  Copyright (C) 2000-2001 by Evgeny Kryukov
  All rights reserved

  All contents of this file and all other files included in this archive
  are Copyright (C) 2001 Evgeny Kryukov. Use and/or distribution of
  them requires acceptance of the License Agreement.

  See License.txt for licence information

===============================================================================}

unit KsSpeedButtons;

{$I KsCommonVer.Inc}
{$T-,W-,X+,P+}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, Menus, Buttons, KsUtils, KsBitmap, KsControls;

const
  InitRepeatPause = 400;  { pause before repeat timer (ms) }
  RepeatPause     = 100;  { pause before hint window displays (ms)}

type

  TKsButtonState = (bsUp, bsDisabled, bsDown, bsExclusive, bsChevronDown);
  TKsChevronPos = (dmpBottom, dmpRight);

  TKsCustomSpeedButton = class(TKsGraphicControl)
  private
    FShowChevron: boolean;
    FFlat: boolean;
    FGroupIndex: Integer;
    FDown: boolean;
    FAllowAllUp: Boolean;
    FMenuPosition: TKsChevronPos;
    FChevronMenu: TPopupMenu;
    FGlyph: TBitmap;
    FLayout: TButtonLayout;
    FMargin: integer;
    FSpacing: integer;
    FOnChevronClick: TNotifyEvent;
    FShowCaption: boolean;
    FShowGlyph: boolean;
    FNumGlyphs: TNumGlyphs;
    FBlackAndWhiteGlyph: boolean;
    FAllowTimer: boolean;
    FRepeatTimer: TTimer;
    procedure SetShowChevron(const Value: boolean);
    procedure SetFlat(const Value: boolean);
    procedure SetDown(const Value: boolean);
    procedure SetAllowAllUp(const Value: Boolean);
    procedure SetGlyph(const Value: TBitmap);
    procedure SetLayout(const Value: TButtonLayout);
    procedure SetMargin(const Value: integer);
    procedure SetSpacing(const Value: integer);
    procedure SetShowCaption(const Value: boolean);
    procedure SetShowGlyph(const Value: boolean);
    procedure SetNumGlyphs(const Value: TNumGlyphs);
    procedure SetGroupIndex(const Value: Integer);
    procedure SetChevronMenu(const Value: TPopupMenu);
    procedure SetBlackAndWhiteGlyph(const Value: boolean);

    procedure CMButtonPressed(var Message: TMessage); message CM_BUTTONPRESSED;

    procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;

    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 UpdateExclusive;
    function CheckChevronDropDown: Boolean;
    function CheckMenuDropDown(const Pos: TSmallPoint; Manual: Boolean): Boolean;
    function GeTKsChevronPos: TPoint;
    { Internal Event Handlers }
    procedure GlyphChangedHandler(Sender: TObject);
    procedure TimerExpired(Sender: TObject);
  protected
    FState: TKsButtonState;
    FMouseDown: boolean;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetButtonRect: TRect; virtual;
    function GetChevronRect: TRect; virtual;
    function GetDropDownArrowRect: TRect; virtual;
    function GetGlyphRect: TRect; virtual;
    function GetCaptionRect: TRect; virtual;
    function GetChevronWidth: integer; virtual;
    function GetDropDownArrowSize: TPoint; virtual;
    function GetGlyphSize: TPoint; virtual;
    function GetCaptionSize: TPoint; virtual;
    procedure DrawDropDownArrow(Offset: TPoint); virtual;
    procedure DrawGlyph(Offset: TPoint); virtual;
    procedure DrawCaption(Offset: TPoint); virtual;

    procedure MouseEnter; override;
    procedure MouseLeave; override;
    procedure PaintBuffer; override;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;

    procedure Notification(AComponent: TComponent; Operation: TOperation); override;

    property State: TKsButtonState read FState;
    procedure ChevronClick; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure Click; virtual;
    property ChevronWidth: integer read GetChevronWidth;
  published
    property Action;
    property AllowAllUp: boolean read FAllowAllUp write SetAllowAllUp default false;
    property AllowTimer: boolean read FAllowTimer write FAllowTimer default false;
    property Anchors;
    { Use BlackAndWhiteGlyph property to set IE button behaviour. }
    property BlackAndWhiteGlyph: boolean read FBlackAndWhiteGlyph write SetBlackAndWhiteGlyph;
    property Constraints;
    property Caption;
    property Down: boolean read FDown write SetDown default false;
    property ChevronMenu: TPopupMenu read FChevronMenu write SetChevronMenu;
    property Enabled;
    property Flat: boolean read FFlat write SetFlat default false;
    property Font;
    property Glyph: TBitmap read FGlyph write SetGlyph;
    property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
    property Layout: TButtonLayout read FLayout write SetLayout default blGlyphLeft;
    property Margin: integer read FMargin write SetMargin default -1;
    property MenuPosition: TKsChevronPos read FMenuPosition write FMenuPosition default dmpBottom;
    property NumGlyphs: TNumGlyphs read FNumGlyphs write SetNumGlyphs default 1;
    property Spacing: Integer read FSpacing write SetSpacing default 4;
    property ParentFont;
    property ParentShowHint;
    property ParentBiDiMode;
    property PopupMenu;
    property ShowCaption: boolean read FShowCaption write SetShowCaption default true;
    property ShowGlyph: boolean read FShowGlyph write SetShowGlyph default true;
    property ShowHint;
    property ShowChevron: boolean read FShowChevron write SetShowChevron default false;
    property Visible;

    property OnClick;
    property OnChevronClick: TNotifyEvent read FOnChevronClick write FOnChevronClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
  end;

{ TKsSpeedDivider class }

  TKsSpeedDivider = class(TKsGraphicControl)
  private
  protected
    procedure PaintBuffer; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TKsSpeedContainer class }

  TKsSpeedContainer = class(TKsCustomControl)
  private
  protected
    procedure PaintBuffer; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

implementation {===============================================================}

uses
  ImgList, ActnList, KsSpinButtons;

{ TKsCustomSpeedButton }

constructor TKsCustomSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FNumGlyphs := 1;
  FState := bsUp;
  ControlStyle := [csCaptureMouse, csDoubleClicks];
  FShowChevron := false;
  FFlat := false;
  FGroupIndex := 0;
  FAllowAllUp := false;
  FMenuPosition := dmpBottom;
  FMargin := -1;
  FSpacing := 4;
  FLayout := blGlyphLeft;
  FDown := false;
  FShowCaption := true;
  FShowGlyph := true;

  FMouseDown := false;

  FGlyph := TBitmap.Create;
  FGlyph.OnChange := GlyphChangedHandler;

  Transparent := true; 
  
  SetBounds(0, 0, 29, 29);
end;

destructor TKsCustomSpeedButton.Destroy;
begin
  if FRepeatTimer <> nil then
    FRepeatTimer.Free;
  FGlyph.Free;
  inherited;
end;

procedure TKsCustomSpeedButton.Loaded;
begin
  inherited;
end;

procedure TKsCustomSpeedButton.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Interval := RepeatPause;
  if (FState = bsDown) and MouseCapture then
  begin
    try
      Click;
    except
      FRepeatTimer.Enabled := False;
      raise;
    end;
  end;
end;

procedure TKsCustomSpeedButton.Click;
begin
  inherited Click;
end;

procedure TKsCustomSpeedButton.DrawDropDownArrow(Offset: TPoint);
var
  LPaintRect: TRect;
begin
  LPaintRect := GetDropDownArrowRect;
  with Offset do
    OffsetRect(LPaintRect, x, y);

  with Buffer, LPaintRect, Offset do
    if FState <> bsDisabled then
    begin
      FillPolygon([Point(Left, Top),
        Point(Right - 1, Top),
        Point((Right - 1 + Left) div 2, Bottom - 1)],
        KColor(clBtnText));
    end
    else
    begin
      MoveTo((Right + Left) div 2, Bottom - 1);
      LineTo(Left, Top, KColor(clBtnShadow));
      LineTo(Right, Top, KColor(clBtnShadow));
      MoveTo(Right, Top);
      LineTo((Right + Left) div 2 + 1 - 1, Bottom + 1 - 1, KColor(clBtnHighlight));
    end;
end;

procedure TKsCustomSpeedButton.DrawGlyph(Offset: TPoint);
var
  R: TRect;
  SrcRect: TRect;
  i, j, W, H: Integer;
  NewColor, TransparentColor: TColor;
  cH, cS, cL: single;
begin
  if FGlyph = nil then Exit;
  if FGlyph.Empty then Exit;

  with Buffer do
  begin
    R := Rect(0, 0, GetGlyphSize.x, GetGlyphSize.y);
    RectCenter(R, GetGlyphRect);
    with Offset do
      OffsetRect(R, x, y);

    W := FGlyph.Width div FNumGlyphs;
    H := FGlyph.Height;

    if (FNumGlyphs > 1) and not Enabled then
      SrcRect := Rect(W, 0, W + W, H)
    else
      SrcRect := Rect(0, 0, W, H);

    TransparentColor := FGlyph.Canvas.Pixels[0, H - 1];

    { Copy to Buffer }
    for i := 0 to W-1 do
      for j := 0 to H-1 do
      begin
        NewColor := FGlyph.Canvas.Pixels[SrcRect.Left + i, SrcRect.Top + j];
        if (FBlackAndWhiteGlyph) and (not MouseInControl) and (NewColor <> TransparentColor) then
        begin
          RGBtoHSL(KColor(NewColor), cH, cS, cL);
          NewColor := RGB(Round(cL * $FF), Round(cL * $FF), Round(cL * $FF));
        end;
        if (not Enabled) and (NewColor <> TransparentColor) then
        begin
          RGBtoHSL(KColor(NewColor), cH, cS, cL);
          NewColor := RGB(160+Round(cL * 50), 160+Round(cL * 50), 160+Round(cL * 50));
        end;
        if NewColor <> TransparentColor then
          Pixels[R.Left + i, R.Top + j] := KColor(NewColor);
      end;
  end;
end;

procedure TKsCustomSpeedButton.DrawCaption(Offset: TPoint);
var
  LPaintRect: TRect;
begin
  LPaintRect := GetCaptionRect;
  with Offset do
    OffsetRect(LPaintRect, x, y);

  with Buffer do
  begin
    Font := ControlFont;
    if FState <> bsDisabled then
      DrawText(Caption, LPaintRect, DrawTextBiDiModeFlags(DT_LEFT))
    else
    begin
      OffsetRect(LPaintRect, 1, 1);
      Font.Color := clBtnHighlight;
      DrawText(Caption, LPaintRect, DrawTextBiDiModeFlags(DT_LEFT));
      OffsetRect(LPaintRect, -1, -1);
      Font.Color := clBtnShadow;
      DrawText(Caption, LPaintRect, DrawTextBiDiModeFlags(DT_LEFT));
    end;
  end;
end;

function TKsCustomSpeedButton.GetDropDownArrowSize: TPoint;
begin
  with Result do
  begin
    x := 5;
    y := 3;
  end;
end;

function TKsCustomSpeedButton.GetGlyphSize: TPoint;
begin
  with Result do
  begin
    x := FGlyph.Width div FNumGlyphs;
    y := FGlyph.Height;
  end;
end;

function TKsCustomSpeedButton.GetCaptionSize: TPoint;
begin
  Result := Point(0, 0);
  if Buffer = nil then Exit;

  with Buffer do
  begin
    Font := ControlFont;
    Result.x := TextWidth(Caption);
    if Caption <> '' then
      Result.y := TextHeight('Pq')
    else
      Result.y := 0;
  end;
end;

function TKsCustomSpeedButton.GetChevronWidth: integer;
begin
  Result := 14;
end;

procedure TKsCustomSpeedButton.PaintBuffer;
const
  DownStyles: array[boolean] of integer = (BDR_RAISEDINNER, BDR_SUNKENOUTER);
  FillStyles: array[Boolean] of Integer = (BF_MIDDLE, 0);
var
  DrawFlags: integer;
  LButtonRect, LChevronRect: TRect;
  ButtonOffset, ChevronOffset: TPoint;
  SaveFlat: boolean;
begin
  if Buffer = nil then Exit;

  if not Enabled then
    FState := bsDisabled;

  LButtonRect := GetButtonRect;
  LChevronRect := GetChevronRect;

  if (Owner is TKsCustomSpinButton) and (FState = bsUp) then
  begin
    SaveFlat := FFlat;
    FFlat := false;
  end;

  if Flat then
  begin
    if (Enabled and
      ((FState in [bsDown, bsExclusive]) or
      (MouseInControl and (FState <> bsDisabled)) or
      ((FState = bsUp) and FMouseDown) or
      (FState = bsChevronDown))) or
      (csDesigning in ComponentState) then
    begin
      if not Transparent then
        with Buffer do
        begin
          FillRect(LButtonRect, KColor(clBtnFace));
          if ShowChevron then
            FillRect(LChevronRect, KColor(clBtnFace));
        end;

      if (FState = bsExclusive) and (not FFlat or not MouseInControl) then
        Buffer.FillHalftoneRect(LButtonRect, KColor(clBtnFace), KColor(clBtnHighlight));
        
      if FState in [bsDown, bsExclusive] then
        Buffer.DrawEdge(LButtonRect, KColor(clBtnShadow), KColor(clBtnHighlight))
      else
        Buffer.DrawEdge(LButtonRect, KColor(clBtnHighlight), KColor(clBtnShadow));

      if ShowChevron then
      begin
        if (FState in [bsChevronDown, bsExclusive]) or Down then
          Buffer.DrawEdge(LChevronRect, KColor(clBtnShadow), KColor(clBtnHighlight))
        else
          Buffer.DrawEdge(LChevronRect, KColor(clBtnHighlight), KColor(clBtnShadow));
      end;
    end;
  end
  else
  begin
    DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;

    if FState in [bsDown, bsExclusive] then
      DrawFlags := DrawFlags or DFCS_PUSHED;
    DrawFrameControl(Buffer.DC, LButtonRect, DFC_BUTTON, DrawFlags);

    DrawFlags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
    if FState in [bsChevronDown, bsExclusive] then
      DrawFlags := DrawFlags or DFCS_PUSHED;

    if ShowChevron then
      DrawFrameControl(Buffer.DC, LChevronRect, DFC_BUTTON, DrawFlags);

    if (FState = bsExclusive) and (not FFlat or not MouseInControl) then
      Buffer.FillHalftoneRect(LButtonRect, KColor(clBtnFace), KColor(clBtnHighlight));
  end;

  ButtonOffset := Point(0, 0);
  ChevronOffset := Point(0, 0);

  if FState in [bsDown, bsExclusive] then
    ButtonOffset := Point(1, 1);

  if (FState in [bsChevronDown, bsExclusive]) or Down then
    ChevronOffset := Point(1, 1);

  if ShowGlyph then
    DrawGlyph(ButtonOffset);

  if ShowCaption then
    DrawCaption(ButtonOffset);

  if ShowChevron then
    DrawDropDownArrow(ChevronOffset);

  if (Owner is TKsCustomSpinButton) then
    FFlat := SaveFlat;
end;

function TKsCustomSpeedButton.GetButtonRect: TRect;
begin
  if Buffer = nil then
    Result := Rect(0, 0, 0, 0)
  else
  begin
    Result := GetClientRect;
    if ShowChevron then
      Result.Right := Result.Right - GetChevronWidth;
  end;
end;

function TKsCustomSpeedButton.GetChevronRect: TRect;
begin
  Result := GetClientRect;
  if ShowChevron then
    Result.Left := Result.Right - GetChevronWidth
  else
    Result.Left := Result.Right;
end;

procedure TKsCustomSpeedButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  FOldState: TKsButtonState;
begin
  inherited MouseDown(Button, Shift, X, Y);
  FMouseDown := true;

  if (Button = mbLeft) and Enabled then
  begin
    if PtInRect(GetButtonRect, Point(x, y)) then
      FState := bsDown
    else
      if PtInRect(GetChevronRect, Point(x, y)) then
    begin
      if not (FState in [bsDown, bsExclusive]) then
      begin
        FState := bsChevronDown;
        Invalidate;
      end;
      if Assigned(FChevronMenu) then
        CheckChevronDropDown
      else
      begin
        FState := bsChevronDown;
        ChevronClick;
        Invalidate;
        Exit;
      end;

      if not (FState in [bsDown, bsExclusive]) then
      begin
        FState := bsUp;
        FMouseDown := false;
      end;
    end;
    Invalidate;
  end;

  if FAllowTimer then
  begin
    if FRepeatTimer = nil then
      FRepeatTimer := TTimer.Create(Self);

    FRepeatTimer.OnTimer := TimerExpired;
    FRepeatTimer.Interval := InitRepeatPause;
    FRepeatTimer.Enabled  := True;
  end;
end;

procedure TKsCustomSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  DoClick: Boolean;
begin
  inherited MouseUp(Button, Shift, X, Y);
  FMouseDown := false;

  DoClick := (X >= 0) and (X < ClientWidth) and (Y >= 0) and (Y <= ClientHeight)
    and (FState in [bsDown, bsExclusive]);

  if (FState = bsChevronDown) then
  begin
    FState := bsUp;
    Invalidate;
  end;

  if (FState <> bsChevronDown) and not FDown then
  begin
    FState := bsUp;
    Invalidate;
  end;

  if DoClick then
  begin
    if (not Down) and (GroupIndex <> 0) then
      Down := true
    else
      if AllowAllUp then
      Down := false;
    Click;

    Invalidate;
  end;

  if FRepeatTimer <> nil then
    FRepeatTimer.Enabled  := false;
end;

procedure TKsCustomSpeedButton.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 TKsCustomSpeedButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = ChevronMenu) and (Operation = opRemove) then
    ChevronMenu := nil;
end;

function TKsCustomSpeedButton.GeTKsChevronPos: TPoint;
begin
  if Assigned(FChevronMenu) then
  begin
    if MenuPosition = dmpBottom then
    begin
      case FChevronMenu.Alignment of
        paLeft: Result := Point(GetChevronRect.Left - 1, Height);
        paRight: Result := Point(Width + 1, Height);
      else {paCenter}
        Result := Point(Width div 2, Height);
      end;
    end
    else { dmpRight }
    begin
      case FChevronMenu.Alignment of
        paLeft: Result := Point(Width, -1);
        paRight: Result := Point(-1, -1);
      else {paCenter}
        Result := Point(Width div 2, Height);
      end;
    end;
  end
  else
    Result := Point(0, 0);
end;

function TKsCustomSpeedButton.CheckChevronDropDown: Boolean;
begin
  Result := CheckMenuDropDown(PointToSmallPoint(GeTKsChevronPos), True);
end;

function TKsCustomSpeedButton.CheckMenuDropDown(const Pos: TSmallPoint;
  Manual: Boolean): Boolean;
var
  Form: TCustomForm;
begin
  Result := False;
  if csDesigning in ComponentState then Exit;
  if Assigned(FChevronMenu) and (ChevronMenu.AutoPopup or Manual) then
  begin
    Form := GetParentForm(Self);
    if Form <> nil then
      Form.SendCancelMode(nil);
    ChevronMenu.PopupComponent := Self;
    with ClientToScreen(SmallPointToPoint(Pos)) do
      ChevronMenu.Popup(X, Y);
    Result := True;
  end;
end;

function TKsCustomSpeedButton.GetDropDownArrowRect: TRect;
var
  LSize: TPoint;
  LChevronWidth: integer;
begin
  LSize := GetDropDownArrowSize;
  LChevronWidth := GetChevronWidth;
  with Result do
  begin
    Left := GetChevronRect.Right - LChevronWidth + (LChevronWidth - LSize.x) div 2;
    Top := (GetChevronRect.Bottom - LSize.y) div 2;
    Right := Left + LSize.x;
    Bottom := Top + LSize.y
  end;
end;

function TKsCustomSpeedButton.GetGlyphRect: TRect;
var
  LGlyphSize,
    LCaptionSize: TPoint;
  LButtonRect: TRect;
begin
  if ShowGlyph then
    LGlyphSize := GetGlyphSize
  else
    LGlyphSize := Point(0, 0);

  if ShowCaption then
    LCaptionSize := GetCaptionSize
  else
    LCaptionSize := Point(0, 0);

  LButtonRect := GetButtonRect;
  with Result do
  begin
    case Layout of
      blGlyphLeft, blGlyphRight:
        begin
          if (LGlyphSize.x = 0) or not ShowGlyph then
            Left := LButtonRect.Left
          else
            if Margin <> -1 then
              Left := Margin
          else
            if (LCaptionSize.x = 0) or not ShowCaption then
              Left := ((LButtonRect.Right - LButtonRect.Left) - LGlyphSize.x) div 2
          else
            if Spacing <> -1 then
              Left := ((LButtonRect.Right - LButtonRect.Left) - LGlyphSize.x
                - Spacing - LCaptionSize.x) div 2
          else
            Left := ((LButtonRect.Right - LButtonRect.Left) - LGlyphSize.x
              - LCaptionSize.x) div 3;

          Top := ((LButtonRect.Bottom - LButtonRect.Top) - LGlyphSize.y) div 2;
        end;
      blGlyphTop, blGlyphBottom:
        begin
          Left := ((LButtonRect.Right - LButtonRect.Left) - LGlyphSize.x) div 2;

          if (LGlyphSize.y = 0) or not ShowGlyph then
            Top := LButtonRect.Top
          else
            if Margin <> -1 then
            Top := Margin
          else
            if (LCaptionSize.y = 0) or not ShowCaption then
            Top := ((LButtonRect.Bottom - LButtonRect.Top) - LGlyphSize.y) div 2
          else
            if Spacing <> -1 then
            Top := ((LButtonRect.Bottom - LButtonRect.Top) - LGlyphSize.y
              - Spacing - LCaptionSize.y) div 2
          else
            Top := ((LButtonRect.Bottom - LButtonRect.Top) - LGlyphSize.y
              - LCaptionSize.y) div 3;
        end;
    end;

    {Mirror reflection}
    if Layout = blGlyphRight then
      Left := LButtonRect.Right - Left - LGlyphSize.x - 1;

    if Layout = blGlyphBottom then
      Top := LButtonRect.Bottom - Top - LGlyphSize.y - 1;

    Right := Left + LGlyphSize.x;
    Bottom := Top + LGlyphSize.y;
  end;
end;

function TKsCustomSpeedButton.GetCaptionRect: TRect;
var
  LGlyphSize,
    LCaptionSize: TPoint;
  LButtonRect,
    LGlyphRect: TRect;

begin
  LGlyphSize := GetGlyphSize;
  LCaptionSize := GetCaptionSize;
  LButtonRect := GetButtonRect;
  LGlyphRect := GetGlyphRect;

  if Glyph.Empty then
  begin
    Result := Rect(0, 0, GetCaptionSize.X, GetCaptionSize.Y);
    RectCenter(Result, Rect(0, 0, FWidth, FHeight));
    Exit;
  end;

  with Result do
  begin
    case Layout of
      blGlyphLeft:
        begin
          if Spacing <> -1 then
            Left := LGlyphRect.Right + Spacing
          else
            Left := LGlyphRect.Right + ((LButtonRect.Right - LGlyphRect.Right) - LCaptionSize.x) div 2;

          Top := ((LButtonRect.Bottom - LButtonRect.Top) - LCaptionSize.y) div 2;
        end;
      blGlyphTop:
        begin
          Left := ((LButtonRect.Right - LButtonRect.Left) - LCaptionSize.x) div 2;

          if Spacing <> -1 then
            Top := LGlyphRect.Bottom + Spacing
          else
            Top := LGlyphRect.Bottom + ((LButtonRect.Bottom - LGlyphRect.Bottom) - LCaptionSize.y) div 2;
        end;
      blGlyphRight:
        begin
          if Spacing <> -1 then
            Left := LGlyphRect.Left - Spacing - LCaptionSize.x
          else
            Left := ((LGlyphRect.Left - LButtonRect.Left) - LCaptionSize.x) div 2;

          Top := ((LButtonRect.Bottom - LButtonRect.Top) - LCaptionSize.y) div 2;
        end;
      blGlyphBottom:
        begin
          Left := ((LButtonRect.Right - LButtonRect.Left) - LCaptionSize.x) div 2;

          if Spacing <> -1 then
            Top := LGlyphRect.Top - Spacing - LCaptionSize.y
          else
            Top := ((LGlyphRect.Top - LButtonRect.Top) - LCaptionSize.y) div 2;
        end;
    end;

    Right := Left + LCaptionSize.x;
    Bottom := Top + LCaptionSize.y;
  end;
end;

procedure TKsCustomSpeedButton.ActionChange(Sender: TObject;
  CheckDefaults: Boolean);

  procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
  begin
    with Glyph do
    begin
      Width := ImageList.Width;
      Height := ImageList.Height;
      Canvas.Brush.Color := clFuchsia;
      Canvas.FillRect(Rect(0, 0, Width, Height));
      ImageList.Draw(Canvas, 0, 0, Index);
    end;
  end;

begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
      if (Glyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
        (ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
      begin

        CopyImage(ActionList.Images, ImageIndex);
        Invalidate;
      end
end;

procedure TKsCustomSpeedButton.ChevronClick;
begin
  if Assigned(FOnChevronClick) then
    FOnChevronClick(Self);
end;

procedure TKsCustomSpeedButton.GlyphChangedHandler(Sender: TObject);
var
  N: integer;
begin
  if (FGlyph.Height <> 0) and (FGlyph.Width mod FGlyph.Height = 0) then
  begin
    N := FGlyph.Width div FGlyph.Height;
    if N > 4 then
      N := 1;
    SetNumGlyphs(N);
  end;
  Invalidate;
end;

{ Properties }

procedure TKsCustomSpeedButton.SetGlyph(const Value: TBitmap);
begin
  FGlyph.Assign(Value);
end;

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

procedure TKsCustomSpeedButton.SetMargin(const Value: integer);
begin
  if FMargin <> Value then
  begin
    FMargin := Value;
    Invalidate;
  end;
end;

procedure TKsCustomSpeedButton.SetSpacing(const Value: integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Invalidate;
  end;
end;

procedure TKsCustomSpeedButton.SetChevronMenu(const Value: TPopupMenu);
begin
  FChevronMenu := Value;
  if Value <> nil then
    Value.FreeNotification(Self);
end;

procedure TKsCustomSpeedButton.SetFlat(const Value: boolean);
begin
  if FFlat <> Value then
  begin
    FFlat := Value;
    if FFlat then Transparent := true;
    Invalidate;
  end;
end;

procedure TKsCustomSpeedButton.SetDown(const Value: boolean);
begin
  if FDown <> Value then
  begin
    FDown := Value;
    if not Value then
      FState := bsUp
    else
    begin
      if MouseInControl then
      begin
        if GroupIndex = 0 then
          FState := bsDown
        else
          FState := bsExclusive;
      end
      else
      begin
        if GroupIndex = 0 then
          FState := bsUp
        else
          FState := bsExclusive;
      end;
    end;

    if Value then
      UpdateExclusive;

    Invalidate;
  end;
end;

procedure TKsCustomSpeedButton.SetGroupIndex(const Value: Integer);
begin
  if FGroupIndex <> Value then
  begin
    FGroupIndex := Value;
    UpdateExclusive;
    if Down then
    begin
      if Value = 0 then
        FState := bsUp
      else
        FState := bsExclusive
    end;

    Invalidate;
  end;
end;

procedure TKsCustomSpeedButton.SetShowChevron(const Value: boolean);
begin
  if FShowChevron <> Value then
  begin
    FShowChevron := Value;
    if not (csLoading in ComponentState) then
    begin
      if Value then
        Width := Width + GetChevronWidth
      else
        Width := Width - GetChevronWidth;
    end;
    Invalidate;
  end;
end;

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

procedure TKsCustomSpeedButton.SetShowCaption(const Value: boolean);
begin
  if FShowCaption <> Value then
  begin
    FShowCaption := Value;
    Invalidate;
  end;
end;

procedure TKsCustomSpeedButton.SetShowGlyph(const Value: boolean);
begin
  if FShowGlyph <> Value then
  begin
    FShowGlyph := Value;
    Invalidate;
  end;
end;

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

procedure TKsCustomSpeedButton.MouseEnter;
begin
  inherited;
  if FMouseDown then
    FState := bsDown;
  Invalidate;
end;

procedure TKsCustomSpeedButton.MouseLeave;
begin
  inherited;
  if Down and (GroupIndex <> 0) then
    FState := bsExclusive
  else
    if FState <> bsChevronDown then
      FState := bsUp;
  Invalidate;
end;

procedure TKsCustomSpeedButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and Enabled and Visible and
      (Parent <> nil) and Parent.Showing then
    begin

      Click;
      Result := 1;
    end
    else
      inherited;
end;

procedure TKsCustomSpeedButton.CMEnabledChanged(var Message: TMessage);
begin
  if Enabled then
  begin
    if Down and (GroupIndex <> 0) then
      FState := bsExclusive
    else
      FState := bsUp;
  end;
  Invalidate;
end;

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

procedure TKsCustomSpeedButton.CMSysColorChange(var Message: TMessage);
begin
  Invalidate;
end;

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

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

procedure TKsCustomSpeedButton.SetNumGlyphs(const Value: TNumGlyphs);
begin
  if FNumGlyphs <> Value then
  begin
    FNumGlyphs := Value;
    Invalidate;
  end;
end;

procedure TKsCustomSpeedButton.SetBlackAndWhiteGlyph(const Value: boolean);
begin
  if FBlackAndWhiteGlyph <> Value then
  begin
    FBlackAndWhiteGlyph := Value;
    Invalidate;
  end;
end;

{ TKsSpeedDivider }

constructor TKsSpeedDivider.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 8;
  Transparent := true;
end;

procedure TKsSpeedDivider.PaintBuffer;
begin
  inherited ;
  if csDesigning in ComponentState then
  begin
    Buffer.DrawRect(Rect(0, 0, FWidth, FHeight), ckGray);
  end;
end;

{ TKsSpeedContainer }

constructor TKsSpeedContainer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csAcceptsControls];
  Transparent := true;
end;

procedure TKsSpeedContainer.PaintBuffer;
begin
  if csDesigning in ComponentState then
  begin
    Buffer.DrawRect(Rect(0, 0, FWidth, FHeight), ckGray);
  end;
end;

initialization
  RegisterClasses([TKsSpeedContainer, TKsSpeedDivider]);
end.

