我用消息来处理 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.

  • 0
    点赞
  • 0
    收藏
  • 打赏
    打赏
  • 2
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
©️2022 CSDN 皮肤主题:大白 设计师:CSDN官方博客 返回首页
评论 2

打赏作者

qi_jianzhou

你的鼓励将是我创作的最大动力

¥2 ¥4 ¥6 ¥10 ¥20
输入1-500的整数
余额支付 (余额:-- )
扫码支付
扫码支付:¥2
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值