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

  Custom TrackBar
  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 KsTrackBars;

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

interface

uses
  Classes, Controls, Windows, Graphics, Messages, KsBitmap, KsUtils, KsControls;

const

  CStdThumbRatio = 2.2;

type

  TTrackOrientation = (toHorizontal, toVertical);
  TTickMark = (tmBoth, tmBottomRight, tmTopLeft);
  { The following table lists the possible values:
    <TABLE>
    Value                       Meaning
    -----                       -------
    htLowInterval               The highlight drawing between Min and Position
    htHighInterval              The highlight drawing between Position and Max
    htNone                      The highlight no drawing
    </TABLE>
  }
  TIntervalHighlightType = (htLowInterval, htHighInterval, htNone);

{ TKsCustomTrackBar }

{ TKsCustomTrackBar is a advanced Windows track bar control. }
  TKsCustomTrackBar = class(TKsCustomControl)
  private
    FSliding: boolean;
    FOrientation: TTrackOrientation;
    FMin: integer;
    FMax: integer;
    FPosition: integer;
    FShowTicks: boolean;
    FThumbHalfWidth: word;
    FTickMarks: TTickMark;
    FMouseOnThumb: boolean;
    FLineSize: Integer;
    FPageSize: Integer;
    FFrequency: Integer;
    FThumbVisible: Boolean;
    FIntervalHighlightType: TIntervalHighlightType;
    FOnChange: TNotifyEvent;
    procedure SetMax(const Value: integer);
    procedure SetMin(const Value: integer);
    procedure SetPosition(const Value: integer);
    procedure SetShowTicks(const Value: boolean);
    procedure SetOrientation(const Value: TTrackOrientation);
    procedure SetThumbHalfWidth(const Value: word);
    procedure SetTickMarks(const Value: TTickMark);
    procedure SetLineSize(const Value: Integer);
    procedure SetPageSize(const Value: Integer);
    procedure SetFrequency(const Value: Integer);
    procedure SetThumbVisible(const Value: Boolean);
    procedure SetIntervalHighlightType(const Value: TIntervalHighlightType);
  protected
    { Windows Handlers }
    procedure CMEnabledChanged(var Msg: TMessage); message CM_ENABLEDCHANGED;
    procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message wm_GetDlgCode;
    { TrackBar }
    procedure Change; dynamic;
    function PositionCoordinate(APos: integer): word;
    function CoordinatePosition(ACoord: word): integer;
    function GetThumbWidth: integer; virtual;
    function GetSideMargin: integer; virtual;
    function GetTopBottomMargin: integer; virtual;
    procedure DrawTrack(BegCoord, EndCoord, PosCooord: integer); virtual;
    procedure DrawThumb(APosCoord: integer); virtual;
    procedure DrawTick(Value, Coord: integer; TopLeft: boolean); virtual;
    procedure DrawTicks; virtual;
    function PtInThumb(x, y: integer): boolean; virtual;
    { For next }
    procedure PaintBuffer; override;
    { Event }
    procedure MouseLeave; override;
    procedure HasFocus; override;
    procedure KillFocus; override;
    { Inherited }
    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;
    { Protected property }
    property ThumbPressed: boolean read FSliding;
    property MouseOnThumb: boolean read FMouseOnThumb;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
  published
    property Align;
    { Determines whether to show trackbar highlight }
    property IntervalHighlightType: TIntervalHighlightType read FIntervalHighlightType
      write SetIntervalHighlightType default htNone;
    property LineSize: integer read FLineSize write SetLineSize default 1;
    property Max: integer read FMax write SetMax default 10;
    property Min: integer read FMin write SetMin default 0;
    property Orientation: TTrackOrientation read FOrientation
      write SetOrientation;
    property PageSize: integer read FPageSize write SetPageSize default 2;
    property Position: integer read FPosition write SetPosition default 3;
    property Frequency: integer read FFrequency write SetFrequency default 1;
    property TabOrder;
    property TabStop default true;
    property ThumbVisible: Boolean read FThumbVisible write SetThumbVisible
      default true;
    { Determines half width (or height) of the slider. Real slider width calc as ThumbHalfWidth * 2 + 1}
    property ThumbHalfWidth: word read FThumbHalfWidth write SetThumbHalfWidth
      default 4;
    property TickMarks: TTickMark read FTickMarks write SetTickMarks
      default tmBottomRight;
    property ShowTicks: boolean read FShowTicks write SetShowTicks default true;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

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

