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

  Custom ScrollBar
  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 KsScrollBars;

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

interface

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

type
  TScrollBarKind = (sbHorizontal, sbVertical);
  TScrollBarInc = 1..32767;

  TKsCustomScrollBar = class(TKsGraphicControl)
  private
    FLastMouseX, FLastMouseY: integer;
    FRepeatTimer: TTimer;

    FSliderCatchCoord: integer;

    FMouseOnSlider: boolean;
    FMouseOnLeftTopBtn: boolean;
    FMouseOnRightBottomBtn: boolean;
    FMouseOnLeftTopArea: boolean;
    FMouseOnRightBottomArea: boolean;

    FMDownOnLeftTopBtn: boolean;
    FMDownOnRightBottomBtn: boolean;
    FMDownOnLeftTopArea: boolean;
    FMDownOnRightBottomArea: boolean;

    FPosition: integer;
    FMin: integer;
    FBorderWidth: integer;
    FMax: integer;
    FPageSize: integer;
    FKind: TScrollBarKind;
    FShowButtons: boolean;
    FLargeChange: TScrollBarInc;
    FSmallChange: TScrollBarInc;
    FOnChange: TNotifyEvent;
    FOnScroll: TKsScrollEvent;
    FAutoScrollUp: boolean;
    FAutoScrollDown: boolean;
    function CalculateSliderSize: integer;
    procedure SetBorderWidth(const Value: integer);
    procedure SetMax(const Value: integer);
    procedure SetMin(const Value: integer);
    procedure SetPageSize(const Value: integer);
    procedure SetPosition(const Value: integer);
    procedure SetKind(const Value: TScrollBarKind);
    procedure SetShowButtons(const Value: boolean);

    function GetSliderPressed: boolean;
    function GetLeftTopBtnPressed: boolean;
    function GetRightBottomBtnPressed: boolean;
    function GetLeftTopAreaPressed: boolean;
    function GetRightBottomAreaPressed: boolean;

    procedure PartPress(FirstTime: boolean);

    procedure TimerExpired(Sender: TObject);

    procedure SetAutoSrcollUp(const Value: boolean);
    procedure SetAutoSrcollDown(const Value: boolean);
  protected
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;

    procedure Change; dynamic;
    procedure Scroll(ScrollCode: TKsScrollCode; var ScrollPos: Integer); dynamic;
    function PositionCoordinate(APos: integer): word;
    function CoordinatePosition(ACoord: word): integer;

    procedure PaintBuffer; override;

    procedure DrawLeftTopBtn; virtual;
    procedure DrawRightBottomBtn; virtual;
    procedure DrawSlider; virtual;
    procedure DrawBackground; virtual;
    procedure DrawBorder; virtual;

    function IsSliderVizible: boolean;
    function GetBtnSize: integer; virtual;
    function GetSliderSize: integer; virtual;
    function GetLeftTopBtnRect: TRect; virtual;
    function GetRightBottomBtnRect: TRect; virtual;
    function GetSliderRect: TRect; virtual;
    function GetBackgroundRect: TRect; virtual;
    function GetLeftTopAreaRect: TRect; virtual;
    function GetRightBottomAreaRect: TRect; virtual;
    function PtInLeftTopBtn(x, y: integer): boolean; virtual;
    function PtInRightBottomBtn(x, y: integer): boolean; virtual;
    function PtInSlider(x, y: integer): boolean; virtual;
    function PtInLeftTopArea(x, y: integer): boolean; virtual;
    function PtInRightBottomArea(x, y: integer): boolean; virtual;
    { Events }
    procedure MouseLeave; 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;
    procedure ImitateKeyDown(var Key: word; Shift: TShiftState);
    { Internal Properties }
    property MouseOnSlider: boolean read FMouseOnSlider;
    property SliderPressed: boolean read GetSliderPressed;
    property MouseOnLeftTopBtn: boolean read FMouseOnLeftTopBtn;
    property LeftTopBtnPressed: boolean read GetLeftTopBtnPressed;
    property MouseOnRightBottomBtn: boolean read FMouseOnRightBottomBtn;
    property RightBottomBtnPressed: boolean read GetRightBottomBtnPressed;
    property MouseOnLeftTopArea: boolean read FMouseOnLeftTopArea;
    property LeftTopAreaPressed: boolean read GetLeftTopAreaPressed;
    property MouseOnRightBottomArea: boolean read FMouseOnRightBottomArea;
    property RightBottomAreaPressed: boolean read GetRightBottomAreaPressed;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure UpdateSytemSize;

    property AutoScrollUp : boolean read FAutoScrollUp write SetAutoSrcollUp;
    property AutoScrollDown : boolean read FAutoScrollDown write SetAutoSrcollDown;
  published
    { Properties }
    property Align;
    property Anchors;
    property BiDiMode;
    { Specifies the distance, in pixels, between the border and bar area. }
    property BorderWidth: integer read FBorderWidth write SetBorderWidth default 1;
    property ShowButtons: boolean read FShowButtons write SetShowButtons default true;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Kind: TScrollBarKind read FKind write SetKind default sbHorizontal;
    property LargeChange: TScrollBarInc read FLargeChange write FLargeChange default 1;
    property Max: integer read FMax write SetMax default 100;
    property Min: integer read FMin write SetMin default 0;
    property PageSize: integer read FPageSize write SetPageSize default 0;
    property ParentBiDiMode;
    property ParentShowHint;
    property PopupMenu;
    property Position: integer read FPosition write SetPosition default 0;
    property ShowHint;
    property SmallChange: TScrollBarInc read FSmallChange write FSmallChange default 1;
    property Visible;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnScroll: TKsScrollEvent read FOnScroll write FOnScroll;
    property OnStartDock;
    property OnStartDrag;
  end;

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

