在 Delphi 中, DBGrid 控件是一个开发数据库软件不能不使用的控件, 其功能非常强大, 可以配合 SQL 语句实现几乎所有数据报表的显示, 操作也非常简单, 属性, 过程, 事件等都非常直观, 但是使用中, 有时侯还是需要一些其他功能, 例如打印, 斑马纹显示, 将 DBGrid 中的数据转存到 Excel97 中等等. 这就需要我们定制 DBGrid, 以更好的适应我们的实际需要. 本人根据使用 Delphi 的体会, 定制了 DBGrid, 实现了以上列举的功能, 对于打印功能则是在 DBGrid 的基础上联合 QuickReport 的功能, 直接进行 DBGrid 的打印及预览, 用户感觉不到 QuickReport 的存在, 只需调用方法 WpaperPreview 即可; 对于转存数据到 Excel 也是一样, 不过这里使用的是自动化变量 Excel 而已. 由于程序太长, 不能详细列举, 这里介绍一个完整的实现斑马纹显示的 DBGrid, 名字是 NewDBGrid. 根据这个小程序, 读者可以添加其他更好, 更多, 更实用的功能.
NewDBGrid 的实现原理就是继承 DBGrid 的所有功能, 同时添加新的属性: Wzebra,WfirstColor ,WsecondColor. 当 Wzebra 的值为 True 时, 显示斑马纹效果, 其显示的效果是单数行颜色为 WfirstColor, 双数行颜色为 WsecondColor. 具体的见下面程序清单:
- unit NewDBGrid;
- interface
- uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
- DB, Grids, DBGrids,Excel97;
- type
- TDrawFieldCellEvent = procedure(Sender: TObject; Field: TField;
- var Color: TCOlor;Var Font: TFont;Row:Longint) of object;
- // 新的数据控件由 TDBGrid 继承而来
- TNewDBGrid = class(TDBGrid)
- private
- // 私有变量
- FWZebra: Boolean; // 是否显示斑马颜色
- FWFirstColor : TColor; // 单数行颜色
- FWSecondColor : TCOlor; // 双数行颜色
- FDrawFieldCellEvent : TDrawFieldCellEvent;
- procedure AutoInitialize; // 自动初使化过程
- procedure AutoDestroy;
- function GetWFirstColor : TColor;
- //FirstColor 的读写函数及过程
- procedure SetWFirstColor(Value : TColor);
- function GetWSecondColor : TCOlor;
- procedure SetWSecondColor(Value : TColor);
- function GetWZebra : Boolean;
- procedure SetWZebra(Value : Boolean);
- protected
- procedure Scroll(Distance: Integer); override;
- // 本控件的重点过程
procedure DrawCell(Acol,ARow: Longint;ARect:
- TRect;AState: TGridDrawState); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- published
- property WZebra: Boolean read GetWZebra write SetWZebra;
- property OnDblClick;
- property OnDragDrop;
- property OnKeyUp;
- property OnKeyDown;
- property OnKeyPress;
- property OnEnter;
- property OnExit;
- property OnDrawDataCell;
property WFirstColor : TColor
read GetWFirstColor write SetWFirstColor ;
property WSecondColor : TColor
- read GetWSecondColor write SetWSecondColor ;
- end;
- procedure Register;
- implementation
- procedure Register;
- begin
- RegisterComponents(?Data Controls?, [TNewDBGrid]);
- end;
- procedure TNewDBGrid.AutoInitialize;
- begin
- FWFirstColor := RGB(239,254,247);
- FWSecondColor := RGB(249,244,245);
{可以在次添加需要的其它控件及初使化参数}
- end;
- procedure TNewDBGrid.AutoDestroy;
- begin
{在这里释放自己添加参数等占用的系统资源}
- end;
- procedure TNewDBGrid.SetWZebra(Value : Boolean);
- begin
- FWZebra := Value;
- Refresh;
- end;
- function TNewDBGrid.GetWZebra: Boolean;
- begin
- Result :=FWZebra;
- end;
- function TNewDBGrid.GetWFirstColor : TColor;
- begin
- Result := FWFirstColor;
- end;
- procedure TNewDBGrid.SetWFirstColor(Value : TColor);
- begin
- FWFirstColor := Value;
- Refresh;
- end;
- function TNewDBGrid.GetWSecondColor : TColor;
- begin
- Result := FWSecondColor;
- end;
- procedure TNewDBGrid.SetWSecondColor(Value : TColor);
- begin
- FWSecondColor := Value;
- Refresh;
- end;
- constructor TNewDBGrid.Create(AOwner: TComponent);
- begin
- inherited Create(AOwner);
- AutoInitialize;
- end;
- destructor TNewDBGrid.Destroy;
- begin
- AutoDestroy;
- inherited Destroy;
- end;
- // 实现斑马效果
- procedure TNewDBGrid.DrawCell(ACol,ARow:
- Longint;ARect: TRect;AState: TGridDrawState);
- var
- OldActive: Integer;
- Highlight: Boolean;
- Value: string;
- DrawColumn: Tcolumn;
- cl: TColor;
- fn: TFont;
- begin
{如果处于控件装载状态, 则直接填充颜色后退出}
- if csLoading in ComponentState then
- begin
- Canvas.Brush.Color := Color;
- Canvas.FillRect(ARect);
- Exit;
- end;
- if (gdFixed in AState) and (ACol - IndicatorOffset 0 ) then
- begin
- inherited DrawCell(ACol,ARow,ARect,AState);
- Exit;
- end;
{对于列标题, 不用任何修饰}
- if (dgTitles in Options) and (ARow = 0) then
- begin
- inherited DrawCell(ACol,ARow,ARect,AState);
- Exit;
- end;
- if (dgTitles in Options) then Dec(ARow);
- Dec(ACol,IndicatorOffset);
- if (gdFixed in AState) and ([dgRowLines,dgColLines] * Options =
- [dgRowLines,dgColLines]) then
- begin
{缩减 ARect, 以便填写数据}
- InflateRect(ARect,-1,-1);
- end
- else
- with Canvas do
- begin
- DrawColumn := Columns[ACol];
- Font := DrawColumn.Font;
- Brush.Color := DrawColumn.Color;
- Font.Color := DrawColumn.Font.Color;
- if FWZebra then // 如果属性 WZebra 为 True 则显示斑马纹
- if Odd(ARow) then
- Brush.Color := FWSecondColor
- else
- Brush.Color := FWFirstColor;
- if (DataLink = nil) or not DataLink.Active then
- FillRect(ARect)
- else
- begin
- Value := ??;
- OldActive := DataLink.ActiveRecord;
- try
- DataLink.ActiveRecord := ARow;
- if Assigned(DrawColumn.Field) then
- begin
- Value := DrawColumn.Field.DisplayText;
- if Assigned(FDrawFieldCellEvent) then
- begin
- cl := Brush.Color;
- fn := Font;
- FDrawFieldCellEvent(self,DrawColumn.Field,cl,fn,ARow);
- Brush.Color := cl;
- Font := fn;
- end;
- end;
- Highlight := HighlightCell(ACol,ARow,Value,AState);
- if Highlight and (not FWZebra) then
- begin
- Brush.Color := clHighlight;
- Font.Color := clHighlightText;
- end;
- if DefaultDrawing then
- DefaultDrawColumnCell(ARect,ACol,DrawColumn,AState);
- if Columns.State = csDefault then
- DrawDataCell(ARect,DrawColumn.Field,AState);
- DrawColumnCell(ARect,ACol,DrawColumn,AState);
- finally
- DataLink.Activerecord := OldActive;
- end;
- if DefaultDrawing and (gdSelected in AState) and
- ((dgAlwaysShowSelection in Options) or Focused)
- and not (csDesigning in Componentstate)
- and not (dgRowSelect in Options)
- and (ValidParentForm(self).ActiveControl = self) then
- begin
- // 显示当前光标处为蓝底黄字, 同时加粗显示
- Windows.DrawFocusRect(Handle,ARect);
- Canvas.Brush.COlor := clBlue;
- Canvas.FillRect(ARect);
- Canvas.Font.Color := clYellow;
- Canvas.Font.Style := [fsBold];
- DefaultDrawColumnCell(ARect,ACol,DrawColumn,AState);
- end;
- end;
- end;
- if (gdFixed in AState) and ([dgRowLines,dgColLines] * Options =
- [dgRowLines,dgColLines]) then
- begin
- InflateRect(ARect,-2,-2);
- DrawEdge(Canvas.Handle,ARect,BDR_RAISEDINNER,BF_BOTTOMRIGHT);
- DrawEdge(Canvas.Handle,ARect,BDR_SUNKENINNER,BF_TOPLEFT);
- end;
- end;
- // 如果移动光标等, 则需要刷新显示 DBGrid
- procedure TNewDBGrid.Scroll(Distance: Integer);
- begin
- inherited Scroll(Distance);
- refresh;
- end;
end.
以上程序在 Win98 + Delphi 5 下调试通过.
来源: http://www.bubuko.com/infodetail-2604362.html