我用消息来处理 Dbgrid 鼠标中轮滚动消息的总结

以前看到别人做过这样一个功能：
1。用 DbGrid 来显示数据，数据很多，当我滚动鼠标中轮时，数据不是向下滚动，而是水平方向上滚动，当时感到很奇怪，这是怎么实现的呢？
2。还有就是Dbgrid 不支持滚动中轮时，记录也滚动，而别人也做出这个来了，这是怎么实现的呢？

我一直带着这两个问题,但总没有时间解决，有一天在大富翁上看到了一篇 DBGrid 使用大全 里讲到如何实现我的第二个问题（可能也讲到了第一个问题，但我没有细看，篇幅很长的）
它的解决办法是

--------------------------------------------
private
 OldGridWnd : TWndMethod;
procedure NewGridWnd (var Message : TMessage);
public

procedure TForm1.NewGridWnd(var Message: TMessage);
var
 IsNeg : Boolean;
begin
 if Message.Msg = WM_MOUSEWHEEL then
 begin
   IsNeg := Short(Message.WParamHi) < 0;
   if IsNeg then
     DBGrid1.DataSource.DataSet.MoveBy(1)
   else
     DBGrid1.DataSource.DataSet.MoveBy(-1)
 end
 else
   OldGridWnd(Message);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 OldGridWnd := DBGrid1.WindowProc ;
 DBGrid1.WindowProc := NewGridWnd;
end; 

------------------------------------------------ 

就上面这段代码，我当前是什么也不知道，就知道按这样做就可以了，试了试，还真可以了，由于不
知道原理是怎么回事，害得我过了几天给忘了，还得重新看代码。

正好前几天学了学消息，学了一点。就想起了我的这个还没有解决的问题，我想用消息来实现该怎么
做呢?

想想消息的定义，我要想实现 WM_MouseWheel ，好在 private 里定义

procedure WMMouseWheel(var msg:TWMMouseWheel); message WM_MouseWheel;

...

procedure WMMouseWheel(var msg:TWMMouseWheel);
begin
  showmessage('ooo');
  // 先看看在滚动中轮时能不能显示这个信息
end;

程序运行时什么也不显示，但这样没错误，就是这么定义消息的？（如果焦点在窗体上,也就是说窗体上什么
也没有，就会执行这个消息）

后来想到了 dbgrid 中有一个类似的方法，它是用了 windowProc ，这个是什么东东呢？记得说消息是在 wndProc 里处理呀，看了看源码 windowProc 是一个 事件属性，在 TControl 里定义的 ，读写 FWindowProc,
那 FwindowProc 呢？
就在下面

 

constructor TControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FWindowProc := WndProc;          -----> 这里，原来把 wndProc 给了 FWindowProc 了

  FControlStyle := [csCaptureMouse, csClickEvents, csSetCaption, csDoubleClicks];
  FFont := TFont.Create;
  FFont.OnChange := FontChanged;
  FAnchors := [akLeft, akTop];
  FConstraints := TSizeConstraints.Create(Self);
  FConstraints.OnChange := DoConstraintsChange;
  FColor := clWindow;
  FVisible := True;
  FEnabled := True;
  FParentFont := True;
  FParentColor := True;
  FParentShowHint := True;
  FParentBiDiMode := True;
  FIsControl := False;
  FDragCursor := crDrag;
  FFloatingDockSiteClass := TCustomDockForm;
  FHelpType := htContext;
end;

 

好，于是我就写了下面的代码

 private
    p:TWNDMEthod;
    //procedure WMMouseWheel(var msg:TWMMouseWheel);message WM_MOuseWheel;
   
    procedure WindowProcNew(var message:TMessage);  
   
  public
...
...

procedure Tform1.WindowProcNew(var message:tmessage);

begin
 
  if message.Msg=wm_mouseWheel then
  begin
    showmessage('ooo');       --->  先显示一个信息
  end;
  p(message);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
 
  p:=dbgrid1.WindowProc;
  dbgrid1.WindowProc := self.WindowProcNew;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  dbgrid1.WindowProc := p;

end;

可以显示出来，还行，接着添加(没时间了省略了吧)....最后在别人的帮助下，我完成的我想要的功能
代码如下
---------------------------------------------------------

procedure Tform1.WindowProcNew(var message:tmessage);
var
    po: TPoint;
    i:integer;