procedure DrawScrlBarRaisedBtn(Buffer: TKsBitmap; Left, Top, Right, Bottom: integer);
var
  TmpRect: TRect;
begin
  with Buffer do
  begin
    FillRect(Rect(Left, Top, Right, Bottom), KColor(clBtnFace));

    TmpRect := Rect(Left + 1, Top + 1, Right - 1, Bottom - 1);
    DrawEdge(TmpRect, KColor(clBtnHighlight), KColor(clBtnShadow));
    TmpRect := Rect(Left, Top, Right, Bottom);
    DrawEdge(TmpRect, KColor(cl3DLight), KColor(cl3DDkShadow));
  end;
end;

procedure DrawScrlBarLoweredBtn(Buffer: TKsBitmap; Left, Top, Right, Bottom: integer);
begin
  with Buffer do
  begin
    FillRect(Rect(Left, Top, Right, Bottom), KColor(clBtnFace));
    DrawRect(Rect(Left, Top, Right, Bottom), KColor(clBtnShadow));
  end;
end;

{ TKsCustomScrollBar ==========================================================}

constructor TKsCustomScrollBar.Create;
begin
  inherited Create(AOwner);

  Width := 121;
  FBorderWidth := 1;
  Height := GetSystemMetrics(SM_CYVTHUMB) + FBorderWidth * 2;

  FMin := 0;

  FMax := 100;
  FPageSize := 0;
  FPosition := 0;
  FLargeChange := 1;
  FSmallChange := 1;

  FKind := sbHorizontal;
  FShowButtons := true;

  FSliderCatchCoord := -1;
  FMouseOnSlider := False;
  FMouseOnLeftTopBtn := false;
  FMDownOnLeftTopBtn := false;
  FMouseOnRightBottomBtn := false;
  FMDownOnRightBottomBtn := false;
  FMouseOnLeftTopArea := false;
  FMDownOnLeftTopArea := false;

  FAutoScrollUp := false;
  FAutoScrollDown := false;

  FLastMouseX := -1;
  FLastMouseY := -1;

  ControlStyle := ControlStyle + [csCaptureMouse];
end;

destructor TKsCustomScrollBar.Destroy;
begin
  if FRepeatTimer <> nil then
  begin
    FRepeatTimer.Free;
    FRepeatTimer := nil;
  end;
  inherited;
end;

procedure TKsCustomScrollBar.UpdateSytemSize;
begin
  if Kind = sbHorizontal then
    Height := GetSystemMetrics(SM_CYVTHUMB)+BorderWidth*2
  else
    Width := GetSystemMetrics(SM_CYVTHUMB)+BorderWidth*2;
end;

function TKsCustomScrollBar.CalculateSliderSize: integer;
var
  LBackRect: TRect;
  LScaleSize: integer;