uses Extctrls, Dialogs;

{ TKsCustomTrackBar }

constructor TKsCustomTrackBar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 150;
  Height := 45;
  TabStop := true;

  FMax := 10;
  FMin := 0;
  FPosition := 3;
  FOrientation := toHorizontal;
  FThumbHalfWidth := 4;

  FLineSize := 1;
  FPageSize := 2;
  FFrequency := 1;

  FThumbVisible := true;
  FShowTicks := true;
  FIntervalHighlightType := htNone;
  FTickMarks := tmBottomRight;

  FSliding := false;
  FMouseOnThumb := false;

  ControlStyle := ControlStyle + [csCaptureMouse];
end;

destructor TKsCustomTrackBar.Destroy;
begin
  inherited Destroy;
end;

procedure TKsCustomTrackBar.Loaded;
begin
  inherited;
  Invalidate;
end;

{ Track Bar }

function TKsCustomTrackBar.CoordinatePosition(ACoord: word): integer;
var
  LScaleWidth, LSideMargin, LThumbWidth: integer;
begin
  LSideMargin := GetSideMargin;
  LThumbWidth := GetThumbWidth;
  if Orientation = toHorizontal then
    LScaleWidth := FWidth
  else
    LScaleWidth := FHeight;
  LScaleWidth := LScaleWidth - LSideMargin * 2 - LThumbWidth;

  Result := Round(((FMax - FMin) * (ACoord - LSideMargin - LThumbWidth div 2)) /
    LScaleWidth + FMin);

  { Round }
  if Result mod FFrequency > FFrequency div 2 then
    Result := Result - (Result mod FFrequency) + FFrequency
  else
    Result := Result - (Result mod FFrequency);

  if Result < Min then
    Result := Min;
  if Result > Max then
    Result := Max;
end;

function TKsCustomTrackBar.PositionCoordinate(APos: integer): word;
var
  LScaleWidth, LSideMargin, LThumbWidth: integer;
begin
  LSideMargin := GetSideMargin;
  LThumbWidth := GetThumbWidth;
  if Orientation = toHorizontal then
    LScaleWidth := FWidth
  else
    LScaleWidth := FHeight;
  LScaleWidth := LScaleWidth - LSideMargin * 2 - LThumbWidth;
  if FMax - FMin = 0 then
    Result := 0
  else
    Result := LSideMargin + LThumbWidth div 2 + Round(LScaleWidth * (APos - FMin) / (FMax - FMin));
end;

procedure TKsCustomTrackBar.DrawTrack(BegCoord, EndCoord, PosCooord: integer);
var
  LTrackRect, LowIntervalRect, TmpRect: TRect;
  LSideMarign, LTopBottmMarign, LThumbWidth, LThumbHeight: integer;
