delphi 使控件支持鼠标滚轴消息


本文整理自网络,侵删。

 这几天要写一个控件,要求能支持鼠标滚轴放大缩小,类似网页上的Google地图。于是我从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这个类中分发消息的一些规则。

相关阅读 >>

Delphi 大小写字符串转换

Delphi 使用int3进行hook处理

Delphi 检测判断字符串是否包含有中文字符

Delphi getwindowhandle

Delphi 收藏字符串处理单元

Delphi webservices 字节数组 base64编码

Delphi xe7开发的获取网页中字符串的编码是否是utf8

Delphi 检验手机号 ismobilenumber

Delphi xml解析、使用treeview呈现效果

Delphi 10 seattle中录制音频

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...