del 打印 onenter assign first preview 就是 rop 用戶

在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下調試通過。

Delphi中的DBGrid控件