begin
  LThumbWidth := GetThumbWidth;
  LTopBottmMarign := GetTopBottomMargin;
  LSideMarign := GetSideMargin;
  LThumbHeight := Round(LThumbWidth * CStdThumbRatio);

  with LTrackRect do
  begin
    if FOrientation = toHorizontal then
    begin
      Top := LTopBottmMarign;
      if TickMarks = tmTopLeft then
        Top := Top + LThumbWidth div 2
      else
        Top := Top + LThumbWidth div 4;

      if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
        Top := Top + 4 + 1;

      if TickMarks = tmBoth then
      begin
        Bottom := Top + LThumbHeight - (LThumbWidth div 4) * 2;
        InflateRect(LTrackRect, 0, -1);
      end
      else
        Bottom := Top + LThumbHeight - LThumbWidth div 2 - LThumbWidth div 4;

      Left := BegCoord;
      Right := EndCoord;

      LowIntervalRect.Top := Top;
      LowIntervalRect.Bottom := Bottom;
      if IntervalHighlightType = htLowInterval then
      begin
        LowIntervalRect.Left := Left;
        LowIntervalRect.Right := PosCooord;
      end
      else
      begin
        LowIntervalRect.Left := PosCooord;
        LowIntervalRect.Right := Right;
      end;
    end
    else
    begin
      Left := LTopBottmMarign;
      if TickMarks = tmTopLeft then
        Left := Left + LThumbWidth div 2
      else
        Left := Left + LThumbWidth div 4;

      if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
        Left := Left + 4 + 1;

      if TickMarks = tmBoth then
      begin
        Right := Left + LThumbHeight - (LThumbWidth div 4) * 2;
        InflateRect(LTrackRect, -1, 0);
      end
      else
        Right := Left + LThumbHeight - LThumbWidth div 2 - LThumbWidth div 4;

      Top := BegCoord;
      Bottom := EndCoord;

      LowIntervalRect.Left := Left;
      LowIntervalRect.Right := Right;
      if IntervalHighlightType = htLowInterval then
      begin
        LowIntervalRect.Top := Top;
        LowIntervalRect.Bottom := PosCooord;
      end
      else
      begin
        LowIntervalRect.Top := PosCooord;
        LowIntervalRect.Bottom := Bottom;
      end;
    end;
  end;

  if Enabled then
    Buffer.FillRect(LTrackRect, KColor(clBtnHighlight))
  else
    Buffer.FillRect(LTrackRect, KColor(clBtnFace));

  if Enabled and (IntervalHighlightType <> htNone) then
    Buffer.FillRect(LowIntervalRect, KColor(clHighlight));

  TmpRect := RectOffset(LTrackRect, 0);
  Buffer.DrawEdge(TmpRect, KColor(clBtnShadow), KColor(clBtnHighlight));
  TmpRect := RectOffset(LTrackRect, -1);
  Buffer.DrawEdge(TmpRect, KColor(cl3DDkShadow), KColor(cl3DLight));
end;

procedure TKsCustomTrackBar.DrawThumb(APosCoord: integer);
var
  Bx, By: integer;
  LThumbWidth, LThumbHeight: integer;
