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.
谢谢高手的指点
