我用訊息來處理 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.