在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下调试通过。
|
请发表评论