Delphi中的DBGrid控件

在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;interfaceusesWindows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,DB,Grids,DBGrids,Excel97;typeTDrawFieldCellEvent = 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);protectedprocedure Scroll(Distance: Integer); override;//本控件的重点过程procedure DrawCell(Acol,ARow: Longint;ARect:TRect;AState: TGridDrawState); override;publicconstructor Create(AOwner: TComponent); override;destructor Destroy; override;publishedproperty WZebra: Boolean read GetWZebra write SetWZebra;property OnDblClick;property OnDragDrop;property OnKeyUp;property OnKeyDown;property OnKeyPress;property OnEnter;property OnExit;property OnDrawDataCell;property WFirstColor : TColorread GetWFirstColor write SetWFirstColor ;property WSecondColor : TColorread GetWSecondColor write SetWSecondColor ;end;procedure Register;implementationprocedure Register;beginRegisterComponents(?Data Controls?,[TNewDBGrid]);end;procedure TNewDBGrid.AutoInitialize;beginFWFirstColor := RGB(239,254,247);FWSecondColor := RGB(249,244,245);{可以在次添加需要的其它控件及初使化参数}end;procedure TNewDBGrid.AutoDestroy;begin{在这里释放自己添加参数等占用的系统资源}end;procedure TNewDBGrid.SetWZebra(Value : Boolean);beginFWZebra := Value;Refresh;end;function TNewDBGrid.GetWZebra: Boolean;beginResult :=FWZebra;end;function TNewDBGrid.GetWFirstColor : TColor;beginResult := FWFirstColor;end;procedure TNewDBGrid.SetWFirstColor(Value : TColor);beginFWFirstColor := Value;Refresh;end;function TNewDBGrid.GetWSecondColor : TColor;beginResult := FWSecondColor;end;procedure TNewDBGrid.SetWSecondColor(Value : TColor);beginFWSecondColor := Value;Refresh;end;constructor TNewDBGrid.Create(AOwner: TComponent);begininherited Create(AOwner);AutoInitialize;end;destructor TNewDBGrid.Destroy;beginAutoDestroy;inherited Destroy;end;//实现斑马效果procedure TNewDBGrid.DrawCell(ACol,ARow:Longint;ARect: TRect;AState: TGridDrawState);varOldActive: Integer;Highlight: Boolean;Value: string;DrawColumn: Tcolumn;cl: TColor;fn: TFont;begin{如果处于控件装载状态,则直接填充颜色后退出}if csLoading in ComponentState thenbeginCanvas.Brush.Color := Color;Canvas.FillRect(ARect);Exit;end;if (gdFixed in AState) and (ACol - IndicatorOffset 〈 0 ) thenbegininherited DrawCell(ACol,ARow,ARect,AState);Exit;end;{对于列标题,不用任何修饰}if (dgTitles in Options) and (ARow = 0) thenbegininherited DrawCell(ACol,AState);Exit;end;if (dgTitles in Options) then Dec(ARow);Dec(ACol,IndicatorOffset);if (gdFixed in AState) and ([dgRowLines,dgColLines] * Options =[dgRowLines,dgColLines]) thenbegin{缩减ARect,以便填写数据}InflateRect(ARect,-1,-1);endelsewith Canvas dobeginDrawColumn := Columns[ACol];Font := DrawColumn.Font;Brush.Color := DrawColumn.Color;Font.Color := DrawColumn.Font.Color;if FWZebra then //如果属性WZebra为True则显示斑马纹if Odd(ARow) thenBrush.Color := FWSecondColorelseBrush.Color := FWFirstColor;if (DataLink = nil) or not DataLink.Active thenFillRect(ARect)elsebeginValue := ??;OldActive := DataLink.ActiveRecord;tryDataLink.ActiveRecord := ARow;if Assigned(DrawColumn.Field) thenbeginValue := DrawColumn.Field.DisplayText;if Assigned(FDrawFieldCellEvent) thenbegincl := Brush.Color;fn := Font;FDrawFieldCellEvent(self,DrawColumn.Field,cl,fn,ARow);Brush.Color := cl;Font := fn;end;end;Highlight := HighlightCell(ACol,Value,AState);if Highlight and (not FWZebra) thenbeginBrush.Color := clHighlight;Font.Color := clHighlightText;end;if DefaultDrawing thenDefaultDrawColumnCell(ARect,ACol,DrawColumn,AState);if Columns.State = csDefault thenDrawDataCell(ARect,AState);DrawColumnCell(ARect,AState);finallyDataLink.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) thenbegin//显示当前光标处为蓝底黄字,同时加粗显示Windows.DrawFocusRect(Handle,ARect);Canvas.Brush.COlor := clBlue;Canvas.FillRect(ARect);Canvas.Font.Color := clYellow;Canvas.Font.Style := [fsBold];DefaultDrawColumnCell(ARect,AState);end;end;end;if (gdFixed in AState) and ([dgRowLines,dgColLines]) thenbeginInflateRect(ARect,-2,-2);DrawEdge(Canvas.Handle,BDR_RAISEDINNER,BF_BOTTOMRIGHT);DrawEdge(Canvas.Handle,BDR_SUNKENINNER,BF_TOPLEFT);end;end;//如果移动光标等,则需要刷新显示DBGridprocedure TNewDBGrid.Scroll(Distance: Integer);begininherited Scroll(Distance);refresh;end;end.　　 以上程序在Win98 + Delphi 5下调试通过。?