unit myTrackBar;

interface

uses
	Windows, Messages, SysUtils, Classes, Controls, ComCtrls;

type
	TMyTrackBar = class(TTrackBar)
	private
		{ Private 宣言 }
		FbThumbHold : Boolean; //左ボタンでつまみを触っているか。
		FbTouched   : Boolean; //トラックバーを左ボタンで触っているか。
		FiHoverPos  : Integer; //マウス下の位置。

		function FGetThumbRect       : TRect;   //つまみのRect。
		function FGetThumbScreenRect : TRect;   //↑のスクリーン座標のRect。
		function FGetSeekRect        : TRect;   //つまみがスライドする部分のRect。
		function FGetSeekScreenRect  : TRect;   //↑のスクリーン座標のRect。
		function FGetSeekWidth       : Integer;
		function FGetThumbHold       : Boolean; //つまみを触っているか。
		function FGetTouched         : Boolean; //トラックバーを触っているか。
	protected
		{ Protected 宣言 }
		procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
		procedure MouseMove(                      Shift: TShiftState; X, Y: Integer); override;
		procedure MouseUp  (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
		procedure DoExit; override;
	public
		{ Public 宣言 }
		constructor Create(AOwner: TComponent); override;
		property ThumbRect       : TRect   read FGetThumbRect;
		property ThumbScreenRect : TRect   read FGetThumbScreenRect;
		property SeekRect        : TRect   read FGetSeekRect;
		property SeekScreenRect  : TRect   read FGetSeekScreenRect;
		property SeekWidth       : Integer read FGetSeekWidth;
	published
		{ Published 宣言 }
		property ThumbHold : Boolean read FGetThumbHold;
		property Touched   : Boolean read FGetTouched;
		property HoverPos  : Integer read FiHoverPos;
		property OnMouseDown;
		property OnMouseMove;
		property OnMouseUp;
	end;

procedure Register;

implementation
uses
	CommCtrl;

// 汎用関数群 ------------------------------------------------------------------
	function lfniCeil(X: Extended): Int64;
	begin
		Result := Trunc(X);
		if Frac(X) > 0 then
			Inc(Result);
	end;

	function lfniFloor(X: Extended): Int64;
	begin
		Result := Trunc(X);
		if Frac(X) < 0 then
			Dec(Result);
	end;
function gfniRoundUp(fNum: Extended): Int64;
{2007-06-09:
fNumを切り上げて返す
}
begin
	if (fNum >= 0) then begin
		Result := lfniCeil(fNum);
	end else begin
		Result := lfniFloor(fNum);
	end;
end;

function gfniRectWidth (rtRect: TRect): Integer;
{2007-06-09:
rtRectの幅を返す
}
begin
	with rtRect do begin
		Result := Right - Left;
	end;
end;


//==============================================================================
constructor TMyTrackBar.Create(AOwner: TComponent);
begin
	inherited;

	FbThumbHold := False; //左ボタンでつまみを触っているか。
	FbTouched   := False; //自身(トラックバー)を左ボタンで触っているか。
	FiHoverPos  := -1;    //マウスのポインター直下の位置。範囲外で-1。
end;

function TMyTrackBar.FGetThumbRect: TRect;
//つまみのRect
//座標はクライアント座標
begin
	SendMessage(Handle, TBM_GETTHUMBRECT, 0, LPARAM(@Result)); //スライダのつまみのRect
end;

function TMyTrackBar.FGetThumbScreenRect: TRect;
//↑のスクリーン座標のRect
begin
	Result := FGetThumbRect;
	Windows.ClientToScreen(Handle, Result.TopLeft);
	Windows.ClientToScreen(Handle, Result.BottomRight);
end;

function TMyTrackBar.FGetSeekRect: TRect;
//つまみがスライドする部分のRect
//座標はクライアント座標
begin
	SendMessage(Handle, TBM_GETCHANNELRECT, 0, LPARAM(@Result));
end;

function TMyTrackBar.FGetSeekScreenRect: TRect;
//↑のスクリーン座標のRect
begin
	Result := FGetSeekRect;
	Windows.ClientToScreen(Handle, Result.TopLeft);
	Windows.ClientToScreen(Handle, Result.BottomRight);
end;

function TMyTrackBar.FGetSeekWidth: Integer;
//スライドする部分の幅
var
	l_Rect: TRect;
begin
	l_Rect := FGetSeekRect;
	Result := l_Rect.Right - l_Rect.Left;
end;

function TMyTrackBar.FGetThumbHold : Boolean; //つまみを触っているか
//2011-08-06:
begin
	Result := FbThumbHold;
end;

function TMyTrackBar.FGetTouched : Boolean; //トラックバーを触っているか
//2011-08-06:
begin
	Result := FbTouched;
end;

procedure TMyTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	FbThumbHold := (Button = mbLeft) and (PtInRect(FGetThumbRect, Point(X, Y)));
	FbTouched   := (Button = mbLeft);

	inherited;
end;

procedure TMyTrackBar.MouseMove(Shift: TShiftState; X, Y: Integer);
var
	l_Rect    : TRect;
	li_Width  : Integer;
	li_ThumbWidth : Integer;
	li_Center : Integer;
	li_Start  : Integer;
	li_End    : Integer;
//	li_Pos    : Integer;
begin
	l_Rect := Self.FGetSeekRect;

	if (X < l_Rect.Left)
	then begin
		//範囲外・左
		FiHoverPos := -1;
	end
	else
	if (X > l_Rect.Right)
	then begin
		//範囲外・右
		FiHoverPos := -1;
	end
	else
	begin
		//範囲内
		li_ThumbWidth := gfniRectWidth(Self.FGetThumbRect);
		li_Center := gfniRoundUp(li_ThumbWidth / 2); //スライダーボタンの幅の中心
		li_Width  := Self.FGetSeekWidth;             //スライダーのスライドする正味のボックスの幅
		li_Start  := l_Rect.Left + li_Center;
		if (X >= li_Start)
		then begin
			li_End := l_Rect.Right - li_Center;
			if (X <= li_End)
			then begin
				FiHoverPos := Trunc((X - li_Start) / (li_Width - li_ThumbWidth) * (Self.Max - Self.Min) + 0.5);
			end
			else
			begin
				FiHoverPos := Self.Max;
			end;
		end
		else
		begin
			FiHoverPos := Self.Min;
		end;
	end;

	inherited;
end;

procedure TMyTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
	inherited;

	FbThumbHold := False;
	FbTouched   := False;
end;

procedure TMyTrackBar.DoExit;
begin
	FbThumbHold := False;
	FbTouched   := False;

	inherited;
end;


//------------------------------------------------------------------------------
procedure Register;
begin
	RegisterComponents('Samples', [TMyTrackBar]);
end;

end.