begin
  LBackRect := GetBackgroundRect;
  if Kind = sbHorizontal then
    LScaleSize := LBackRect.Right - LBackRect.Left
  else
    LScaleSize := LBackRect.Bottom - LBackRect.Top;

  Result := Round((PageSize * LScaleSize) / (Max - Min+1));
  if Result < GetSystemMetrics(SM_CYVTHUMB) div 3 * 2 then
    Result := GetSystemMetrics(SM_CYVTHUMB) div 3 * 2;
end;

function TKsCustomScrollBar.PositionCoordinate(APos: integer): word;
var
  LBackRect: TRect;
  LScaleSize: integer;
  LVirtScaleSize : integer;
begin
  LBackRect := GetBackgroundRect;
  LVirtScaleSize := Max - Min-PageSize;
  if PageSize <> 0 then
    LVirtScaleSize := LVirtScaleSize+1;

  if Kind = sbHorizontal then
  begin
    LScaleSize := LBackRect.Right - LBackRect.Left - GetSliderSize;
    if ((Max - Min-PageSize+1) > 0) and (LVirtScaleSize > 0) then
    begin
      if (Position <= Max-PageSize+1) then
        Result := Round((LScaleSize * (Position - Min)) / LVirtScaleSize) + LBackRect.Left
      else
        Result := LScaleSize + LBackRect.Left;
    end
    else
      Result := LBackRect.Left;
  end
  else
  begin
    LScaleSize := LBackRect.Bottom - LBackRect.Top- GetSliderSize;
    if ((Max - Min-PageSize+1) > 0) and (LVirtScaleSize > 0) then
    begin
      if (Position <= Max-PageSize+1) then
        Result := Round((LScaleSize * (Position - Min)) / LVirtScaleSize) + LBackRect.Top
      else
        Result := LScaleSize + LBackRect.Top;
    end
    else
      Result := LBackRect.Top;
  end;
end;

function TKsCustomScrollBar.CoordinatePosition(ACoord: word): integer;
var
  LBackRect: TRect;
  LScaleSize: integer;
  LVirtScaleSize : integer;
begin
  LBackRect := GetBackgroundRect;
  LVirtScaleSize := Max - Min-PageSize;
  if PageSize <> 0 then
    LVirtScaleSize := LVirtScaleSize+1;
  if Kind = sbHorizontal then
  begin
    LScaleSize := LBackRect.Right - LBackRect.Left - GetSliderSize;
    if (LScaleSize <> 0) and (LVirtScaleSize > 0) then
      Result := Round(((ACoord - LBackRect.Left) * LVirtScaleSize) / LScaleSize + Min)
    else
      Result := 0;
  end
  else
  begin
    LScaleSize := LBackRect.Bottom - LBackRect.Top - GetSliderSize;
    if (LScaleSize <> 0) and (LVirtScaleSize > 0) then
      Result := Round(((ACoord - LBackRect.Top) * LVirtScaleSize) / LScaleSize + Min)
    else
      Result := 0;
  end;

  if Result < Min then
    Result := Min;
  if Result > Max-PageSize+1 then
    Result := Max-PageSize+1;
end;

procedure TKsCustomScrollBar.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;

procedure TKsCustomScrollBar.Scroll(ScrollCode: TKsScrollCode;
  var ScrollPos: Integer);
begin
  if Assigned(FOnScroll) then FOnScroll(Self, ScrollCode, ScrollPos);
end;

procedure TKsCustomScrollBar.DrawBackground;
begin
  Buffer.FillHalftoneRect(GetBackgroundRect, KColor(clScrollBar), KColor(clBtnHighlight));
end;

procedure TKsCustomScrollBar.DrawBorder;
var
  TmpRect: TRect;
begin
  TmpRect := Rect(0, 0, Width, Height);
  if BorderWidth > 0 then
    Buffer.DrawEdge(TmpRect, KColor(clBtnShadow), KColor(clBtnHighlight));
end;

procedure TKsCustomScrollBar.DrawLeftTopBtn;
var
  TmpRect: TRect;
  Flags : UINT;