begin
  if not ThumbVisible then Exit;

  LThumbWidth := GetThumbWidth;
  LThumbHeight := Round(LThumbWidth * CStdThumbRatio);
  with Buffer do
  begin
    if Orientation = toHorizontal then
    begin
      Bx := APosCoord - LThumbWidth div 2;
      By := GetTopBottomMargin;
      if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
        By := By + 4 + 1;

      case TickMarks of
        tmBottomRight: begin

          if ThumbPressed then
            FillHalftonePolygon([Point(Bx, By),
              Point(Bx + LThumbWidth - 1, By),
              Point(Bx + LThumbWidth - 1, By + LThumbHeight - LThumbWidth div 2 - 1),
              Point(Bx + LThumbWidth div 2, By + LThumbHeight - 1),
              Point(Bx, By + LThumbHeight - LThumbWidth div 2 - 1)],
              KColor(clBtnFace), KColor(clBtnHighlight))
          else
            FillPolygon([Point(Bx, By),
              Point(Bx + LThumbWidth - 1, By),
              Point(Bx + LThumbWidth - 1, By + LThumbHeight - LThumbWidth div 2 - 1),
              Point(Bx + LThumbWidth div 2, By + LThumbHeight - 1),
              Point(Bx, By + LThumbHeight - LThumbWidth div 2 - 1)],
              KColor(clBtnFace));

          MoveTo(Bx + LThumbWidth - 2, By);
          LineTo(Bx, By, KColor(clBtnHighlight));
          LineTo(Bx, By + LThumbHeight - LThumbWidth div 2 - 1, KColor(clBtnHighlight));
          LineTo(Bx + LThumbWidth div 2, By + LThumbHeight - 1, KColor(clBtnHighlight));

          MoveTo(Bx + LThumbWidth - 2, By + 1);
          LineTo(Bx + LThumbWidth - 2, By + LThumbHeight - LThumbWidth div 2 - 1, KColor(clBtnShadow));
          LineTo(Bx + LThumbWidth div 2 - 1, By + LThumbHeight - 1, KColor(clBtnShadow));

          MoveTo(Bx + LThumbWidth - 1, By);
          LineTo(Bx + LThumbWidth - 1, By + LThumbHeight - LThumbWidth div 2 - 1, KColor(cl3DDkShadow));
          LineTo(Bx + LThumbWidth div 2 - 1, By + LThumbHeight, KColor(cl3DDkShadow));
        end;
        tmTopLeft: begin

          if ThumbPressed then
            FillHalftonePolygon([Point(Bx + LThumbWidth div 2, By),
              Point(Bx + LThumbWidth - 1, By + LThumbWidth div 2),
              Point(Bx + LThumbWidth - 1, By + LThumbHeight - 1),
              Point(Bx, By + LThumbHeight - 1),
              Point(Bx, By + LThumbWidth div 2)],
              KColor(clBtnFace), KColor(clBtnHighlight))
          else
            FillPolygon([Point(Bx + LThumbWidth div 2, By),
              Point(Bx + LThumbWidth - 1, By + LThumbWidth div 2),
              Point(Bx + LThumbWidth - 1, By + LThumbHeight - 1),
              Point(Bx, By + LThumbHeight - 1),
              Point(Bx, By + LThumbWidth div 2)],
              KColor(clBtnFace));

          MoveTo(Bx, By + LThumbHeight - 2);
          LineTo(Bx, By + LThumbWidth div 2, KColor(clBtnHighlight));
          LineTo(Bx + LThumbWidth div 2, By, KColor(clBtnHighlight));

          MoveTo(Bx + LThumbWidth div 2, By + 1);
          LineTo(Bx + LThumbWidth - 2, By + LThumbWidth div 2, KColor(clBtnShadow));
          LineTo(Bx + LThumbWidth - 2, By + LThumbHeight - 2, KColor(clBtnShadow));
          LineTo(Bx, By + LThumbHeight - 2, KColor(clBtnShadow));

          MoveTo(Bx + LThumbWidth div 2, By);
          LineTo(Bx + LThumbWidth - 1, By + LThumbWidth div 2, KColor(cl3DDkShadow));
          LineTo(Bx + LThumbWidth - 1, By + LThumbHeight - 1, KColor(cl3DDkShadow));
          LineTo(Bx - 1, By + LThumbHeight - 1, KColor(cl3DDkShadow));
        end;
        tmBoth: begin
          if ThumbPressed then
            FillHalftoneRect(Rect(Bx, By, Bx + LThumbWidth, By + LThumbHeight), KColor(clBtnFace), KColor(clBtnHighlight))
          else
            FillRect(Rect(Bx, By, Bx + LThumbWidth, By + LThumbHeight), KColor(clBtnFace));
          DrawEdge(Rect(Bx, By, Bx + LThumbWidth, By + LThumbHeight),
            KColor(clBtnHighlight), ckBlack);
          DrawEdge(Rect(Bx + 1, By + 1, Bx + LThumbWidth - 1, By + LThumbHeight - 1),
            KColor(clBtnFace), KColor(clBtnShadow));
        end;
      end;
    end
    else
    begin
      { Orientation = toVertical }

      Bx := GetTopBottomMargin;
      By := APosCoord - LThumbWidth div 2;
      if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
        Bx := Bx + 4 + 1;
      case TickMarks of
        tmBottomRight: begin

          if ThumbPressed then
            FillHalftonePolygon([Point(Bx, By),
              Point(Bx + LThumbHeight - LThumbWidth div 2 - 1, By),
              Point(Bx + LThumbHeight - 1, By + LThumbWidth div 2),
              Point(Bx + LThumbHeight - LThumbWidth div 2 - 1, By + LThumbWidth - 1),
              Point(Bx, By + LThumbWidth - 1)],
              KColor(clBtnFace), KColor(clBtnHighlight))
          else
            FillPolygon([Point(Bx, By),
              Point(Bx + LThumbHeight - LThumbWidth div 2 - 1, By),
              Point(Bx + LThumbHeight - 1, By + LThumbWidth div 2),
              Point(Bx + LThumbHeight - LThumbWidth div 2 - 1, By + LThumbWidth - 1),
              Point(Bx, By + LThumbWidth - 1)],
              KColor(clBtnFace));

          MoveTo(Bx, By + LThumbWidth - 2);
          LineTo(Bx, By, KColor(clBtnHighlight));
          LineTo(Bx + LThumbHeight - LThumbWidth div 2 - 1, By, KColor(clBtnHighlight));
          LineTo(Bx + LThumbHeight - 1, By + LThumbWidth div 2, KColor(clBtnHighlight));

          MoveTo(Bx + LThumbHeight - 2, By + LThumbWidth div 2);
          LineTo(Bx + LThumbHeight - LThumbWidth div 2 - 1, By + LThumbWidth - 2, KColor(clBtnShadow));
          LineTo(Bx, By + LThumbWidth - 2, KColor(clBtnShadow));

          MoveTo(Bx + LThumbHeight - 1, By + LThumbWidth div 2);
          LineTo(Bx + LThumbHeight - LThumbWidth div 2 - 1, By + LThumbWidth - 1, KColor(cl3DDkShadow));
          LineTo(Bx - 1, By + LThumbWidth - 1, KColor(cl3DDkShadow));
        end;
        tmTopLeft: begin

          if ThumbPressed then
            FillHalftonePolygon([Point(Bx + LThumbWidth div 2, By),
              Point(Bx + LThumbHeight - 1, By),
              Point(Bx + LThumbHeight - 1, By + LThumbWidth - 1),
              Point(Bx + LThumbWidth div 2, By + LThumbWidth - 1),
              Point(Bx, By + LThumbWidth div 2)],
              KColor(clBtnFace), KColor(clBtnHighlight))
          else
            FillPolygon([Point(Bx + LThumbWidth div 2, By),
              Point(Bx + LThumbHeight - 1, By),
              Point(Bx + LThumbHeight - 1, By + LThumbWidth - 1),
              Point(Bx + LThumbWidth div 2, By + LThumbWidth - 1),
              Point(Bx, By + LThumbWidth div 2)],
              KColor(clBtnFace));

          MoveTo(Bx + 1, By + LThumbWidth div 2 - 1);
          LineTo(Bx + LThumbWidth div 2, By, KColor(clBtnHighlight));
          LineTo(Bx + LThumbHeight - 1, By, KColor(clBtnHighlight));

          MoveTo(Bx + LThumbHeight - 2, By + 1);
          LineTo(Bx + LThumbHeight - 2, By + LThumbWidth - 2, KColor(clBtnShadow));
          LineTo(Bx + LThumbWidth div 2, By + LThumbWidth - 2, KColor(clBtnShadow));
          LineTo(Bx, By + LThumbWidth div 2 - 1, KColor(clBtnShadow));

          MoveTo(Bx + LThumbHeight - 1, By);
          LineTo(Bx + LThumbHeight - 1, By + LThumbWidth - 1, KColor(cl3DDkShadow));
          LineTo(Bx + LThumbWidth div 2, By + LThumbWidth - 1, KColor(cl3DDkShadow));
          LineTo(Bx - 1, By + LThumbWidth div 2 - 1, KColor(cl3DDkShadow));

        end;
        tmBoth: begin
          if ThumbPressed then
            FillHalftoneRect(Rect(Bx, By, Bx + LThumbHeight, By + LThumbWidth), KColor(clBtnFace), KColor(clBtnHighlight))
          else
            FillRect(Rect(Bx, By, Bx + LThumbHeight, By + LThumbWidth), KColor(clBtnFace));
          DrawEdge(Rect(Bx, By, Bx + LThumbHeight, By + LThumbWidth),
            KColor(clBtnHighlight), ckBlack);
          DrawEdge(Rect(Bx + 1, By + 1, Bx + LThumbHeight - 1, By + LThumbWidth - 1),
            KColor(clBtnFace), KColor(clBtnShadow));
        end;
      end;
    end;
  end;
