delphi dbgrid 滚动条拖动
delphi 中怎么实现拖动dbgrid滚动条的同时,dbgrid的网格也跟着变化。谢谢
追问:怎么实现dbgird里的内容也跟着走啊 我现在是 只有松手时dbgird才变化,怎么实现同时变化啊 谢谢
delphi 中怎么实现拖动dbgrid滚动条的同时,dbgrid的网格也跟着变化。谢谢
追问:怎么实现dbgird里的内容也跟着走啊 我现在是 只有松手时dbgird才变化,怎么实现同时变化啊 谢谢
答案:拖动dbgrid滚动条的时候,关联的数据库记录位置会发生变化,会触发数据控件的AfterScroll事件,在这个事件中处理dbgrid表格就可以了
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;这样就能正常使用了~~~
给你个我一直使用的单元:
//////////////////////////////////////////
unit uDBGridEx;
interface
uses
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;implementation
procedure 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.
//////////////////////////////////////////////////////////放个DBGrid1, 加载大量数据, 然后试试看效果如果, 支持翻页滚动(按住CTRL键).
unit Unit1;
interface
uses
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;implementation
uses uDBGridEx;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
TDBGridEx.Create(Application, DBGrid1);
end;end.
给你这个我一直使用的单元:
建个工程,放个DBGrid1加载大量数据用下边的代码试试效果, 看看能否达到你的要求吧.
//////////////////////////////////////////////////////////////////////////
unit uDBGridEx;
interface
uses
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;implementation
procedure 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:
上一个:VB 和 Delphi 的区别
下一个:Delphi 菱行代码问题