unit armexcel;
{TArmExcel 用EXCEL做报表，设置纸张、页眉页脚、网格线
可以选择工作表，打印预览
2000-09-12 作者 ：ARM}
interface
uses
Windows,comobj,Messages,SysUtils,db,forms,Classes,dialogs;
CONST
xlContinuous = 1;
xlInsideHorizontal = 12;
xlInsideVertical = 11;
xlDiagonalDown = 5;
xlDiagonalUp = 6;
xlEdgeBottom = 9;
xlEdgeLeft = 7;
xlEdgeRight = 10;
xlEdgeTop = 8;
xlNone = -4142;
//pager size
type
TPaperSize=(xlPaper10x14,
xlPaper11x17,
xlPaperA3,
xlPaperA4,
xlPaperA4Small,
xlPaperA5,
xlPaperB4,
xlPaperB5,
xlPaperCsheet,
xlPaperDsheet,
xlPaperEnvelope10,
xlPaperEnvelope11,
xlPaperEnvelope12,
xlPaperEnvelope14,
xlPaperEnvelope9,
xlPaperEnvelopeB4,
xlPaperEnvelopeB5,
xlPaperEnvelopeB6,
xlPaperEnvelopeC3,
xlPaperEnvelopeC4,
xlPaperEnvelopeC5,
xlPaperEnvelopeC6,
xlPaperEnvelopeC65,
xlPaperEnvelopeDL,
xlPaperEnvelopeItaly,
xlPaperEnvelopeMonarch,
xlPaperEnvelopePersonal,
xlPaperEsheet,
xlPaperExecutive,
xlPaperFanfoldLegalGerman,
xlPaperFanfoldStdGerman,
xlPaperFanfoldUS,
xlPaperFolio,
xlPaperLedger,
xlPaperLegal,
xlPaperLetter,
xlPaperLetterSmall,
xlPaperNote,
xlPaperQuarto,
xlPaperStatement,
xlPaperTabloid,
xlPaperUser
);
const
PaperSizeMetrics : array[xlPaper10x14..xlPaperUser] of Integer =
( $00000010,
$00000011,
$00000008,
$00000009,
$0000000A,
$0000000B,
$0000000C,
$0000000D,
$00000018,
$00000019,
$00000014,
$00000015,
$00000016,
$00000017,
$00000013,
$00000021,
$00000022,
$00000023,
$0000001D,
$0000001E,
$0000001C,
$0000001F,
$00000020,
$0000001B,
$00000024,
$00000025,
$00000026,
$0000001A,
$00000007,
$00000029,
$00000028,
$00000027,
$0000000E,
$00000004,
$00000005,
$00000001,
$00000002,
$00000012,
$0000000F,
$00000006,
$00000003,
$00000100);
type
//用于页眉页脚
TReportTitle=class(TPersistent)
private
FLeft:string;
FCenter:string;
FRight:string;
public
constructor Create;
procedure Assign(Source: TPersistent); override;
published
property left:string read Fleft write Fleft;
property center:string read Fcenter write Fcenter;
property Right:string read FRight write FRight;
end;
//表格线
TGridBound=class(TPersistent)
private
ftop:integer;
fbottom:integer;
fleft:integer;
fright:integer;
public
constructor Create;
procedure Assign(Source: TPersistent); override;
published
property top:integer read FTop write Ftop;
property bottom:integer read fbottom write fbottom;
property left:integer read Fleft write fleft;
property Right:integer read FRight write fright;
end;
type
TProgressEvent = procedure(Info: string; Count, Total: Integer) of object;
//
Tarmexcel = class(TComponent)
private
msexcel:variant;
wbook:Variant;
wsheet:variant;
FFilename:string;
fPrintTitleRows:STRING;//表头
FHeader,FFooter:TReportTitle;
FGrid:TGridBound;
FShowGrid: boolean;
FDirectPreview:boolean;
Factivesheet:string;
FPagerSize:TPaperSize;
FCellXOffset,FCellYOffset:integer;
FDataset:Tdataset;
FShowFieldName:boolean;
FOnDbProgress:TProgressEvent;
procedure drawgrid;
PROCEDURE PageSetup;
procedure FreeInstance;
protected
{ Protected declarations }
public
constructor create(aowner:TComponent);override;
destructor Destroy; override;
procedure CreateInstance;
procedure WriteData;
procedure ShowWindow;
published
property filename:string read FFileName write FFileName;
property Header:TReportTitle read Fheader write Fheader;
property Footer:TReportTitle read FFooter write FFooter;
property ShowGrid:boolean read FShowGrid write FShowGrid ;
property Grid:TGridBound read FGrid write FGrid;
PROPERTY PrintTitleRows:STRING READ fPrintTitleRows WRITE fPrintTitleRows;
property ActiveSheet:string Read FActiveSheet write FActiveSheet;
property PaperSize:TPaperSize read FPagerSize write FPagerSize;
property DirectPreview:boolean read FDirectPreview write FDirectPreview;
property Dataset:Tdataset read Fdataset write Fdataset;
property CellXOffset:integer read FCellXOffset write FCellXOffset;
property CellYOffset:integer read FCellYOffset write FCellYOffset;
property ShowFieldName :boolean read FShowFieldname write FShowFieldName;
property OnDBProgress:TProgressEvent read FOnDBProgress write FOnDBProgress;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('宫雨', [Tarmexcel]);
end;
{ Tarmexcel }
constructor Tarmexcel.create(aowner: TComponent);
begin
inherited Create(AOwner);
Fheader:=TReportTitle.create;
FFooter:=TReportTitle.create;
Fgrid:=TGridBound.create;
FShowGrid:=False;
FDirectPreview:=false;
end;
procedure Tarmexcel.createinstance;
begin
MsExcel:= CreateOleObject('Excel.Application');
WBook:=MsExcel.Application;
if filename<>'' then
wbook.workbooks.Open(filename)
else
wbook.workbooks.add;
if activesheet<>'' then
wbook.Sheets[activesheet].Select;
WSheet:=WBook.ActiveSheet;
DrawGrid;
PageSetup;
end;
destructor Tarmexcel.Destroy;
begin
freeinstance;
Fheader.Free;
FFooter.Free;
Fgrid.Free;
inherited Destroy;
end;
procedure Tarmexcel.drawgrid;
VAR
ATXT:STRING;
begin
if showgrid then
begin
WITH GRID DO
BEGIN
ATXT:=chr(64+left)+inttostr(top)+':'+chr(64+RIGHT)+inttostr(bottom);
WSheet.Range[ATXT].Borders[xlDiagonalDown].LineStyle:= xlNone;
WSheet.Range[ATXT].Borders[xlDiagonalUp].LineStyle:=xlNone;
WSheet.Range[ATXT].Borders[xlEdgeLeft].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeTop].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeBottom].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlEdgeRight].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlInsideVertical].LineStyle:=xlContinuous;
WSheet.Range[ATXT].Borders[xlInsideHorizontal].LineStyle:=xlContinuous;
END;
end;
end;
procedure Tarmexcel.FreeInstance;
begin
Wbook.DisplayAlerts:=False;
Wbook.quit;
WBook:= UnAssigned;
end;
procedure Tarmexcel.PageSetup;
const
pp='&[页码]/&[总页数]';
cp='第&[页码]页';
dt='日期:&[日期]';
begin
WSheet.PageSetup.PrintTitleRows:=PrintTitleRows;
if Header.left<>'' then
wsheet.pagesetup.LeftHeader:=Header.left;
if Header.right<>'' then
wsheet.pagesetup.RightHeader:=Header.RIGHT;
if Header.Center<>'' then
wsheet.pagesetup.CenterHeader:=Header.CENTER;
if FOOTER.left<>'' then
wsheet.pagesetup.LeftFooter:=Footer.left;
if FOOTER.right<>'' then
wsheet.pagesetup.RightFooter:=Footer.RIGHT;
if FOOTER.center<>'' then
wsheet.pagesetup.CenterFooter:=Footer.CENTER;
wsheet.pagesetup.PaperSize:=PaperSizeMetrics[PaperSize];
if (DirectPreview) and (filename<>'')then
wbook.ActiveWindow.SelectedSheets.PrintPreview;
end;
procedure Tarmexcel.ShowWindow;
begin
WBook.Visible:=True;
end;
procedure Tarmexcel.writedata;
var
i,j:integer;
begin
if dataset=nil then
exit;
if not dataset.active then
exit;
with dataset do
begin
disablecontrols;
first;
i:=1;
if ShowFieldName then
for j:=0 to fieldcount-1 do
begin
wsheet.cells[i+CellXOffset,j+1+CellYOffset]:=fields[j].DisplayLabel;
i:=i+1;
end;
while not eof do
begin
for j:=0 to fieldcount-1 do
if fields.datatype<>Ftdate then
wsheet.cells[i+CellXOffset,j+1+CellYOffset]:=fields[j].asvariant
else
wsheet.cells[i+CellXOffset,j+1+CellYOffset]:=fields[j].asstring;
next;
i:=i+1;
if Assigned(OnDBProgress) then
OnDBProgress('',I+1,RecordCount);
Application.ProcessMessages;
end;
first;
enablecontrols;
end;
end;
{ TReportTitle }
procedure TReportTitle.Assign(Source: TPersistent);
begin
if Source is TReportTitle then begin
Left := TReportTitle(Source).Left;
Right:= TReportTitle(Source).Right;
Center := TReportTitle(Source).Center;
end
else inherited Assign(Source);
end;
constructor TReportTitle.Create;
begin
inherited;
end;
{ TGridBound }
procedure TGridBound.Assign(Source: TPersistent);
begin
inherited;
if Source is TGridBound then begin
Left := TGridBound(Source).Left;
Right:= TGridBound(Source).Right;
top := TGridBound(Source).Top;
bottom:=TGridBound(source).bottom;
end
else inherited Assign(Source);
end;
constructor TGridBound.Create;
begin
inherited;
end;
end.
