Delphi DBgrid DBCtrlGrid控件的滾動問題
1、不支持鼠標中鍵
2、鼠標一定要松開才生效
3、滾動條才滾動的時候數據庫也會跟著滾動 (不能算缺點只有不一樣的方式，如果能提供多種選擇就好了)
以上1、2點現可以解決。3點暫沒有找到方法
用法
TDBGridEx.Create(Application, DBGrid1);
TDBCtrlGridEx.Create(Application, DBCtrlGrid1);
//DBGridEx單元代碼
//////////////////////////////////////////////////////////////////////////
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.
//DBCtrlGridEx單元代碼
//////////////////////////////////////////////////////////////////////////
unit uDBCtrlGridEx;
interface
uses
Windows, Forms, Classes, Messages, DBCGrids;
type
TDBCtrlGridEx = class(TComponent)
private
D: TDBCtrlGrid;
F: TWndMethod;
protected
procedure DBCtrlGridProc(var Message:TMessage);virtual;
Public
constructor Create(AOwner: TComponent; DBCtrlGrid: TDBCtrlGrid);reintroduce;
destructor Destroy; override;
end;
procedure WiseDBCtrlGrid(DBCtrlGrid: TDBCtrlGrid);overload;
procedure WiseDBCtrlGrid(AForm: TForm; DBCtrlGrid: TDBCtrlGrid);overload;
implementation
procedure WiseDBCtrlGrid(DBCtrlGrid: TDBCtrlGrid);overload;
begin
TDBCtrlGridEx.Create(Application, DBCtrlGrid);
end;
procedure WiseDBCtrlGrid(AForm: TForm; DBCtrlGrid: TDBCtrlGrid);overload;
begin
TDBCtrlGridEx.Create(AForm, DBCtrlGrid);
end;
{ TDBCtrlGridEx }
constructor TDBCtrlGridEx.Create(AOwner: TComponent; DBCtrlGrid: TDBCtrlGrid);
begin
inherited Create(AOwner);
F := DBCtrlGrid.WindowProc;
D := DBCtrlGrid;
D.WindowProc := DBCtrlGridProc;
end;
procedure TDBCtrlGridEx.DBCtrlGridProc(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 TDBCtrlGridEx.Destroy;
begin
if (D <> nil) then D.WindowProc := F;
inherited Destroy;
end;
end.