end;

procedure TKsCustomTrackBar.DrawTick(Value, Coord: integer;
  TopLeft: boolean);
var
  VCoord: integer;
  LThumbHeight: integer;
begin
  LThumbHeight := Round(GetThumbWidth * CStdThumbRatio);
  if TopLeft then
  begin
    VCoord := GetTopBottomMargin + 3;
    with Buffer do
    begin
      if Orientation = toHorizontal then
      begin
        MoveTo(Coord, VCoord);
        if (Value = Min) or (Value = Max) then
          LineTo(Coord, VCoord - 4, ckBlack)
        else
          LineTo(Coord, VCoord - 3, ckBlack);
      end
      else
      begin
        MoveTo(VCoord, Coord);
        if (Value = Min) or (Value = Max) then
          LineTo(VCoord - 4, Coord, ckBlack)
        else
          LineTo(VCoord - 3, Coord, ckBlack);
      end;
    end
  end
  else
  begin
    if TickMarks = tmBoth then
      VCoord := GetTopBottomMargin + 4 + 1 +
        LThumbHeight + 1
    else
      VCoord := GetTopBottomMargin + 1 +
        LThumbHeight + 1;
    with Buffer do
    begin
      if Orientation = toHorizontal then
      begin
        MoveTo(Coord, VCoord);
        if (Value = Min) or (Value = Max) then
          LineTo(Coord, VCoord + 4, ckBlack)
        else
          LineTo(Coord, VCoord + 3, ckBlack);
      end
      else
      begin
        MoveTo(VCoord, Coord);
        if (Value = Min) or (Value = Max) then
          LineTo(VCoord + 4, Coord, ckBlack)
        else
          LineTo(VCoord + 3, Coord, ckBlack);
      end;
    end;
  end;
