Question

delphi dbgrid 滚动条拖动

delphi 中怎么实现拖动dbgrid滚动条的同时，dbgrid的网格也跟着变化。谢谢

Answer 1

给你这个我一直使用的单元: 建个工程,放个DBGrid1加载大量数据用下边的代码试试效果, 看看能否达到你的要求吧.//////////////////////////////////////////////////////////////////////////unit uDBGridEx;interfaceuses
Windows, Forms, Classes, Messages, DBGrids;type
TDBGridEx = class(TComponent)
private
D: TDBGrid;
F: TWndMethod;
protected
procedure DBGridProc(var Message:TMessage);virtual;
Public
constructor Create(AOwner: TComponent; DBGrid: TDBGrid);reintroduce;
destructor Destroy; override;
end;procedure WiseDBGrid(DBGrid: TDBGrid);overload;
procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;implementationprocedure WiseDBGrid(DBGrid: TDBGrid);overload;
begin
TDBGridEx.Create(Application, DBGrid);
end;procedure WiseDBGrid(AForm: TForm; DBGrid: TDBGrid);overload;
begin
TDBGridEx.Create(AForm, DBGrid);
end;{ TDBGridEx }constructor TDBGridEx.Create(AOwner: TComponent; DBGrid: TDBGrid);
begin
inherited Create(AOwner);
F := DBGrid.WindowProc;
D := DBGrid;
D.WindowProc := DBGridProc;
end;procedure TDBGridEx.DBGridProc(var Message: TMessage);
var
si: TScrollInfo;
Par: WPARAM;
begin
case Message.Msg of
WM_MOUSEWHEEL: //鼠标中键
begin
FillChar(si,SizeOf(si),0);
si.cbSize := SizeOf(si); //拿全部信息
si.fMask := SIF_TRACKPOS or SIF_RANGE or SIF_POS or SIF_PAGE;
with TWMMouseWheel(Message) do begin
GetScrollInfo(D.Handle, SB_VERT, si); // 拿滚动条相关信息
if WheelDelta <0 then //小于 0 则表示向下滚动
begin
if Keys = MK_CONTROL then //按下CTRL键,则翻页滚动.
Par := SB_PAGEDOWN
else Par := SB_LINEDOWN; //不按特殊键,则单行滚动
D.Perform(WM_VSCROLL,Par,0);
end
else begin
if Keys = MK_CONTROL then //同上,只是滚动方向相反
Par := SB_PAGEUP
else Par := SB_LINEUP;
D.Perform(WM_VSCROLL,Par,0);
end;
end;
end;
WM_VSCROLL: //纵向滚动条
begin
with TWMVScroll(Message) do
begin
case ScrollCode of
SB_THUMBTRACK:
D.Perform(WM_VSCROLL,SB_THUMBPOSITION,Pos)
end;
end;
end;
end;
F(Message);
end;destructor TDBGridEx.Destroy;
begin
if (D <> nil) then D.WindowProc := F;
inherited Destroy;
end;end.
//////////////////////// Form1 的代码 unit Unit1;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Grids, DBGrids, DB, ADODB;type
TForm1 = class(TForm)
ADOConnection1: TADOConnection;
ADOTable1: TADOTable;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementationuses uDBGridEx;{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
TDBGridEx.Create(Application, DBGrid1);
end;end.

Answer 2

delphi dbgrid确实是个BUG，不过有第三方控件的~~~或者在窗体上添加一个ApplicationEvent控件，然后在它的OnMessage事件里写以下代码：
procedure TForm1.ApplicationEvents1Message(var Msg:tagMSG;var Handled:Boolean);
begin
if(DBGrid1.Focused)And(Msg.message=WM_MOUSEWHEEL)then
begin
if Msg.wParam>0 then
SendMessage(DBGrid1.Handle, WM_KEYDOWN, VK_UP, 0)
else
SendMessage(DBGrid1.Handle, WM_KEYDOWN, VK_DOWN, 0);
Handled := True;
end;
end;这样就能正常使用了~~~

Answer 3

拖动dbgrid滚动条的时候，关联的数据库记录位置会发生变化，会触发数据控件的AfterScroll事件，在这个事件中处理dbgrid表格就可以了