TScrollBox的修正及使控件支持鼠标滚轴消息

【关键词】 TScrollBox，滚轴消息，OnMouseWheel、OnMouseWheelDown、OnMouseWheelUp

【摘要】

只要在构造函数中把TabStop := True加上，然后重载 function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override; function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override; function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override; 就可以使控件支持鼠标滚轴消息了。

因为需要做一个控件支持鼠标滚轴消息。于是我从 TWinControl 下继承，重写

function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;

但是发现程序在运行的时候只有窗体能得到滚轴消息，控件本身不能，于是想到窗体是整个这个窗体上控件的消息管理者，是不是它过滤了，果然发现：

procedure TCustomForm.MouseWheelHandler(var Message: TMessage);
begin
  with Message do
  begin
    if FFocusedControl <> nil then
      Result := FFocusedControl.Perform(CM_MOUSEWHEEL, WParam, LParam)
    else
      inherited MouseWheelHandler(Message);
  end;
end;

结果是鼠标消息的被主窗体过滤为只发给有焦点的控件（这是合理的），于是想到 TCustomForm 设置焦点的函数：

procedure TCustomForm.SetActive(Value: Boolean);
begin
  FActive := Value;
  if FActiveOleControl <> nil then
    FActiveOleControl.Perform(CM_DOCWINDOWACTIVATE, Ord(Value), 0);
  if Value then
  begin
    if (ActiveControl = nil) and not(csDesigning in ComponentState) then
      ActiveControl := FindNextControl(nil, True, True, False);
    MergeMenu(True);
    SetWindowFocus;
  end;
end;

发现主要控制是由 FindNextControl 来寻找来设置焦点的控件，这个函数是在 TWinControl 中

function TWinControl.FindNextControl(CurControl: TWinControl;
  GoForward, CheckTabStop, CheckParent: Boolean): TWinControl;
var
  I, StartIndex: Integer;
  List: TList;
begin
  Result := nil;
  List := TList.Create;
  try
    GetTabOrderList(List);
    if List.Count > 0 then
    begin
      StartIndex := List.IndexOf(CurControl);
      if StartIndex = -1 then
        if GoForward then
          StartIndex := List.Count - 1
        else
          StartIndex := 0;
      I := StartIndex;
      repeat
        if GoForward then
        begin
          Inc(I);
          if I = List.Count then
            I := 0;
        end
        else
        begin
          if I = 0 then
            I := List.Count;
          Dec(I);
        end;
        CurControl := List[I];
        if CurControl.CanFocus and (not CheckTabStop or CurControl.TabStop) and
          (not CheckParent or (CurControl.Parent = Self)) then
          Result := CurControl;
      until (Result <> nil) or (I = StartIndex);
    end;
  finally
    List.Free;
  end;
end;

细看代码发现主要是

if CurControl.CanFocus and (not CheckTabStop or CurControl.TabStop) and
  (not CheckParent or (CurControl.Parent = Self)) then
  Result := CurControl;

在控制，其中 (not CheckTabStop or CurControl.TabStop) 最重要，因此如果控件在创建的时候没有设置 TabStop 为 True 的话，那么窗体就认为控件不能获得焦点，也就不会发送 CM_MOUSEWHEEL 给控件，至此问题解决，只要在构造函数中把 TabStop := True 加上，然后重载

function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
function DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;

就可以使控件支持鼠标滚轴消息了。题外话：其实 VCL 对 Windows 消息进行了封装，而且加了很多自定义消息，也加了一套分发消息的规则，大家在写控件的时候要注意 TCustomForm 这个类中分发消息的一些规则。

其实 Dephi 的控件 TScrollBox 有 OnMouseWheel 、 OnMouseWheelDown 、 OnMouseWheelUp 方法，但是大家在其中写代码之后会发现其实是不执行的，主要是因为控件没有焦点，只要加上 TScrollBox.TabStop := True 就可以了。