end;

function TKsCustomTrackBar.PtInThumb(x, y: integer): boolean;
var
  Bx, By: integer;
  LThumbWidth, LThumbHeight: integer;
begin
  LThumbWidth := GetThumbWidth;
  LThumbHeight := Round(LThumbWidth * CStdThumbRatio);

  if Orientation = toHorizontal then
  begin
    Bx := PositionCoordinate(Position) - LThumbWidth div 2;
    By := GetTopBottomMargin;
    if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
      By := By + 4 + 1;
    case TickMarks of
      tmBottomRight:
        Result :=
          PointInPolygon(Point(x, y),
            [Point(Bx, By),
            Point(Bx + LThumbWidth - 1, By),
            Point(Bx + LThumbWidth - 1, By + LThumbHeight - LThumbWidth div 2
            -
            1),
            Point(Bx + LThumbWidth div 2, By + LThumbHeight - 1),
            Point(Bx, By + LThumbHeight - LThumbWidth div 2 - 1)]);

      tmTopLeft:
        Result :=
          PointInPolygon(Point(x, y), [Point(Bx + LThumbWidth div 2, By),
            Point(Bx + LThumbWidth - 1, By + LThumbWidth div 2),
            Point(Bx + LThumbWidth - 1, By + LThumbHeight - 1),
            Point(Bx, By + LThumbHeight - 1),
            Point(Bx, By + LThumbWidth div 2)]);

    else  { tmBoth }
      Result :=
        PtInRect(Rect(Bx, By, Bx + LThumbWidth, By + LThumbHeight), Point(X, Y));
    end;
  end
  else
  begin
    { Orientation = toVertical }
    Bx := GetTopBottomMargin;
    By := PositionCoordinate(Position) - LThumbWidth div 2;
    if ShowTicks and ((TickMarks = tmTopLeft) or (TickMarks = tmBoth)) then
      Bx := Bx + 4 + 1;
    case TickMarks of
      tmBottomRight:
        Result :=
          PointInPolygon(Point(x, y), [Point(Bx, By),
            Point(Bx + LThumbHeight - LThumbWidth div 2 - 1, By),
            Point(Bx + LThumbHeight - 1, By + LThumbWidth div 2),
            Point(Bx + LThumbHeight - LThumbWidth div 2 - 1, By + LThumbWidth
            -
            1),
            Point(Bx, By + LThumbWidth - 1)]);
      tmTopLeft:
         Result :=
          PointInPolygon(Point(x, y), [Point(Bx + LThumbWidth div 2, By),
            Point(Bx + LThumbHeight - 1, By),
            Point(Bx + LThumbHeight - 1, By + LThumbWidth - 1),
            Point(Bx + LThumbWidth div 2, By + LThumbWidth - 1),
            Point(Bx, By + LThumbWidth div 2)]);
   else { tmBoth }
      Result := PtInRect(Rect(Bx, By, Bx + LThumbHeight, By + LThumbWidth), Point(X, Y));
    end;
  end;
