unit dabTrackBar;
interface
uses
SysUtils, Classes, Controls, ComCtrls, Messages, Forms,
CommCtrl, StdCtrls;
type
TdabTrackBar =
class(TTrackBar)
private
{ Private-Deklarationen }
fOnChanged : TNotifyEvent;
FOnMouseDown: TMouseEvent;
FControlState: TControlState;
FControlStyle: TControlStyle;
procedure DoMouseDown(
var Message: TWMMouse; Button: TMouseButton;
Shift: TShiftState);
procedure CNHScroll(
var Message: TWMHScroll);
message CN_HSCROLL;
procedure WMLButtonDown(
var Message: TWMLButtonDown);
message WM_LBUTTONDOWN;
procedure WMRButtonDown(
var Message: TWMRButtonDown);
message WM_RBUTTONDOWN;
procedure WMMButtonDown(
var Message: TWMMButtonDown);
message WM_MBUTTONDOWN;
protected
{ Protected-Deklarationen }
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent);
override;
property ControlState: TControlState
read FControlState
write FControlState;
property ControlStyle: TControlStyle
read FControlStyle
write FControlStyle;
published
{ Published-Deklarationen }
property OnChanged: TNotifyEvent
read FOnChanged
write FOnChanged;
property OnMouseDown: TMouseEvent
read FOnMouseDown
write FOnMouseDown;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('
dab', [TdabTrackBar]);
end;
procedure TdabTrackBar.CNHScroll(
var Message: TWMHScroll);
begin
inherited;
if assigned(fOnChanged)
and
(
Message.ScrollCode
in [TB_THUMBPOSITION, TB_LINEUP, TB_LINEDOWN, TB_PAGEUP, TB_PAGEDOWN] )
then
fOnChanged(self);
end;
constructor TdabTrackBar.Create(AOwner: TComponent);
begin
inherited;
FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
end;
procedure TdabTrackBar.DoMouseDown(
var Message: TWMMouse; Button: TMouseButton;
Shift: TShiftState);
begin
if not (csNoStdEvents
in ControlStyle)
then
with Message do
if (Width > 32768)
or (Height > 32768)
then
with CalcCursorPos
do
MouseDown(Button, KeysToShiftState(Keys) + Shift, X, Y)
else
MouseDown(Button, KeysToShiftState(Keys) + Shift,
Message.XPos,
Message.YPos);
end;
procedure TdabTrackBar.WMLButtonDown(
var Message: TWMLButtonDown);
begin
SendCancelMode(Self);
inherited;
if csCaptureMouse
in ControlStyle
then MouseCapture := True;
if csClickEvents
in ControlStyle
then Include(FControlState, csClicked);
DoMouseDown(
Message, mbLeft, []);
end;
procedure TdabTrackBar.WMMButtonDown(
var Message: TWMMButtonDown);
begin
inherited;
DoMouseDown(
Message, mbMiddle, []);
end;
procedure TdabTrackBar.WMRButtonDown(
var Message: TWMRButtonDown);
begin
inherited;
DoMouseDown(
Message, mbRight, []);
end;
end.