摘 要：在Delphi 7环境下，以DBGrid控件为基类，设计一个新的控件，使其支持鼠标轮的滚动事件，并对新控件的鼠标轮事件编程，实现数据记录的上下滚动。
    关键词：鼠标轮，DBGrid，VCL，事件，控件

一、 引言  

     当前，很多鼠标都带有鼠标轮装置，这为用户在游览网页或编辑Office文档时都带来很多方便。利用Borland Delphi进行数据库应用系统的开发过程中，DBGrid控件仍然是非常实用的数据感应控件，但是，在Delphi 的最新版本中，Borland公司还没有把鼠标轮事件添加到DBGrid控件中，当DBGrid控件具有大量的数据记录时，用户只能通过“PageUp”、“PageDown”按键或单击DBGrid控件右边的滚动条来完成数据记录的上下滚动。为此，我们以DBGrid控件为基类，设计一个新的控件，使其支持用鼠标轮来完成数据记录的上下滚动。 　

二、原理机制

   1、 重载WndProc方法

Windows是一个消息驱动的操作系统，消息的传递是实现对象间通信和控制的主要手段，在DBGrid控件中滚动鼠标轮时，Windows必然会产生一个对应的消息。经过反复的试验，我们最终在Messages.pas单元中发现Delphi把这一消息命名为WM_MOUSEWHEEL。于是，我们想到了在DBGrid控件的基础上设计一个名为NewDBGrid的控件，并通过重载其WndProc方法来截获WM_MOUSEWHEEL消息，使其支持鼠标轮事件。WndProc是在TControl类中定义的一个虚拟方法，重载该方法可以对消息进行过滤。所谓消息过滤实质是指程序员截获VCL控件的某些消息自行处理，对于这些已处理的消息，VCL控件将不再向它的处理句柄进行分派。由于目前较多文献都已详细地分析了Delphi的消息机制，所以这里就不再深入WndProc方法的讨论，有兴趣的读者可阅读文献[2]。

   2、鼠标轮事件的建立
Delphi的核心是VCL，VCL将大多数的Windows消息转化成控件开发者和使用者都能处理的事件。通过阅读VCL部分源代码，我们在Controls.pas单元中也发现了两个与鼠标轮相关的事件：TMouseWheelEvent和TMouseWheelUpDownEvent，前者表示鼠标轮事件，后者表示鼠标轮上，下滚动事件。这两个事件的声明分别是TMouseWheelEvent = procedure(Sender: TObject; Shift: TShiftState;WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean) of object;和TMouseWheelUpDownEvent = procedure(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean) of object;，主要参数如下：
（1）shift：记录鼠标轮滚动时是否有其它虚拟键按下，一般有这些选项：ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble。
（2）WheelDelta：鼠标轮滚动的距离，向上滚动时为正，向下滚动时为负。
（3）MousePos：鼠标的坐标，由X、Y坐标组成。
（4）Handle：该参数表示鼠标轮的滚动是否已处理。对窗体而言，如果在OnMouseWheel事件过程中将Handle参数设为False，则系统会根据滚动方向再次触发OnMouseWheelUp或OnMouseWheelDown事件。
我们将在NewDBGrid控件中建立OnMouseWheel、OnMouseWheelUp和OnmouseWheelDown事件。Delphi在创建控件时，事件也被当作属性来处理，与其它普通属性相比，事件必须定义为过程类型，并使该过程成为一个对象方法的指针，指向某个潜在的过程。当用户为事件指定处理子程序后，事件便成为指向该子程序的指针。例如本文所要建立的OnMouseWheel事件可采用如下方式进行定义：

type
private
fOnMouseWheel:TMouseWheelEvent;//声明事件变量以保存过程指针
published
property OnMouseWheel: TMouseWheelEvent read fOnMouseWheel write fOnMouseWheel;
end;

可以看出，除了OnMouseWheel被定义为过程类型外，其定义格式与一般属性的直接访问格式几乎完全相同。显然，在重载NewDBGrid控件的WndProc方法时，应在过滤WM_MOUSEWHEEL消息的过程中引发OnMouseWheel等虚方法，格式如下：

procedure TNewDBGrid.WndProc(var Msg: TMessage);
begin
if (Msg.Msg=WM_MOUSEWHEEL) then//判断是否接收到WM_MOUSEWHEEL消息
if Assigned(fOnMouseWheel) then fOnMouseWheel(……);
// 最后调用储存在fOnMouseWheel元素中的方法
inherited;
end;

3、鼠标轮事件的应用
当新的NewDBGrid控件支持鼠标轮事件后，我们可以对OnMouseWheelUp、OnMouseWheelDown事件进行编程：分别用WINDOWS API函数PostMessage往NewDBGrid控件发“VK_PRIOR”、“VK_NEXT”按键消息，使NewDBGrid控件的数据记录随着鼠标轮的滚动而上下滚动。WINDOWS API函数PostMessage的详细用法见文献[3]。