begin
  TmpRect := GetLeftTopBtnRect;

  if Kind = sbHorizontal then
    Flags := DFCS_SCROLLLEFT
  else
    Flags := DFCS_SCROLLUP;

  if LeftTopBtnPressed then
    Flags := Flags or DFCS_PUSHED or DFCS_FLAT;

  if (Enabled = false) and not (csDesigning in ComponentState) then
    Flags := Flags or DFCS_INACTIVE;

  DrawFrameControl(Buffer.DC, TmpRect, DFC_SCROLL, Flags);
end;

procedure TKsCustomScrollBar.DrawRightBottomBtn;
var
  TmpRect: TRect;
  Flags : UINT;
begin
  TmpRect := GetRightBottomBtnRect;

  if Kind = sbHorizontal then
    Flags := DFCS_SCROLLRIGHT
  else
    Flags := DFCS_SCROLLDOWN;

  if RightBottomBtnPressed then
    Flags := Flags or DFCS_PUSHED or DFCS_FLAT;

  if (Enabled = false) and not (csDesigning in ComponentState) then
    Flags := Flags or DFCS_INACTIVE;

  DrawFrameControl(Buffer.DC, TmpRect, DFC_SCROLL, Flags);
end;

procedure TKsCustomScrollBar.DrawSlider;
var
  TmpRect: TRect;
begin
  TmpRect := GetSliderRect;

  with TmpRect do
  begin
    if SliderPressed then
      DrawScrlBarLoweredBtn(Buffer, Left, Top, Right, Bottom)
    else
      DrawScrlBarRaisedBtn(Buffer, Left, Top, Right, Bottom);
  end;
end;

function TKsCustomScrollBar.GetBackgroundRect: TRect;
var
  LBtnSize: integer;
begin
  Result := RectOffset(Rect(0, 0, Width, Height), -BorderWidth);
  LBtnSize := GetBtnSize;
  if ShowButtons then
    with Result do
      if Kind = sbHorizontal then
      begin
        Left := Left + LBtnSize;
        Right := Right - LBtnSize;
      end
      else
      begin
        Top := Top + LBtnSize;
        Bottom := Bottom - LBtnSize;
      end;
end;

function TKsCustomScrollBar.GetBtnSize: integer;
var
  TmpSize: integer;
begin
  Result := GetSystemMetrics(SM_CYVTHUMB);
  if Kind = sbHorizontal then
    TmpSize := Width
  else
    TmpSize := Height;

  if Result * 2 > TmpSize - BorderWidth * 2 then
    Result := (TmpSize - BorderWidth * 2) div 2
end;

function TKsCustomScrollBar.GetLeftTopBtnRect: TRect;
begin
  with Result do
    if Kind = sbHorizontal then
    begin
      Left := BorderWidth;
      Top := BorderWidth;
      Right := Left + GetBtnSize;
      Bottom := Height - BorderWidth;
    end
    else
    begin
      Left := BorderWidth;
      Top := BorderWidth;
      Right := Width - BorderWidth;
      Bottom := Top + GetBtnSize;
    end;
end;

function TKsCustomScrollBar.GetRightBottomBtnRect: TRect;
begin
  with Result do
    if Kind = sbHorizontal then
    begin
      Right := Width - BorderWidth;
      Left := Right - GetBtnSize;
      Top := BorderWidth;
      Bottom := Height - BorderWidth;
    end
    else
    begin
      Left := BorderWidth;
      Right := Width - BorderWidth;
      Bottom := Height - BorderWidth;
      Top := Bottom - GetBtnSize;
    end;
end;

function TKsCustomScrollBar.GetSliderRect: TRect;
begin
  with Result do
    if Kind = sbHorizontal then
    begin
      Left := PositionCoordinate(Position);
      Top := GetBackgroundRect.Top;
      Right := Left + GetSliderSize;
      Bottom := GetBackgroundRect.Bottom;
    end
    else
    begin
      Left := GetBackgroundRect.Left;
      Top := PositionCoordinate(Position);
      Right := GetBackgroundRect.Right;
      Bottom := Top + GetSliderSize;
    end;
end;

function TKsCustomScrollBar.GetLeftTopAreaRect: TRect;
begin
  with Result do
    if Kind = sbHorizontal then
    begin
      Left := GetBackgroundRect.Left;
      Top := GetBackgroundRect.Top;
      Right := PositionCoordinate(Position);
      Bottom := GetBackgroundRect.Bottom;
    end
    else
    begin
      Left := GetBackgroundRect.Left;
      Top := GetBackgroundRect.Top;
      Right := GetBackgroundRect.Right;
      Bottom := PositionCoordinate(Position);
    end;
