begin
    SetFocusBtn (TVrTimerSpinButton(Sender));
    if (FFocusControl <> nil) and FFocusControl.TabStop and
        FFocusControl.CanFocus and (GetFocus <> FFocusControl.Handle) then
      FFocusControl.SetFocus
    else if TabStop and (GetFocus <> Handle) and CanFocus then
      SetFocus;
  end;
end;

procedure TVrSpinner.BtnClick(Sender: TObject);
begin
  if Sender = FUpButton then
  begin
    if Assigned(FOnUpClick) then FOnUpClick(Self);
  end
  else
    if Assigned(FOnDownClick) then FOnDownClick(Self);
end;

procedure TVrSpinner.SetFocusBtn (Btn: TVrTimerSpinButton);
begin
  if TabStop and CanFocus and  (Btn <> FFocusedButton) then
  begin
    FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState - [tbFocusRect];
    FFocusedButton := Btn;
    if (GetFocus = Handle) then
    begin
       FFocusedButton.TimeBtnState := FFocusedButton.TimeBtnState + [tbFocusRect];
       Repaint;
    end;
  end;
end;

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

procedure TVrSpinner.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  FUpButton.Enabled := Enabled;
  FDownButton.Enabled := Enabled;
end;

procedure TVrSpinner.Loaded;
var
  W, H: Integer;
begin
  inherited Loaded;
  W := Width;
  H := Height;
  ChangeSize(W, H);
  if (W <> Width) or (H <> Height) then
    inherited SetBounds (Left, Top, W, H);
end;

procedure TVrSpinner.SetOrientation(Value: TVrOrientation);
begin
  if FOrientation <> Value then
  begin
    FOrientation := Value;
    if FUpButton <> nil then FUpButton.Free;
    if FDownButton <> nil then FDownButton.Free;
    if Value = voVertical then
    begin
      FUpButton := CreateButton(stUp);
      FDownButton := CreateButton(stDown);
    end
    else
    begin
      FUpButton := CreateButton(stLeft);
      FDownButton := CreateButton(stRight);
    end;
    if csDesigning in ComponentState then
    begin
      if Align = alNone then
        BoundsRect := Bounds(Left, Top, Height, Width)
      else RecreateWnd;
    end;
  end;
end;

procedure TVrSpinner.PaletteModified(Sender: TObject);
begin
  FUpButton.Palette.Assign(FPalette);
  FDownButton.Palette.Assign(FPalette);
end;

procedure TVrSpinner.SetPalette(Value: TVrPalette);
begin
  FPalette.Assign(Value);
end;

{ VrSpinButton }
constructor TVrSpinButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque, csClickEvents] - [csDoubleClicks];
  Height := 25;
  Width := 25;
  Color := clBtnFace;
  ParentColor := true;
  FBtnType := stUp;
  FPalette := TVrPalette.Create;
  FPalette.OnChange := PaletteModified;

  ImageList := TImageList.Create(nil);
  ImageList.DrawingStyle := dsTransparent;
  Bitmap := TBitmap.Create;
  LoadBitmaps;
end;

destructor TVrSpinButton.Destroy;
begin
  FPalette.Free;
  Bitmap.Free;
  ImageList.Free;
  inherited Destroy;
end;

procedure TVrSpinButton.LoadBitmaps;
begin
  ImageList.Width := 21;
  ImageList.Height := 16;
  if FBtnType in [stLeft, stRight] then
  begin
    ImageList.Width := 17;
    ImageList.Height := 21;
  end;
  Bitmap.Handle := LoadBitmap(hInstance, ResId[FBtnType]);
  FPalette.ToBMP(Bitmap, clGreen, clLime);
  ImageList.Clear;
  ImageList.AddMasked(Bitmap, Bitmap.TransparentColor);
  ImageList.GetBitmap(0, Bitmap);
  Bitmap.Mask(Bitmap.TransparentColor);
end;

