标签：enter 方法 dac 联合 record 私有 message off ast
在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下调试通过。
标签：enter 方法 dac 联合 record 私有 message off ast
原文地址：https://www.cnblogs.com/jijm123/p/9048765.html
