用消息来处理鼠标中轮滚动时水平滚动条移动 --别人对我的帮助

问题：150 分求一段消息代码，熟悉消息处理的高手请进(用消息来处理鼠标中轮滚动时水平滚动条移动) ( 积分：150, 回复：12, 阅读：92 ) 分类：IDE/使用技巧 ( 版主：luyear, menxin )
来自：qi_jianzhou, 时间：2006-4-12 10:29:00, ID：3412067 | 编辑	[显示：小字体 | 大字体]
我想用消息来实现这样一个功能 在 Dbgrid 中，我们滚动鼠标的中轮，可以使记录移动，这里我要做的是滚动中轮时要使水平滚动条移动，向上滚动中轮水平滚动条则向左移动，反之，向下滚动中轮则水平滚动条向右移动，要是没有水平滚动条的话则还像平常的处理-上下移动记录 要求用消息来实现，代码中要有注释（本人对消息不懂，请加详细的注释），先拿 150 分   来自： qi_jianzhou, 时间：2006-4-12 10:53:03, ID：3412127 | 编辑 刷新这么快呀，我刚发的就跑到后面去了 怎么没人回答呢   来自： smokingroom, 时间：2006-4-12 11:12:19, ID：3412177 注释就不必了吧，实在不懂看Windows SDK。 procedure TForm1.MouseWheelHandler(var Message: TMessage); var   Control: TControl;   p: TPoint; begin   p.X := Message.LParamLo;   p.Y := Message.LParamHi;   Control := FindVCLWindow(p);   if Control=DBGrid1 then   begin     with TWMMouseWheel(Message) do     begin       if GetScrollRange(DBGrid1.Handle,SB_HORZ,p.X,p.Y) and (p.Y>0) then       begin         if WheelDelta > 0 then           SendMessage(DBGrid1.Handle,WM_HSCROLL,SB_LINELEFT,SB_HORZ)         else           SendMessage(DBGrid1.Handle,WM_HSCROLL,SB_LINERIGHT,SB_HORZ);         Result := 1;       end else         inherited;     end;   end else     inherited; end;    来自： smokingroom, 时间：2006-4-12 11:14:44, ID：3412183 函数的声明: type   TForm1 = class(TForm)    ...   public     procedure MouseWheelHandler(var Message:TMessage);override;     { Public declarations }   end;   来自： qi_jianzhou, 时间：2006-4-12 13:55:42, ID：3412495 | 编辑 谢谢，我先看看   来自： qi_jianzhou, 时间：2006-4-12 17:48:11, ID：3412885 | 编辑 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;     procedure FormCreate(Sender: TObject);     procedure FormDestroy(Sender: TObject);   private     p:TWNDMEthod;     procedure WMCommand(var msg:TWMCommand);message WM_Command;     procedure MouseWheelHandler(var msg:Tmessage);override;  // 我用这个可以在滚动鼠标                                                              // 中轮时水平滚动条移动     procedure WindowProcNew(var message:TMessage);   //  这个是我自己做的   public     { Public declarations }   end; var   Form1: TForm1; implementation {$R *.dfm} procedure TForm1.WMCommand(var msg:TWMcommand); begin end; // 下面这个是上面程序的 procedure TForm1.MouseWheelHandler(var msg:Tmessage); var   c:TwinControl;   p:tpoint; begin   p.X := msg.LParamLo;       // 鼠标的位置信息是放在 Lparam 里吗？   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         // 这句也清楚 大于 0 是指向上滚动中轮         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;    // 这里为什么要返回 1 呢?       end else       inherited;     end;   end; end; // 下面这个是我写的  不知为什么刚写出来时，运行的不是我想要的 , 当滚动中轮时，记录会向下移动 // 当移动到 dbgrid显示出来的最后一条记录时(这里的最后一条记录是目录在屏幕上显示出来的最后一条记 // 录)，水平滚动条才开始移动, 后来我加上了上面的 MouseWheelHandler 这个过程，我的写的这个也就没有 // 问题了,试着把 MouseWheelHandler 时的代码全注释掉，我的还没有问题，如果把 MouseWheelHandler //  全注释掉，不要这个 MouseWheelHandler 过程，我写的这个的问题也就出来了，不知是什么原因 // 我写的这个问题在哪呢？ procedure Tform1.WindowProcNew(var message:tmessage); var     po: TPoint;   // 之所以这样是看了上面的那个例子了 begin   po.X := Message.LParamLo;   po.Y := Message.LParamHi;   //  下面这句是我的想法，判断消息是不是 wm_mouseWheel   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        if WheelDelta >0 then        begin          sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineleft,0);        end        else        begin          sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineright,0);        end;        // 下面这句还是根据上面的那个例子写出来的        result := 1;     end;   end;   p(message);   // 这个是调用 DBGRid 原始的 windowproc 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. 谢谢高手的指点   来自： smokingroom, 时间：2006-4-13 8:20:49, ID：3413150 if GetScrollRange(DBGrid2.Handle,SB_HORZ,p.X,p.Y) and (p.Y>0) then －－这句是用来判断是否存在水平滚动条 Result := 1;    // 这里为什么要返回 1 呢? －－Result实际上是Message.Result,Message.Result:=1表示此消息已经处理。   p.X := msg.LParamLo;       // 鼠标的位置信息是放在 Lparam 里吗？   p.y := msg.LParamHi; －－根据WM_MOUSEWHEEL消息的定义wParam存放的是鼠标的位置信息。   另外，你写的procedure Tform1.WindowProcNew(var message:tmessage);应该也是没 有问题的，处理方法是一样的，只不过处理消息的地方不一样，你是在DBGrid的 窗口过程中处理，我是在窗体预留的处理WM_MOUSEWHEEL的消息的过程中处理。因为 该消息如果子窗口未作处理，则会转发到上级窗口。   来自： qi_jianzhou, 时间：2006-4-13 9:03:03, ID：3413201 | 编辑 还是有点不太明白 我的这个程序如果写了下面的这个过程 procedure TForm1.MouseWheelHandler(var msg:Tmessage); begin end; 不要任何的实现,那我写的那个就没有问题, 但如果程序中没有 MouseWheelHandler(var msg:Tmessage) 则我的就出现上面的情况了, 为什么呢    来自： smokingroom, 时间：2006-4-13 9:34:33, ID：3413238 procedure Tform1.WindowProcNew(var message:tmessage); var     po: TPoint;   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        if WheelDelta >0 then        begin          sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineleft,0);        end        else        begin          sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineright,0);        end;        result := 1;        Exit;因为已经处理了,不需要调用默认的处理,所以需要退出处理过程     end;   end;   p(message);   end;   来自： qi_jianzhou, 时间：2006-4-13 12:02:26, ID：3413494 | 编辑 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   // 如果滚动到最左边          // 我想发送一个消息，让垂直滚动条向上滚动,这样记录也会向上滚动          // 可以滚动，但如果当前记录现在是在 dbgrid 中显示出来的记录是的最后一条          // 向上滚动中轮时，当水平滚动条到了最左边，接着滚动这时记录就会跳过许多          // 条记录，到 dbgrid 中显示出来的最上面那条记录，然后滚动中轮，记录才会          // 一条一条的向上移动          // sendmessage(dbgrid1.Handle,wm_Vscroll,sb_lineup,0);                    // 我用这句就可以了，但我还想用消息来实现          self.DBGrid1.DataSource.DataSet.Prior;        end        else        begin          sendmessage(dbgrid1.Handle,wm_hscroll,sb_lineright,0);          if i>=po.y then            self.DBGrid1.DataSource.DataSet.next;            //sendmessage(dbgrid1.Handle,wm_vscroll,sb_linedown,0);        end;      result := 1;      exit;     end;   end;   p(message); end;   来自： smokingroom, 时间：2006-4-13 13:50:12, ID：3413660 分别用以下两句代替: SendMessage(DBGrid1.Handle,WM_KEYDOWN,VK_UP,0); SendMessage(DBGrid1.Handle,WM_KEYDOWN,VK_DOWN,0);   来自： qi_jianzhou, 时间：2006-4-13 15:48:05, ID：3413812 | 编辑 谢谢 成功 可否交个朋友 我的 邮箱 qijianzhou289@sohu.com qq 165609409  但不怎么常上   来自： qi_jianzhou, 时间：2006-4-13 15:51:56, ID：3413815 | 编辑 感谢对我的帮助,另开一贴, 送 100 分