end;

function TKsCustomScrollBar.GetRightBottomAreaRect: TRect;
begin
  with Result do
    if Kind = sbHorizontal then
    begin
      Left := PositionCoordinate(Position) + GetSliderSize;
      Top := GetBackgroundRect.Top;
      Right := GetBackgroundRect.Right;
      Bottom := GetBackgroundRect.Bottom;
    end
    else
    begin
      Left := GetBackgroundRect.Left;
      Top := PositionCoordinate(Position) + GetSliderSize;
      Right := GetBackgroundRect.Right;
      Bottom := GetBackgroundRect.Bottom;
    end;
end;

function TKsCustomScrollBar.GetSliderSize: integer;
var
  TmpBackRect: TRect;
  TmpBackSize: integer;
begin
  if PageSize <= 0 then
    Result := GetSystemMetrics(SM_CYVTHUMB)
  else
    Result := CalculateSliderSize;

  TmpBackRect := GetBackgroundRect;

  if Kind = sbHorizontal then
    TmpBackSize := TmpBackRect.Right - TmpBackRect.Left
  else
    TmpBackSize := TmpBackRect.Bottom - TmpBackRect.Top;

  if Result >= TmpBackSize then
    Result := 0;
end;

function TKsCustomScrollBar.PtInLeftTopBtn(x, y: integer): boolean;
begin
  Result := PtInRect(GetLeftTopBtnRect, Point(x, y));
end;

function TKsCustomScrollBar.PtInRightBottomBtn(x, y: integer): boolean;
begin
  Result := PtInRect(GetRightBottomBtnRect, Point(x, y));
end;

function TKsCustomScrollBar.PtInSlider(x, y: integer): boolean;
begin
  Result := PtInRect(GetSliderRect, Point(x, y));
end;

function TKsCustomScrollBar.PtInLeftTopArea(x, y: integer): boolean;
begin
  Result := PtInRect(GetLeftTopAreaRect, Point(x, y));
end;

function TKsCustomScrollBar.PtInRightBottomArea(x, y: integer): boolean;
begin
  Result := PtInRect(GetRightBottomAreaRect, Point(x, y));
end;

procedure TKsCustomScrollBar.ImitateKeyDown(var Key: word; Shift: TShiftState);
var
  NewPos: integer;

  procedure CorrectNewPos;
  begin
    if NewPos > Max then
      NewPos := Max
    else
      if NewPos < Min then
        NewPos := Min;
  end;

begin
  case Key of
    VK_PRIOR:
      begin
        if PageSize > 0 then
          NewPos := Position - PageSize
        else
          NewPos := Position - LargeChange;
        CorrectNewPos;
        Scroll(scPageUp, NewPos);
        Position := NewPos;
      end;
    VK_NEXT:
      begin
        if PageSize > 0 then
          NewPos := Position + PageSize
        else
          NewPos := Position + LargeChange;
        CorrectNewPos;
        Scroll(scPageDown, NewPos);
        Position := NewPos;
      end;
    VK_END:
      begin
        NewPos := Max;
        CorrectNewPos;
        Scroll(scBottom, NewPos);
        Position := NewPos;
      end;
    VK_HOME:
      begin
        NewPos := Min;
        CorrectNewPos;
        Scroll(scTop, NewPos);
        Position := NewPos;
      end;
    VK_LEFT, VK_UP:
      begin
        NewPos := Position - SmallChange;
        CorrectNewPos;
        Scroll(scLineUp, NewPos);
        Position := NewPos;
        if (Position <= Min) and AutoScrollUp then
          AutoScrollUp := false;
      end;
    VK_RIGHT, VK_DOWN:
      begin
        NewPos := Position + SmallChange;
        CorrectNewPos;
        Scroll(scLineDown, NewPos);
        Position := NewPos;
        if (Position >= Max) and AutoScrollDown then
          AutoScrollDown := false;
      end;
  end;
end;

procedure TKsCustomScrollBar.MouseDown(Button: TMouseButton;
  Shift: TShiftState; x, y: integer);
var
  OldLeftTopBtnPressed,
    OldRightBottomBtnPressed,
    OldLeftTopAreaPressed,
    OldRightBottomAreaPressed: boolean;
  NewPos: integer;