end;

procedure TKsCustomTrackBar.DrawTicks;
var
  CurPos: integer;
begin
  if ShowTicks then
  begin
    if (TickMarks = tmTopLeft) or (TickMarks = tmBoth) then
      for CurPos := Min to Max do
        if (CurPos mod Frequency = 0) or (CurPos = Min) or (CurPos = Max) then
          DrawTick(CurPos, PositionCoordinate(CurPos), true);
    if (TickMarks = tmBottomRight) or (TickMarks = tmBoth) then
      for CurPos := Min to Max do
        if (CurPos mod Frequency = 0) or (CurPos = Min) or (CurPos = Max) then
          DrawTick(CurPos, PositionCoordinate(CurPos), false);
  end;
end;

function TKsCustomTrackBar.GetSideMargin: integer;
begin
  Result := 9;
end;

function TKsCustomTrackBar.GetThumbWidth: integer;
begin
  Result := FThumbHalfWidth * 2 + 1
end;

function TKsCustomTrackBar.GetTopBottomMargin: integer;
begin
  Result := 7
end;

{ Painting }

procedure TKsCustomTrackBar.PaintBuffer;
var
  R: TRect;
begin
  inherited ;
  
  if Orientation = toHorizontal then
    DrawTrack(GetSideMargin, FWidth - GetSideMargin, PositionCoordinate(Position))
  else
    DrawTrack(GetSideMargin, FHeight - GetSideMargin, PositionCoordinate(Position));

  DrawTicks;

  DrawThumb(PositionCoordinate(Position));

  if Focused then
  begin
    R := Rect(0, 0, FWidth, FHeight);
    Buffer.DrawFocusRect(R, ckBlack);
  end;
end;

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

{ Events }

procedure TKsCustomTrackBar.HasFocus;
begin
  inherited;
  Invalidate;
end;

procedure TKsCustomTrackBar.KillFocus;
begin
  inherited;
  Invalidate;
end;

procedure TKsCustomTrackBar.MouseLeave;
begin
  inherited;
  if FMouseOnThumb then
  begin
    FMouseOnThumb := false;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState;
  x, y: integer);
var
  PointPosition: integer;
begin
  inherited MouseDown(Button, Shift, x, y);

  SetFocus;

  if PtInThumb(x, y) and (Button = mbLeft) then
  begin
    FSliding := true;
    Invalidate;
  end;

  if (not (FSliding)) and (Button = mbLeft) then
  begin
    if Orientation = toHorizontal then
      PointPosition := CoordinatePosition(x)
    else
      PointPosition := CoordinatePosition(y);

    if PointPosition > Position then
      Position := Position + PageSize
    else
      if PointPosition < Position then
      Position := Position - PageSize;
  end;
end;

