Переопределение TScrollbox MouseDown

Итак, вы хотите настроить поведение мыши вниз для всех дочерних элементов таким образом, чтобы при запуске операции перетаскивания события мыши нажатого дочернего элемента игнорировались. Но когда перетаскивание не выполняется, тогда потребуется запускать дочерние события мыши как обычно.

На самом деле неплохой вопрос. Поскольку большая часть взаимодействия с элементами управления по умолчанию связана с отпусканием кнопки мыши (например, 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.

Примечание. Когда перетаскивание не инициируется (движение мыши ‹Mouse.DragThreshold), все события мыши и щелчка дочернего элемента, по которому был выполнен щелчок, остаются неизменными. Иначе сработает только Child.OnMouseDown!

В целях тестирования этот ответ включен в приведенный выше код.

Спасибо @TLama за предложение использовать WM_PARENTNOTIFY.