Question

我创建了一个源自TScrollbox的自定义滚动框，它的工作方式相同，只是当它在滚动条的客户区域中拖动时它会滚动。

现在我的问题是，当我的CustomScrollbox中的按钮或面板上有鼠标时，我无法拖动滚动。

MouseDown，MouseUp，MouseMove覆盖不会触发，因为它会悬停在不同的控件中。

当我开始拖动时，如何跟踪MouseDown，MouseUp，MouseMove并阻止按钮/面板事件触发（在我的CustomScrollbox内）？

这是我smooth CustomScrollbox

的视频

Answer 1

因此，您希望调整所有子项的鼠标按下行为，以便在启动拖动操作时，应忽略单击子项的鼠标事件。但是当没有执行拖动时，则需要像往常一样触发孩子的鼠标事件。

实际上并不是一个糟糕的问题。由于大多数默认控件交互都与鼠标按钮的 release 紧密相关（例如OnClick处理WM_LBUTTONUP），因此仍然应该以直观的方式实现。

我尝试了下面的代码，确实感觉非常好。它涉及：

处理WM_PARENTNOTIFY以便在点击子控件时捕获，
绕过Child.OnMouseMove和Child.OnMouseUp，
当移动超过Mouse.DragThreshold时将控制权转移到滚动框，
在拖动之前将焦点重置为上一个焦点控制
取消拖动后对子鼠标事件所做的所有更改。

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.

注意：如果未启动拖动（鼠标移动＆lt; Mouse.DragThreshold），则单击的子项的所有鼠标和单击事件将保持不变。否则只会Child.OnMouseDown开火！

出于测试目的，this answer已纳入上述代码中。

感谢@TLama建议使用WM_PARENTNOTIFY。

TScrollbox MouseDown覆盖

1 个答案: