再谈DBGrid斑马纹效果 和 解决DBGrid支持滚轮效果最终方法 希望对各位大富翁有点帮助 ( 积分: 300 )

// author :jfyes
// date: 2005-3-9 整理
// remark: DBGrid 技巧
//A).解决DBGrid支持滚轮效果;
//B). 再谈DBGrid斑马纹效果

//A）.解决DBGrid支持滚轮效果最终方法
//1). 是改写DBGrid, 只不过改太罗索, 如果通过DBGrid1.WindowProc来处理是个方法如下：
var
OldGridWnd : TWndMethod;
procedure Tfm_Main.NewGridWnd(var Message : TMessage);
var
IsNeg : Boolean;
begin
if Message.Msg = WM_MOUSEWHEEL then
begin
IsNeg := Short(Message.WParamHi) < 0;
if IsNeg then
DBGrid1.DataSource.DataSet.MoveBy(1)
else
DBGrid1.DataSource.DataSet.MoveBy(-1);
end
else
OldGridWnd(Message);
end;
procedure Tfm_Main.FormCreate(Sender: TObject);
begin
OldGridWnd := DBGrid1.WindowProc ;
DBGrid1.WindowProc := NewGridWnd;
end;
2). WindowProc,这种方法不容易移植并麻烦，方便还是application.message来处理比容易，就是程式性能
有所降低。
procedure Tfm_Main.OnMouseWheel(Var Msg :TMsg;var Handled:Boolean);
begin
if Msg.message = WM_MouseWheel then
begin
if Msg.wParam > 0 then
begin
if DBGrid1.Focused then
DBGrid1.DataSource.DataSet.MoveBy(-1)
end
else
begin
if DBGrid1.Focused then
DBGrid1.DataSource.DataSet.MoveBy(1);
end;
Handled:= True;
end;
end;
procedure Tfm_Main.FormCreate(Sender: TObject);
begin
application.OnMessage := OnMouseWheel;
end;

3).如果一个表单有多个DBGrid就要改成如下还要简要:
procedure Tfm_Main.OnMouseWheel(Var Msg :TMsg;var Handled:Boolean);
begin
if Msg.message = WM_MouseWheel then
begin
if not(ActiveControl is TDBGrid) then Exit;
if Msg.wParam > 0 then
TDBGrid(ActiveControl).DataSource.DataSet.MoveBy(-1)
else
TDBGrid(ActiveControl).DataSource.DataSet.MoveBy(1);
Handled:= True;
end;
end;

//==============================================================
//B). 再谈DBGrid斑马纹效果
// 曾在DFW上看到多种实现DBGrid的斑马纹效果但其结果不是很理想
//1).第一种方法是改写DBGrid，重新继承写一个，那就有点小题大做了。
//2).直接在OnDrawColumnCell解决最好。但是看了许多解决方法都是DataSet.RecNo来实现
//，但这样就不是非常好的效果，insert就不行了，相信有很多DFW有过这样的情况。
//但是DataSet.RecNo和TCustomGrid(Sender).MouseCoord(X, Y).Y 来结合，事情就完全解决；如下：

procedure Tfm_Main.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var
RowNo: Integer;
begin
RowNo := TDBGrid(sender).DataSource.DataSet.RecNo; // 这里可以不要但这比MouseCoord效率高
if RowNo = -1 then //这里是dsInsert 状态的值
RowNo := TCustomGrid(Sender).MouseCoord(Rect.Left + 1, Rect.Top + 1).Y; //这是取行号
with TDBGrid(Sender).canvas do
begin
if RowNo Mod 2 = 0 then
Brush.Color := clInfoBk
else
Brush.Color := clwhite;
if (state =[gdSelected])or(state =[gdSelected, gdFocused]) then
begin
Brush.Color := clblue;
font.Color := clRed;
end;
Pen.Mode := pmMask;
end; // with TDBGrid(Sender).canvas do
(sender as TDBGrid).DefaultDrawColumnCell(Rect, datacol, column, State);
end;

// 希望对各位大富翁有点帮助。

// author :jfyes
// date: 2005-3-9 整理
// remark: DBGrid 技巧
//A).解决DBGrid支持滚轮效果;
//B). 再谈DBGrid斑马纹效果

