TScrollbox MouseDown override

问题

I created a Custom scrollbox derives from TScrollbox that works the same except that it will scrolls when dragging in the client area aside from its scrollbars.

My problem now is i cannot Drag To Scroll when mouse is on a button or panel inside my CustomScrollbox.

the MouseDown, MouseUp, MouseMove override will not trigger because it hovers into different controls.

How can I keep tracking the MouseDown, MouseUp, MouseMove and prevent Button/Panels events from firing(inside my CustomScrollbox) when i start dragging?

here's the video of my smooth CustomScrollbox

回答1:

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.

来源：https://stackoverflow.com/questions/9595166/tscrollbox-mousedown-override

标签

Delphi

smooth-scrolling

custom-scrolling

tscrollbox