begin
  po.X := Message.LParamLo;
  po.Y := Message.LParamHi;
  if message.Msg=wm_mouseWheel then
  begin
    with  TWMMouseWheel(message) do
    if GetScrollRange(DBGrid1.Handle,SB_HORZ,po.X,po.Y) and (po.Y>0) then
    begin
       i := getScrollpos(dbgrid1.Handle,windows.SB_HORZ);
       if WheelDelta >0 then
       begin
         sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineleft,0);
         if i<=po.x then
         //  sendmessage(dbgrid1.Handle,wm_Vscroll,sb_lineup,0);
         //  self.DBGrid1.DataSource.DataSet.Prior;
         sendmessage(dbgrid1.Handle,WM_KEYdown,vk_up,0);
       end
       else
       begin
         sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineright,0);
         if i>=po.y then
           //f.DBGrid1.DataSource.DataSet.next;
           //sendmessage(dbgrid1.Handle,wm_vscroll,sb_linedown,0);
         sendmessage(dbgrid1.Handle,wm_keydown,vk_down,0);
       end;
     result := 1;
     exit;
    end;
  end;
  p(message);
end;

-------------------------------------------------------------

全部的代码为:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBTables, Grids, DBGrids;

type
  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    Table1: TTable;
    DataSource1: TDataSource;
    DBGrid2: TDBGrid;
    DBGrid3: TDBGrid;
    Table2: TTable;
    DataSource2: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    p:TWNDMEthod;
    procedure WMMouseWheel(var msg:TWMMouseWheel);message WM_MOuseWheel;
    //procedure WMCommand(var msg:TWMCommand);message WM_Command;
    //procedure MouseWheelHandler(var msg:Tmessage);override;  // 我用这个可以在滚动鼠标
                                                             // 中轮时水平滚动条移动
    procedure WindowProcNew(var message:TMessage);   // 我用这个记录先上下移动，向下移到 DBGrid
                                                     // 显示出来的记录的最后一条记录 ,水平滚动条
                                                     // 才开始移动
   
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure tform1.WMMouseWheel(var msg:TWMMouseWheel);
begin
  showmessage('oo');
end;
{procedure TForm1.WMCommand(var msg:TWMcommand);
begin

end; }
{procedure TForm1.MouseWheelHandler(var msg:Tmessage);
var
  c:TwinControl;
  p:tpoint;
begin
  p.X := msg.LParamLo;
  p.y := msg.LParamHi;

  c := FindVclWindow(p);
  if c<>nil then
  begin
    if c=dbgrid2 then
    with TWMMouseWheel(msg) do
    begin
     // if GetScrollRange(DBGrid2.Handle,SB_HORZ,p.X,p.Y) and (p.Y>0) then
      begin
        if WheelDelta > 0 then
          SendMessage(DBGrid2.Handle,WM_HSCROLL,SB_LINELEFT,SB_HORZ)
        else
          SendMessage(DBGrid2.Handle,WM_HSCROLL,SB_LINERIGHT,SB_HORZ);
        Result := 1;
      end;// else
      //inherited;
    end;
  end;

  
end;}
procedure Tform1.WindowProcNew(var message:tmessage);
var
    po: TPoint;
    i:integer;
begin
  po.X := Message.LParamLo;
  po.Y := Message.LParamHi;
  if message.Msg=wm_mouseWheel then
  begin
    with  TWMMouseWheel(message) do
    if GetScrollRange(DBGrid1.Handle,SB_HORZ,po.X,po.Y) and (po.Y>0) then
    begin
       i := getScrollpos(dbgrid1.Handle,windows.SB_HORZ);
       if WheelDelta >0 then
       begin
         sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineleft,0);
         if i<=po.x then
         //  sendmessage(dbgrid1.Handle,wm_Vscroll,sb_lineup,0);
         //  self.DBGrid1.DataSource.DataSet.Prior;
         sendmessage(dbgrid1.Handle,WM_KEYdown,vk_up,0);
       end
       else
       begin
         sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineright,0);
         if i>=po.y then
           //f.DBGrid1.DataSource.DataSet.next;
           //sendmessage(dbgrid1.Handle,wm_vscroll,sb_linedown,0);
         sendmessage(dbgrid1.Handle,wm_keydown,vk_down,0);
       end;
     result := 1;
     exit;
    end;
  end;
  p(message);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
  p:=dbgrid1.WindowProc;
  dbgrid1.WindowProc := self.WindowProcNew;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  dbgrid1.WindowProc := p;

end;

end.