So you want to adjust the mouse down behaviour of all childs, in such way that when a dragging operation is being initiated, the mouse events of the clicked child should be ignored. But when no drag is performed, then it would be required to fire the child's mouse events as usual.
Not a bad question actually. Since most of the default control interaction is tight to the release of the mouse button (e.g. OnClick is handled in WM_LBUTTONUP), this still should be possible in an intuitive manner.
I tried the code below, and it feels quite nice indeed. It involves:
- handling
WM_PARENTNOTIFY to catch when a child control is clicked on,
- bypassing
Child.OnMouseMove and Child.OnMouseUp,
- transfer control to the scrollbox when the move exceeds
Mouse.DragThreshold,
- resetting focus to the previous focussed control before the drag,
- canceling all changes made to the child's mouse events after the drag.
unit Unit2;
interface
uses
Windows, Messages, Classes, Controls, Forms, StdCtrls, ExtCtrls;
type
TScrollBox = class(Forms.TScrollBox)
private
FChild: TControl;
FDragging: Boolean;
FPrevActiveControl: TWinControl;
FPrevScrollPos: TPoint;
FPrevTick: Cardinal;
FOldChildOnMouseMove: TMouseMoveEvent;
FOldChildOnMouseUp: TMouseEvent;
FSpeedX: Single;
FSpeedY: Single;
FStartPos: TPoint;
FTracker: TTimer;
function ActiveControl: TWinControl;
procedure ChildMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ChildMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
function GetScrollPos: TPoint;
procedure SetScrollPos(const Value: TPoint);
procedure Track(Sender: TObject);
procedure WMParentNotify(var Message: TWMParentNotify);
message WM_PARENTNOTIFY;
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;
public
constructor Create(AOwner: TComponent); override;
property ScrollPos: TPoint read GetScrollPos write SetScrollPos;
end;
TForm2 = class(TForm)
ScrollBox1: TScrollBox;
...
end;
implementation
{$R *.dfm}
{ TScrollBox }
type
TControlAccess = class(TControl);
function TScrollBox.ActiveControl: TWinControl;
var
Control: TWinControl;
begin
Result := Screen.ActiveControl;
Control := Result;
while (Control <> nil) do
begin
if Control = Self then
Exit;
Control := Control.Parent;
end;
Result := nil;
end;
procedure TScrollBox.ChildMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if (Abs(FChild.Left + X - FStartPos.X) > Mouse.DragThreshold) or
(Abs(FChild.Top + Y - FStartPos.Y) > Mouse.DragThreshold) then
begin
MouseCapture := True;
TControlAccess(FChild).OnMouseMove := FOldChildOnMouseMove;
TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
MouseDown(mbLeft, Shift, FChild.Left + X, FChild.Top + Y);
FChild := nil;
if FPrevActiveControl <> nil then
FPrevActiveControl.SetFocus;
end
else
if Assigned(FOldChildOnMouseMove) then
FOldChildOnMouseMove(Sender, Shift, X, Y);
end;
procedure TScrollBox.ChildMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if FChild <> nil then
begin
if Assigned(FOldChildOnMouseUp) then
FOldChildOnMouseUp(Sender, Button, Shift, X, Y);
TControlAccess(FChild).OnMouseMove := FOldChildOnMouseMove;
TControlAccess(FChild).OnMouseUp := FOldChildOnMouseUp;
FChild := nil;
end;
end;
constructor TScrollBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FTracker := TTimer.Create(Self);
FTracker.Enabled := False;
FTracker.Interval := 15;
FTracker.OnTimer := Track;
end;
function TScrollBox.GetScrollPos: TPoint;
begin
Result := Point(HorzScrollBar.Position, VertScrollBar.Position);
end;
procedure TScrollBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
FDragging := True;
FPrevTick := GetTickCount;
FPrevScrollPos := ScrollPos;
FTracker.Enabled := True;
FStartPos := Point(ScrollPos.X + X, ScrollPos.Y + Y);
Screen.Cursor := crHandPoint;
inherited MouseDown(Button, Shift, X, Y);
end;
procedure TScrollBox.MouseMove(Shift: TShiftState; X, Y: Integer);
begin
if FDragging then
ScrollPos := Point(FStartPos.X - X, FStartPos.Y - Y);
inherited MouseMove(Shift, X, Y);
end;
procedure TScrollBox.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
FDragging := False;
Screen.Cursor := crDefault;
inherited MouseUp(Button, Shift, X, Y);
end;
procedure TScrollBox.SetScrollPos(const Value: TPoint);
begin
HorzScrollBar.Position := Value.X;
VertScrollBar.Position := Value.Y;
end;
procedure TScrollBox.Track(Sender: TObject);
var
Delay: Cardinal;
begin
Delay := GetTickCount - FPrevTick;
if FDragging then
begin
if Delay = 0 then
Delay := 1;
FSpeedX := (ScrollPos.X - FPrevScrollPos.X) / Delay;
FSpeedY := (ScrollPos.Y - FPrevScrollPos.Y) / Delay;
end
else
begin
if (Abs(FSpeedX) < 0.005) and (Abs(FSpeedY) < 0.005) then
FTracker.Enabled := False
else
begin
ScrollPos := Point(FPrevScrollPos.X + Round(Delay * FSpeedX),
FPrevScrollPos.Y + Round(Delay * FSpeedY));
FSpeedX := 0.83 * FSpeedX;
FSpeedY := 0.83 * FSpeedY;
end;
end;
FPrevScrollPos := ScrollPos;
FPrevTick := GetTickCount;
end;
procedure TScrollBox.WMParentNotify(var Message: TWMParentNotify);
begin
inherited;
if Message.Event = WM_LBUTTONDOWN then
begin
FChild := ControlAtPos(Point(Message.XPos, Message.YPos), False, True);
if FChild <> nil then
begin
FPrevActiveControl := ActiveControl;
FOldChildOnMouseMove := TControlAccess(FChild).OnMouseMove;
TControlAccess(FChild).OnMouseMove := ChildMouseMove;
FOldChildOnMouseUp := TControlAccess(FChild).OnMouseUp;
TControlAccess(FChild).OnMouseUp := ChildMouseUp;
end;
end;
end;
end.
Note: When no drag is initiated (mouse movement < Mouse.DragThreshold), all mouse and click events of the clicked child remain intact. Otherwise only Child.OnMouseDown will fire!
For testing purposes, this answer is incorporated in the code above.
With thanks to @TLama for suggesting to use WM_PARENTNOTIFY.