//A）.解决DBGrid支持滚轮效果最终方法
//1). 是改写DBGrid, 只不过改太罗索, 如果通过DBGrid1.WindowProc来处理是个方法如下：
var
OldGridWnd : TWndMethod;
procedure Tfm_Main.NewGridWnd(var Message : TMessage);
var
IsNeg : Boolean;
begin
if Message.Msg = WM_MOUSEWHEEL then
begin
IsNeg := Short(Message.WParamHi) < 0;
if IsNeg then
DBGrid1.DataSource.DataSet.MoveBy(1)
else
DBGrid1.DataSource.DataSet.MoveBy(-1);
end
else
OldGridWnd(Message);
end;
procedure Tfm_Main.FormCreate(Sender: TObject);
begin
OldGridWnd := DBGrid1.WindowProc ;
DBGrid1.WindowProc := NewGridWnd;
end;
2). WindowProc,这种方法不容易移植并麻烦，方便还是application.message来处理比容易，就是程式性能
有所降低。
procedure Tfm_Main.OnMouseWheel(Var Msg :TMsg;var Handled:Boolean);
begin
if Msg.message = WM_MouseWheel then
begin
if Msg.wParam > 0 then
begin
if DBGrid1.Focused then
DBGrid1.DataSource.DataSet.MoveBy(-1)
end
else
begin
if DBGrid1.Focused then
DBGrid1.DataSource.DataSet.MoveBy(1);
end;
Handled:= True;
end;
end;
procedure Tfm_Main.FormCreate(Sender: TObject);
begin
application.OnMessage := OnMouseWheel;
end;

3).如果一个表单有多个DBGrid就要改成如下还要简要:
procedure Tfm_Main.OnMouseWheel(Var Msg :TMsg;var Handled:Boolean);
begin
if Msg.message = WM_MouseWheel then
begin
if not(ActiveControl is TDBGrid) then Exit;
if Msg.wParam > 0 then
TDBGrid(ActiveControl).DataSource.DataSet.MoveBy(-1)
else
TDBGrid(ActiveControl).DataSource.DataSet.MoveBy(1);
Handled:= True;
end;
end;

//==============================================================
//B). 再谈DBGrid斑马纹效果
// 曾在DFW上看到多种实现DBGrid的斑马纹效果但其结果不是很理想
//1).第一种方法是改写DBGrid，重新继承写一个，那就有点小题大做了。
//2).直接在OnDrawColumnCell解决最好。但是看了许多解决方法都是DataSet.RecNo来实现
//，但这样就不是非常好的效果，insert就不行了，相信有很多DFW有过这样的情况。
//但是DataSet.RecNo和TCustomGrid(Sender).MouseCoord(X, Y).Y 来结合，事情就完全解决；如下：

procedure Tfm_Main.DBGrid1DrawColumnCell(Sender: TObject;
const Rect: TRect; DataCol: Integer; Column: TColumn;
State: TGridDrawState);
var
RowNo: Integer;
begin
RowNo := TDBGrid(sender).DataSource.DataSet.RecNo; // 这里可以不要但这比MouseCoord效率高
if RowNo = -1 then //这里是dsInsert 状态的值
RowNo := TCustomGrid(Sender).MouseCoord(Rect.Left + 1, Rect.Top + 1).Y; //这是取行号
with TDBGrid(Sender).canvas do
begin
if RowNo Mod 2 = 0 then
Brush.Color := clInfoBk
else
Brush.Color := clwhite;
if (state =[gdSelected])or(state =[gdSelected, gdFocused]) then
begin
Brush.Color := clblue;
font.Color := clRed;
end;
Pen.Mode := pmMask;
end; // with TDBGrid(Sender).canvas do
(sender as TDBGrid).DefaultDrawColumnCell(Rect, datacol, column, State);
end;

// 希望对各位大富翁有点帮助。

标题有别字,"在谈"应该为"再谈"

1.代码有漏洞,如果DBGrid没有关联DataSource,代码肯定出错,应该加上判断语句:
if assigned(DBGrid1.DataSource) and assigned(DBGrid1.DataSource.DataSet) and DBGrid1.DataSource.DataSet.active then
DBGrid1.DataSource.DataSet.MoveBy(1)

2.某些时候,TDBGrid(sender).DataSource.DataSet.RecNo不正确,比如,新增记录时为-1,会造成全Grid为同一种颜色.

还有
左边固定列显示序号的问题

谢谢ysai的指点 !

问一个很菜的问题：这里所说的滚轮效果是指记录的循环滚动吗？象火车站大屏幕的信息那样？

直接用DevExpress Grid，功能很强呀！

上楼：
晕，滚轮就是鼠标中间那个轮。

收藏了。多谢楼主。

不好意思,俺一直在使用wwDBGrid

谁能帮我想想滚屏的实现方法？在Delphi或者VB之中。有没有稍简单一点的？
（1）显示出数据的滚动效果，
（2）当鼠标停留在某行数据时，可以给出适当的提示
（3）单击或双击时，可以跳转到用以显示明细内容的界面。

收藏了。多谢楼主。

好方法！值得收藏！

多人接受答案了。

好方法！值得收藏！