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

  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 KsSpinButtons;

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

interface

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

const
  InitRepeatPause = 400;  { pause before repeat timer (ms) }
  RepeatPause     = 100;  { pause before hint window displays (ms)}
  DefaultWidth    = 15;   { deafult spinbutton width }

type

  TKsSpinAlign = (saLeft, saRight);
  TKsChangingEvent = procedure (Sender: TObject; var AllowChange: Boolean) of object;

{ TKsCustomSpinButton }

  TKsCustomSpinButton = class (TKsCustomControl)
  private
    FUpButton: TKsCustomSpeedButton;
    FDownButton: TKsCustomSpeedButton;
    FFocusedButton: TKsCustomSpeedButton;
    FAssociate: TWinControl;
    FOnUpClick: TNotifyEvent;
    FOnDownClick: TNotifyEvent;
    FSliderPos: TPoint;
    FSliderActive: boolean;
    FEnabledSlider: boolean;
    FIncrement: integer;
    FMin: integer;
    FPosition: integer;
    FMax: integer;
    FOnChanging: TKsChangingEvent;
    FSpinAlign: TKsSpinAlign;
    FChanging: boolean;
    FCheckTimer: TTimer;
    procedure CheckAssosiate(Sender: TObject);

    function GetUpGlyph: TBitmap;
    function GetDownGlyph: TBitmap;
    procedure SetUpGlyph(Value: TBitmap);
    procedure SetDownGlyph(Value: TBitmap);
    function GetUpNumGlyphs: TNumGlyphs;
    function GetDownNumGlyphs: TNumGlyphs;
    procedure SetUpNumGlyphs(Value: TNumGlyphs);
    procedure SetDownNumGlyphs(Value: TNumGlyphs);
    procedure BtnClick(Sender: TObject);
    procedure BtnMouseDown (Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SetFocusBtn (Btn: TKsCustomSpeedButton);
    procedure AdjustSize (var W, H: Integer); reintroduce;
    procedure WMSize(var Message: TWMSize);  message WM_SIZE;
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure SetIncrement(const Value: integer);
    procedure SetMax(const Value: integer);
    procedure SetMin(const Value: integer);
    procedure SetPosition(const Value: integer);
    procedure SetSpinAlign(const Value: TKsSpinAlign);
    procedure SetAssociate(const Value: TWinControl);
    procedure SetEnabledSlider(const Value: boolean);
  protected
    { VCL }
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;

    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    { KS Dev }
    procedure MouseLeave; override;
    procedure MouseEnter; override;
    { }
    function CreateButton: TKsCustomSpeedButton; virtual;
    procedure UpdateAssociate;
    procedure UpdateAssociatePosition;

    property UpButton: TKsCustomSpeedButton read FUpButton;
    property DownButton: TKsCustomSpeedButton read FDownButton;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;

    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
    procedure Invalidate; override;
  published
    property Align;
    property Anchors;
    property Associate: TWinControl read FAssociate write SetAssociate;
    property SpinAlign: TKsSpinAlign read FSpinAlign write SetSpinAlign;
    property DownGlyph: TBitmap read GetDownGlyph write SetDownGlyph;
    property DownNumGlyphs: TNumGlyphs read GetDownNumGlyphs write SetDownNumGlyphs default 1;
    property EnabledSlider: boolean read FEnabledSlider write SetEnabledSlider default true;
    property Increment: integer read FIncrement write SetIncrement;
    property Max: integer read FMax write SetMax;
    property Min: integer read FMin write SetMin;
    property Position: integer read FPosition write SetPosition;
    property TabStop;
    property UpGlyph: TBitmap read GetUpGlyph write SetUpGlyph;
    property UpNumGlyphs: TNumGlyphs read GetUpNumGlyphs write SetUpNumGlyphs default 1;
    property OnChanging: TKsChangingEvent read FOnChanging write FOnChanging;
    property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
    property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
  end;

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

{$R *.res}

type
  THackControl = class(TControl);

{ TKsCustomSpinButton }

constructor TKsCustomSpinButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Transparent := true;

  FUpButton := CreateButton;
  FUpButton.ShowCaption := false;
  FUpButton.OnClick := BtnClick;
  FUpButton.OnMouseDown := BtnMouseDown;
  FUpButton.Enabled := true;
  FUpButton.AllowTimer := true;
  FUpButton.Parent := Self;

  FDownButton := CreateButton;
  FDownButton.ShowCaption := false;
  FDownButton.OnClick := BtnClick;
  FDownButton.OnMouseDown := BtnMouseDown;
  FDownButton.Enabled := true;
  FDownButton.AllowTimer := true;
  FDownButton.Parent := Self;

  FEnabledSlider := true;
  FMax := 100;
  FMin := 0;
  FPosition := 0;
  FIncrement := 1;
  FSpinAlign := saRight;

  UpGlyph := nil;
  DownGlyph := nil;

  Width := DefaultWidth;
  Height := 21;

  FFocusedButton := FUpButton;

  FCheckTimer := TTimer.Create(Self);
  FCheckTimer.OnTimer := CheckAssosiate;
  FCheckTimer.Interval := 400;

  FUpButton.Visible := true;
  FDownButton.Visible := true;
end;

destructor TKsCustomSpinButton.Destroy;
begin
  FCheckTimer.Free;
  inherited Destroy;
end;

procedure TKsCustomSpinButton.Loaded;
var
  W, H: Integer;
begin
  inherited Loaded;
  UpdateAssociatePosition;

  W := Width;
  H := Height;
  AdjustSize(W, H);
  if (W <> Width) or (H <> Height) then
  begin
    inherited SetBounds (Left, Top, W, H);
    ResizeBuffer;
  end;

  if FAssociate <> nil then
    FCheckTimer.Enabled  := True;

  Invalidate;
end;

procedure TKsCustomSpinButton.Invalidate;
begin
  inherited;
  if FDownButton <> nil then FDownButton.Invalidate;
  if FUpButton <> nil then FUpButton.Invalidate;
end;

function TKsCustomSpinButton.CreateButton: TKsCustomSpeedButton;
begin
  Result := TKsCustomSpeedButton.Create(Self);
end;

{ Position Routines }

procedure TKsCustomSpinButton.CheckAssosiate(Sender: TObject);
var
  S: string;
  Val: integer;
begin
  if FChanging then Exit;

  S := THackControl(FAssociate).Caption;
  Val := StrToIntDef(S, FPosition);
  if Val <> FPosition then
    Position := Val;
end;

procedure TKsCustomSpinButton.UpdateAssociate;
var
  S: string;
  Val: integer;
begin
  if FAssociate <> nil then
  begin
    FChanging := true;
    try
      S := THackControl(FAssociate).Caption;
      Val := StrToIntDef(S, MaxInt);
      if (Val <> FPosition) then
        THackControl(FAssociate).Caption := IntToStr(FPosition);
    finally
      FChanging := false;
    end;
  end;
end;

procedure TKsCustomSpinButton.UpdateAssociatePosition;
var
  R: TRect;
begin
  if FAssociate <> nil then
  begin
    R := Rect(0, 0, DefaultWidth, FAssociate.Height);
    if SpinAlign = saLeft then
      OffsetRect(R, FAssociate.Left - DefaultWidth, FAssociate.Top)
    else
      OffsetRect(R, FAssociate.Left + FAssociate.Width, FAssociate.Top);

    BoundsRect := R;
  end;
end;

procedure TKsCustomSpinButton.AdjustSize(var W, H: Integer);
var
  Mid: Integer;
begin
  if (FUpButton = nil) or (csLoading in ComponentState) then Exit;

  Mid := H div 2;
  if FEnabledSlider then
    Mid := Mid - 1;

  FUpButton.SetBounds(0, 0, W, Mid);
  FDownButton.SetBounds(0, Mid + 1, W, Mid);
  FDownButton.Top := Height - FDownButton.Height;
end;

procedure TKsCustomSpinButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  W, H: Integer;
begin
  W := AWidth;
  H := AHeight;
  AdjustSize(W, H);
  inherited SetBounds (ALeft, ATop, W, H);
end;

procedure TKsCustomSpinButton.WMSize(var Message: TWMSize);
var
  W, H: Integer;
begin
  inherited;

  { check for minimum size }
  W := Width;
  H := Height;
  AdjustSize (W, H);
  if (W <> Width) or (H <> Height) then
    inherited SetBounds(Left, Top, W, H);
  Message.Result := 0;
end;

procedure TKsCustomSpinButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  case Key of
    VK_UP:
      begin
        SetFocusBtn (FUpButton);
        FUpButton.Click;
      end;
    VK_DOWN:
      begin
        SetFocusBtn (FDownButton);
        FDownButton.Click;
      end;
    VK_SPACE:
      FFocusedButton.Click;
  end;
end;

procedure TKsCustomSpinButton.BtnMouseDown (Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
  begin
    SetFocusBtn(TKsCustomSpeedButton (Sender));
    if (FAssociate <> nil) and FAssociate.TabStop and 
        FAssociate.CanFocus and (GetFocus <> FAssociate.Handle) then
      FAssociate.SetFocus
    else if TabStop and (GetFocus <> Handle) and CanFocus then
      SetFocus;
  end;
end;

procedure TKsCustomSpinButton.BtnClick(Sender: TObject);
begin
  if Sender = FUpButton then
  begin
    Position := FPosition + FIncrement; 
    if Assigned(FOnUpClick) then FOnUpClick(Self);
  end
  else
  begin
    Position := FPosition - FIncrement;
    if Assigned(FOnDownClick) then FOnDownClick(Self);
  end;
end;

procedure TKsCustomSpinButton.SetFocusBtn (Btn: TKsCustomSpeedButton);
begin
  if TabStop and CanFocus and (Btn <> FFocusedButton) then
  begin
    FFocusedButton := Btn;
    if (GetFocus = Handle) then
      Invalidate;
  end;
end;

procedure TKsCustomSpinButton.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

{ Slider Change }

procedure TKsCustomSpinButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  SliderRect: TRect;
begin
  inherited;

  if (mbLeft = Button) and (FEnabledSlider) then
  begin
    SliderRect := Rect(0, FHeight div 2 - 1, FWidth, FHeight div 2 + 1);
    if PtInRect(SliderRect, Point(X, Y)) then
    begin
      FSliderPos := Point(X, Y);
      FSliderActive := true;
    end;
  end;
end;

procedure TKsCustomSpinButton.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  SliderRect: TRect;
  Delta: integer;
begin
  inherited;

  if not FEnabledSlider then Exit;
  
  if FSliderActive then
  begin
    Delta := FSliderPos.Y - Y;
    Position := FPosition + FIncrement * Delta;
  end
  else
  begin
    SliderRect := Rect(0, FHeight div 2 - 1, FWidth, FHeight div 2 + 1);
    if PtInRect(FUpButton.BoundsRect, Point(X, Y)) or
       PtInRect(FDownButton.BoundsRect, Point(X, Y))
    then
      Cursor := crDefault
    else
      Cursor := crSizeNS
  end;
end;

procedure TKsCustomSpinButton.MouseEnter;
begin
  inherited;
end;

procedure TKsCustomSpinButton.MouseLeave;
begin
  inherited;
  Cursor := crDefault;
end;

procedure TKsCustomSpinButton.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited;
  FSliderActive := false;
end;

procedure TKsCustomSpinButton.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FAssociate) then
  begin
    FCheckTimer.Enabled  := false;
    FAssociate := nil;
  end;
end;

{ Properties }

function TKsCustomSpinButton.GetUpGlyph: TBitmap;
begin
  Result := FUpButton.Glyph;
end;

procedure TKsCustomSpinButton.SetUpGlyph(Value: TBitmap);
begin
  if Value <> nil then
    FUpButton.Glyph := Value
  else
  begin
    FUpButton.Glyph.Handle := LoadBitmap(HInstance, 'KS_SpinUp');
    FUpButton.NumGlyphs := 1;
    FUpButton.Invalidate;
  end;
end;

function TKsCustomSpinButton.GetUpNumGlyphs: TNumGlyphs;
begin
  Result := FUpButton.NumGlyphs;
end;

procedure TKsCustomSpinButton.SetUpNumGlyphs(Value: TNumGlyphs);
begin
  FUpButton.NumGlyphs := Value;
end;

function TKsCustomSpinButton.GetDownGlyph: TBitmap;
begin
  Result := FDownButton.Glyph;
end;

procedure TKsCustomSpinButton.SetDownGlyph(Value: TBitmap);
begin
  if Value <> nil then
    FDownButton.Glyph := Value
  else
  begin
    FDownButton.Glyph.Handle := LoadBitmap(HInstance, 'KS_SpinDown');
    FUpButton.NumGlyphs := 1;
    FDownButton.Invalidate;
  end;
end;

function TKsCustomSpinButton.GetDownNumGlyphs: TNumGlyphs;
begin
  Result := FDownButton.NumGlyphs;
end;

procedure TKsCustomSpinButton.SetDownNumGlyphs(Value: TNumGlyphs);
begin
  FDownButton.NumGlyphs := Value;
end;

procedure TKsCustomSpinButton.SetIncrement(const Value: integer);
begin
  if FIncrement <> Value then
    FIncrement := Value;
end;

procedure TKsCustomSpinButton.SetMax(const Value: integer);
begin
  if FMax <> Value then
  begin
    FMax := Value;
    if FMax < FMin then FMax := FMin;
    if FPosition > FMax then FPosition := FMax;
    UpdateAssociate;
  end;
end;

procedure TKsCustomSpinButton.SetMin(const Value: integer);
begin
  if FMin <> Value then
  begin
    FMin := Value;
    if FMin > FMax then FMin := FMax;
    if FPosition < FMin then FPosition := FMin;
    UpdateAssociate;
  end;
end;

procedure TKsCustomSpinButton.SetPosition(const Value: integer);
var
  OldPosition: integer;
  AllowChange: boolean;
begin
  if FPosition <> Value then
  begin
    OldPosition := FPosition;
    
    FPosition := Value;
    if FPosition < FMin then FPosition := FMin;
    if FPosition > FMax then FPosition := FMax;

    AllowChange := true;

    if Assigned(FOnChanging) then
    begin
      FOnChanging(Self, AllowChange);
      if not AllowChange then
        FPosition := OldPosition;
    end;

    if AllowChange then
      UpdateAssociate;
  end;
end;

procedure TKsCustomSpinButton.SetSpinAlign(const Value: TKsSpinAlign);
begin
  if FSpinAlign <> Value then
  begin
    FSpinAlign := Value;
    UpdateAssociatePosition;
  end;
end;

procedure TKsCustomSpinButton.SetAssociate(const Value: TWinControl);
begin
  FAssociate := Value;

  if Value <> nil then
  begin
    FCheckTimer.Enabled  := true;
    UpdateAssociate;
    UpdateAssociatePosition;
  end;
end;

procedure TKsCustomSpinButton.SetEnabledSlider(const Value: boolean);
var
  W, H: integer;
begin
  if FEnabledSlider <> Value then
  begin
    FEnabledSlider := Value;
    W := Width;
    H := Height;
    AdjustSize(W, H);
  end;
end;

end.