procedure TVrSpinButton.SetBtnType(Value: TVrSpinButtonType);
begin
  if FBtnType <> Value then
  begin
    FBtnType := Value;
    LoadBitmaps;
    UpdateControlCanvas;
  end;
end;

procedure TVrSpinButton.SetPalette(Value: TVrPalette);
begin
  FPalette.Assign(Value);
end;

procedure TVrSpinButton.PaletteModified(Sender: TObject);
begin
  LoadBitmaps;
  UpdateControlCanvas;
end;

function TVrSpinButton.ImageRect: TRect;
var
  X, Y: Integer;
begin
  X := (Width - ImageList.Width) div 2;
  Y := (Height - ImageList.Height) div 2;
  Result := Bounds(X, Y, ImageList.Width, ImageList.Height);
end;

procedure TVrSpinButton.Paint;
var
  Index: Integer;
begin
  ClearClientCanvas;

  Index := 1;
  if Enabled then
  begin
    if (MouseBtnDown) then Index := 2;
  end else Index := 0;

  {$IFDEF VER110}
    ImageList.Draw(Canvas,
      ImageRect.Left, ImageRect.Top, Index, True);
  {$ELSE}
    ImageList.Draw(Canvas,
      ImageRect.Left, ImageRect.Top, Index);
  {$ENDIF}
end;

function TVrSpinButton.InControl(X, Y: Integer): Boolean;
var
  Px, Py: Integer;
begin
  Px := ImageRect.Right - X - 1;
  Py := ImageRect.Bottom - Y - 1;
  Result := (Bitmap.Canvas.Pixels[Px, Py] = clBlack) and
            (Canvas.Pixels[X, Y] <> clBlack);
end;

procedure TVrSpinButton.Click;
begin
end;

procedure TVrSpinButton.DoClick;
begin
  inherited Click;
end;

procedure TVrSpinButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  if (Button = mbLeft) and Enabled then
    if InControl(X, Y) then
    begin
      MouseBtnDown := true;
      MouseCapture := true;
      UpdateControlCanvas;
    end;
end;

procedure TVrSpinButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited;
  MouseBtnDown := false;
  MouseCapture := false;
  UpdateControlCanvas;
  if InControl(X, Y) then DoClick;
end;

{TVrTimerSpinButton}
destructor TVrTimerSpinButton.Destroy;
begin
  if FRepeatTimer <> nil then
    FRepeatTimer.Free;
  inherited Destroy;
end;

procedure TVrTimerSpinButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown (Button, Shift, X, Y);
  if tbAllowTimer in FTimeBtnState then
  begin
    if FRepeatTimer = nil then
      FRepeatTimer := TVrTimer.Create(Self);
    FRepeatTimer.Enabled := false;
    FRepeatTimer.OnTimer := TimerExpired;
    FRepeatTimer.Interval := InitRepeatPause;
    FRepeatTimer.TimerType := ttSystem;
    FRepeatTimer.Enabled := True;
  end;
end;

procedure TVrTimerSpinButton.MouseUp(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  inherited MouseUp(Button, Shift, X, Y);
  if FRepeatTimer <> nil then
    FRepeatTimer.Enabled  := False;
end;

procedure TVrTimerSpinButton.TimerExpired(Sender: TObject);
begin
  FRepeatTimer.Interval := RepeatPause;
  if (MouseBtnDown) and MouseCapture then
  begin
    try
      DoClick;
    except
      FRepeatTimer.Enabled := False;
      raise;
    end;
  end;
end;

procedure TVrTimerSpinButton.Paint;
var
  R: TRect;
begin
  inherited Paint;
  if tbFocusRect in FTimeBtnState then
  begin
    R := Bounds(0, 0, Width, Height);
    InflateRect(R, -3, -3);
    Canvas.Brush.Style := bsSolid;
    Canvas.Brush.Color := clBlack;
    Canvas.FrameRect(R);
  end;
end;


end.