begin
  inherited MouseDown(Button, Shift, x, y);

  if Button <> mbLeft then Exit;

  if PtInSlider(x, y) then
  begin
    if Kind = sbHorizontal then
      FSliderCatchCoord := x - GetSliderRect.Left
    else
      FSliderCatchCoord := y - GetSliderRect.Top;

    NewPos := Position;
    Scroll(scTrack, NewPos);
    Position := NewPos;

    Invalidate;
  end;

  OldLeftTopBtnPressed := LeftTopBtnPressed;
  OldRightBottomBtnPressed := RightBottomBtnPressed;
  OldLeftTopAreaPressed := LeftTopAreaPressed;
  OldRightBottomAreaPressed := RightBottomAreaPressed;

  if PtInLeftTopBtn(x, y) then
    FMDownOnLeftTopBtn := true;

  if PtInRightBottomBtn(x, y) then
    FMDownOnRightBottomBtn := true;

  if PtInLeftTopArea(x, y) then
    FMDownOnLeftTopArea := true;

  if PtInRightBottomArea(x, y) then
    FMDownOnRightBottomArea := true;

  if ((OldLeftTopBtnPressed = false) and (LeftTopBtnPressed = true)) or
    ((OldRightBottomBtnPressed = false) and (RightBottomBtnPressed = true)) or
    ((OldLeftTopAreaPressed = false) and (LeftTopAreaPressed = true)) or
    ((OldRightBottomAreaPressed = false) and (RightBottomAreaPressed = true)) then
  begin
    Invalidate;
    PartPress(True);
  end;
end;

procedure TKsCustomScrollBar.MouseMove(Shift: TShiftState; x, y: integer);
var
  TmpCoord, NewPos: integer;
  OldMouseOnSlider,
  OldMouseOnLeftTopBtn,
  OldMouseOnRightBottomBtn,
  OldMouseOnLeftTopArea,
  OldMouseOnRightBottomArea: boolean;
begin
  inherited;

  FLastMouseX := x;
  FLastMouseY := y;

  if FSliderCatchCoord > 0 then
  begin
    if Kind = sbHorizontal then
    begin
      TmpCoord := x - FSliderCatchCoord;
      if (TmpCoord < GetBackgroundRect.Left) then
        TmpCoord := GetBackgroundRect.Left
      else
        if TmpCoord > GetBackgroundRect.Right then
        TmpCoord := GetBackgroundRect.Right;
    end
    else
    begin
      TmpCoord := y - FSliderCatchCoord;
      if (TmpCoord < GetBackgroundRect.Top) then
        TmpCoord := GetBackgroundRect.Top
      else
        if TmpCoord > GetBackgroundRect.Bottom then
        TmpCoord := GetBackgroundRect.Bottom;

    end;

    NewPos := CoordinatePosition(TmpCoord);
    Scroll(scTrack, NewPos);
    Position := CoordinatePosition(TmpCoord);
  end;

  OldMouseOnSlider := FMouseOnSlider;
  FMouseOnSlider := PtInSlider(x, y);

  OldMouseOnLeftTopBtn := FMouseOnLeftTopBtn;
  FMouseOnLeftTopBtn := PtInLeftTopBtn(x, y) and ShowButtons;

  OldMouseOnRightBottomBtn := FMouseOnRightBottomBtn;
  FMouseOnRightBottomBtn := PtInRightBottomBtn(x, y) and ShowButtons;

  OldMouseOnLeftTopArea := FMouseOnLeftTopArea;
  FMouseOnLeftTopArea := PtInLeftTopArea(x, y);

  OldMouseOnRightBottomArea := FMouseOnRightBottomArea;
  FMouseOnRightBottomArea := PtInRightBottomArea(x, y);

  if (OldMouseOnSlider <> FMouseOnSlider) or
    (OldMouseOnLeftTopBtn <> FMouseOnLeftTopBtn) or
    (OldMouseOnRightBottomBtn <> FMouseOnRightBottomBtn) or
    (OldMouseOnLeftTopArea <> FMouseOnLeftTopArea) or
    (OldMouseOnRightBottomArea <> FMouseOnRightBottomArea) then
    Invalidate;
end;

procedure TKsCustomScrollBar.MouseUp(Button: TMouseButton;
  Shift: TShiftState; x, y: integer);
