我想用訊息來實現這樣一個功能
在 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：3413150if 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：3413238procedure 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 分 |