三、代码与实现

    1、 以DBGrid为基类派生NewDBGrid控件
（1）在Delphi 7中，单击菜单[Component]→[New Component]，如图1所示，“Ancestor Type”选择 TDBGrid，“Class Name”填上新控件名称TNewDBGrid，生成的控件放在Samples页。


图1：以DBGrid为基类派生NewDBGrid控件

（2）按下列代码调整NewDBGrid.pas，并保存该单元文件。

unit NewDBGrid;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Grids, DBGrids;
type
TNewDBGrid = class(TDBGrid)
private
fOnMouseWheel:TMouseWheelEvent;// 声明事件变量以保存过程指针
fOnMouseWheelUp:TMouseWheelUpDownEvent;
fOnMouseWheelDown:TMouseWheelUpDownEvent;
{ Private declarations }
protected
{ Protected declarations }
public
procedure WndProc(var Msg:TMessage);override;//重载WndProc方法
{ Public declarations }
published
property OnMouseWheel:TMouseWheelEvent read fOnMouseWheel write fOnMouseWheel;
//添加鼠标轮滚动事件OnMouseWheel
property OnMouseWheelUp:TMouseWheelUpDownEvent read fOnMouseWheelUp write fOnMouseWheelUp; //添加鼠标轮向上滚动事件OnMouseWheelUp
property OnMouseWheelDown:TMouseWheelUpDownEvent read fOnMouseWheelDown write fOnMouseWheelDown; //添加鼠标轮向下滚动事件OnMouseWheelDown
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Samples', [TNewDBGrid]);//新的NewDBGrid控件安装在Samples页面上
end;
{ TNewDBGrid }
procedure TNewDBGrid.WndProc(var Msg: TMessage);
var
MousePoint:TPoint;
Handled:Boolean;
shift:TShiftState;
begin
if (Msg.Msg=WM_MOUSEWHEEL) then//判断是否接收到WM_MOUSEWHEEL消息
begin
MousePoint.X:=LOWORD(Msg.LParam);//从当前消息中获取鼠标的位置
MousePoint.Y:=HIWORD(Msg.LParam);
Handled:=False;
if(Msg.wParam>0) then//当wParam的值为正时，表示鼠标轮向上滚动
begin
if Assigned(fOnMouseWheelUp) then fOnMouseWheelUp(self,shift,MousePoint,Handled);
//调用储存在fOnMouseWheelUp元素中的方法
end
else
begin
if Assigned(fOnMouseWheelDown) then fOnMouseWheelDown(self,shift,MousePoint,Handled);
//调用储存在fOnMouseWheelDown元素中的方法
end;
if Assigned(fOnMouseWheel) then fOnMouseWheel(self,shift,Msg.WParam,MousePoint,Handled);
//最后调用储存在fOnMouseWheel元素中的方法
if Handled then exit;
end;
inherited;//其它未处理的消息交由父类的控件处理
end;
end.

（3）单击菜单[Component]→[Install Component]，单击“Install Component”窗口的“Browse”按钮，并选取刚才建立的NewDBGrid.pas文件，随后按提示完成TNewDBGrid控件的安装。

2、测试NewDBGrid控件

（1） 在Delphi 7中，新建一个项目，该项目主要的控件及相关属性见表1所示。

控件名称 类 属性名称 值

Table1 TTable DataBaseName DBDEMOS
TableName items.db
DataSource1 TDataSource DataSet Table1
NewDBGrid1 TNewDBGrid DataSource DataSource1

表1：程序中主要控件及相关属性

（2）从“Object Inspector”窗口检查NewDBGrid1控件是否如图2所示，出现三个与鼠标轮相关的事件。

图2：NewDBGrid控件出现的鼠标轮事件

（3）分别对Form1的OnActivate、NewDBGrid1的OnMouseWheelUp和OnMouseWheelDown事件编程。
procedure TForm1.FormActivate(Sender: TObject);
begin
Table1.Active:=True; //打开数据表
NewDBGrid1.Setfocus;
end;
procedure TForm1.NewDBGrid1MouseWheelUp(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
PostMessage(NEWDBGrid1.Handle,WM_KEYDOWN,VK_PRIOR,0);
//往NewDBGrid1发“PageUp”按键的消息，使其数据记录向上翻一页；
PostMessage(NEWDBGrid1.Handle,WM_KEYDOWN,VK_DOWN,0);
//为了体现数据的连续性，往NewDBGrid1发“↓”按键的消息，保留上页的最后一条记录；
end;
procedure TForm1.NewDBGrid1MouseWheelDown(Sender: TObject;
Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
PostMessage(NEWDBGrid1.Handle,WM_KEYDOWN,VK_Next,0);
PostMessage(NEWDBGrid1.Handle,WM_KEYDOWN,VK_UP,0);
end;

四、结束语