var
  NewPos: integer;
begin
  inherited;

  if Button <> mbLeft then Exit;

  if FSliderCatchCoord <> -1 then
  begin
    NewPos := Position;
    Scroll(scPosition, NewPos);
    Position := NewPos;
  end;

  FSliderCatchCoord := -1;
  FMDownOnLeftTopBtn := false;
  FMDownOnRightBottomBtn := false;
  FMDownOnLeftTopArea := false;
  FMDownOnRightBottomArea := false;

  if FRepeatTimer <> nil then
    FRepeatTimer.Enabled := False;

  NewPos := Position;
  Scroll(scEndScroll, NewPos);
  Position := NewPos;

  Invalidate;
end;

procedure TKsCustomScrollBar.PaintBuffer;
begin
  inherited;
  DrawBorder;
  DrawBackground;

  if ShowButtons then
  begin
    DrawLeftTopBtn;
    DrawRightBottomBtn;
  end;

  if IsSliderVizible then
  begin
    DrawSlider;
    if LeftTopAreaPressed then
      Buffer.FillRect(GetLeftTopAreaRect, KColor(cl3DDkShadow));

    if RightBottomAreaPressed then
      Buffer.FillRect(GetRightBottomAreaRect, KColor(cl3DDkShadow));
  end;
end;

procedure TKsCustomScrollBar.TimerExpired(Sender: TObject);
var
  OldMouseOnLeftTopArea,
    OldMouseOnRightBottomArea: boolean;
  LKey: word;
begin
  FRepeatTimer.Interval := GetKeyBoardSpeedInterval;
  try
    if LeftTopBtnPressed or FAutoScrollUp then
    begin
      LKey := VK_Left;
      ImitateKeyDown(LKey, []);
    end
    else
      if RightBottomBtnPressed or FAutoScrollDown then
    begin
      LKey := VK_Right;
      ImitateKeyDown(LKey, []);
    end
    else
    begin
      OldMouseOnLeftTopArea := FMouseOnLeftTopArea;
      FMouseOnLeftTopArea := PtInLeftTopArea(FLastMouseX, FLastMouseY);
      if LeftTopAreaPressed then
      begin
        LKey := VK_Prior;
        ImitateKeyDown(LKey, []);
      end
      else
      begin
        OldMouseOnRightBottomArea := FMouseOnRightBottomArea;
        FMouseOnRightBottomArea := PtInRightBottomArea(FLastMouseX, FLastMouseY);
        if RightBottomAreaPressed then
        begin
          LKey := VK_Next;
          ImitateKeyDown(LKey, []);
        end;

        if (OldMouseOnLeftTopArea <> FMouseOnLeftTopArea) or
          (OldMouseOnRightBottomArea <> FMouseOnRightBottomArea) then
          Invalidate;
      end;
    end;
  except
    FRepeatTimer.Enabled := False;
  end;
end;

procedure TKsCustomScrollBar.PartPress(FirstTime: boolean);
begin
  if FRepeatTimer = nil then
  begin
    FRepeatTimer := TTimer.Create(Self);
    FRepeatTimer.OnTimer := TimerExpired;
  end;
  if FirstTime then
  begin
    FRepeatTimer.OnTimer(FRepeatTimer);
    FRepeatTimer.Interval := GetKeyBoardDelayInterval;
  end
  else
    FRepeatTimer.Interval := GetKeyBoardSpeedInterval;

  FRepeatTimer.Enabled := true;
end;

function TKsCustomScrollBar.IsSliderVizible: boolean;
var
  TmpRect: TRect;
begin
  TmpRect := GetSliderRect;
  Result := ((Enabled = true) or (csDesigning in ComponentState)) and
    not ((TmpRect.Right - TmpRect.Left <= 0) or
      (TmpRect.Bottom - TmpRect.Top <= 0));
end;