procedure TKsCustomTrackBar.MouseMove(Shift: TShiftState; x, y: integer);
var
  TmpCoord: integer;
  Old: boolean;
begin
  inherited MouseMove(Shift, x, y);

  if Orientation = toHorizontal then
  begin
    TmpCoord := x;
    if (x < 0) then
      TmpCoord := 0
    else
      if x > FWidth then
      TmpCoord := FWidth
  end
  else
  begin
    TmpCoord := y;
    if (y < 0) then
      TmpCoord := 0
    else
      if y > FHeight then
      TmpCoord := FHeight
  end;

  if FSliding then
    Position := CoordinatePosition(TmpCoord);

  Old := FMouseOnThumb;
  if PtInThumb(x, y) then
    FMouseOnThumb := true
  else
    FMouseOnThumb := false;

  if FMouseOnThumb <> Old then
    Invalidate;
end;

procedure TKsCustomTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; x,
  y: integer);
begin
  inherited MouseUp(Button, Shift, x, y);
  if Button = mbLeft then
  begin
    FSliding := false;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.KeyDown(var Key: word; Shift: TShiftState);
begin
  inherited KeyDown(Key, Shift);

  case Key of
    VK_PRIOR: Position := Position - PageSize;
    VK_NEXT: Position := Position + PageSize;
    VK_END: Position := Max;
    VK_HOME: Position := Min;
    VK_LEFT: Position := Position - LineSize;
    VK_RIGHT: Position := Position + LineSize;
    VK_UP: Position := Position - LineSize;
    VK_DOWN: Position := Position + LineSize;
  end;
end;

{ Windows Handlers }

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

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

{ Properties }

procedure TKsCustomTrackBar.SetMax(const Value: integer);
begin
  if (FMax <> Value) and (Value > Min)  then
  begin
    FMax := Value;
    if Position > FMax then
      Position := FMax;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetMin(const Value: integer);
begin
  if (FMin <> Value) and (Value < Max) then
  begin
    FMin := Value;
    if Position < FMin then
      Position := FMin;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetOrientation(const Value: TTrackOrientation);
var
  TmpValue: integer;
begin
  if FOrientation <> Value then
  begin
    FOrientation := Value;
    if (csDesigning in ComponentState)
      and (((FOrientation = toHorizontal) and (Height > Width))
      or ((FOrientation = toVertical) and (Height < Width))) then
    begin
      TmpValue := Width;
      Width := Height;
      Height := TmpValue;
    end;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetPosition(const Value: integer);
begin
  if FPosition <> Value then
  begin
    if Value > FMax then
      FPosition := FMax
    else
      if Value < FMin then
      FPosition := FMin
    else
      FPosition := Value;
    Invalidate;
    Change;
  end;
end;

procedure TKsCustomTrackBar.SetShowTicks(const Value: boolean);
begin
  if FShowTicks <> Value then
  begin
    FShowTicks := Value;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetThumbHalfWidth(const Value: word);
begin
  if FThumbHalfWidth <> Value then
  begin
    FThumbHalfWidth := Value;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetTickMarks(const Value: TTickMark);
begin
  if Value <> FTickMarks then
  begin
    FTickMarks := Value;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetLineSize(const Value: Integer);
begin
  if FLineSize <> Value then
    FLineSize := Value;
end;

procedure TKsCustomTrackBar.SetPageSize(const Value: Integer);
begin
  FPageSize := Value;
end;

procedure TKsCustomTrackBar.SetFrequency(const Value: Integer);
begin
  if FFrequency <> Value then
  begin
    FFrequency := Value;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetThumbVisible(const Value: Boolean);
begin
  if FThumbVisible <> Value then
  begin
    FThumbVisible := Value;
    Invalidate;
  end;
end;

procedure TKsCustomTrackBar.SetIntervalHighlightType(
  const Value: TIntervalHighlightType);
begin
  if FIntervalHighlightType <> Value then
  begin
    FIntervalHighlightType := Value;
    Invalidate;
  end;
end;

end.