procedure TKsCustomScrollBar.CMEnabledChanged(var Msg: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TKsCustomScrollBar.MouseLeave;
begin
  if FMouseOnSlider or
    FMouseOnLeftTopBtn or
    FMouseOnRightBottomBtn or
    FMouseOnLeftTopArea or
    FMouseOnRightBottomArea then
  begin
    FMouseOnSlider := false;
    FMouseOnLeftTopBtn := false;
    FMouseOnRightBottomBtn := false;
    FMouseOnLeftTopArea := false;
    FMouseOnRightBottomArea := false;
    Invalidate;
  end;
end;

procedure TKsCustomScrollBar.WMGetDlgCode(var Msg: TWMGetDlgCode);
begin
  inherited;
  Msg.Result := dlgc_WantArrows;
end;

procedure TKsCustomScrollBar.SetBorderWidth(const Value: integer);
begin
  if FBorderWidth <> Value then
  begin
    FBorderWidth := Value;
    Invalidate;
  end;
end;

procedure TKsCustomScrollBar.SetKind(const Value: TScrollBarKind);
var
  TmpValue: integer;
begin
  if FKind <> Value then
  begin
    FKind := Value;
    if (csDesigning in ComponentState)
      and (((FKind = sbHorizontal) and (Height > Width))
      or ((FKind = sbVertical) and (Height < Width))) then
    begin
      TmpValue := Width;
      Width := Height;
      Height := TmpValue;
    end;
    Invalidate;
  end;
end;

procedure TKsCustomScrollBar.SetMax(const Value: integer);
begin
  if (FMax <> Value) then
  begin
    if Value < Min then
      FMax := Min
    else
      FMax := Value;

    if Position > FMax then
      Position := FMax;

    if FPageSize > FMax - FMin+1 then
      FPageSize := FMax - FMin+1;

    Invalidate;
  end;
end;

procedure TKsCustomScrollBar.SetMin(const Value: integer);
begin
  if (FMin <> Value) then
  begin
    if Value > Max then
      FMin := Max
    else
      FMin := Value;


    if Position < FMin then
      Position := FMin;

    if FPageSize > FMax - FMin+1 then
      FPageSize := FMax - FMin+1;

    Invalidate;
  end;
end;

procedure TKsCustomScrollBar.SetPageSize(const Value: integer);
begin
  if (FPageSize <> Value) and (Value >= 0) then
  begin
    FPageSize := Value;

    if FPageSize > FMax - FMin+1 then
      FPageSize := FMax - FMin+1;

    Invalidate;
  end;
end;

procedure TKsCustomScrollBar.SetPosition(const Value: integer);
begin
  if FPosition <> Value then
  begin
    if Value > Max then
      FPosition := Max
    else
      if Value < Min then
        FPosition := Min
    else
      FPosition := Value;
    Invalidate;
    Change;
  end;
end;

procedure TKsCustomScrollBar.SetShowButtons(const Value: boolean);
begin
  if FShowButtons <> Value then
  begin
    FShowButtons := Value;
    Invalidate;
  end;
end;

function TKsCustomScrollBar.GetSliderPressed: boolean;
begin
  Result := FSliderCatchCoord > -1;
end;

function TKsCustomScrollBar.GetLeftTopBtnPressed: boolean;
begin
  Result := FMDownOnLeftTopBtn and MouseOnLeftTopBtn;
end;

function TKsCustomScrollBar.GetRightBottomBtnPressed: boolean;
begin
  Result := FMDownOnRightBottomBtn and MouseOnRightBottomBtn;
end;

function TKsCustomScrollBar.GetLeftTopAreaPressed: boolean;
begin
  Result := FMDownOnLeftTopArea and MouseOnLeftTopArea;
end;

function TKsCustomScrollBar.GetRightBottomAreaPressed: boolean;
begin
  Result := FMDownOnRightBottomArea and MouseOnRightBottomArea;
end;

procedure TKsCustomScrollBar.SetAutoSrcollUp(const Value: boolean);
begin
  if FAutoScrollUp <> Value then begin
    FAutoScrollUp := Value;

    if FAutoScrollUp then begin
      AutoScrollDown := not FAutoScrollUp;
      PartPress(false);
    end else
      if FRepeatTimer <> nil then
        FRepeatTimer.Enabled := false;
  end;
end;

procedure TKsCustomScrollBar.SetAutoSrcollDown(const Value: boolean);
begin
  if FAutoScrollDown <> Value then begin
    FAutoScrollDown := Value;

    if FAutoScrollDown then begin
      AutoScrollUp := not FAutoScrollDown;
      PartPress(false);
    end
    else
      if FRepeatTimer <> nil then
        FRepeatTimer.Enabled := false;
  end;
end;

end.

