xlsprint.pas

一个打印EXCEL文件的组件

unit xlsPrint;
{
  一个打印Excel文档的小组件
  本组件是在ARM的ArmExcel组件基础上进行增删修改的，ARM早在2000年就为我们提供了一个对Excel文档进行修改、打印的组件，在此致以谢意！
  但我在使用ArmExcel组件的过程中发现该组件存在几点小瑕疵：
  1.  每打开一个Excel文件就要CreateInstance一次。
  2.  通常使用Excel文件时不一定要打印，可能仅需要对文件进行读写、修改，若提供OLE调用Excel则显得费时且占用内存较大，可采用XLSReadWriteII组件对Excel文件进行访问。
  3.  原组件在设置ActiveSheet时有一个小错误，从而造成了设置ActiveSheet后必须FreeInstance后再CreateInstance一次才能生效。
  由于以上几个原因，从而萌生了自己改写一个打印Excel文档小组件的念头，在通读了ArmExcel组件源代码后进行了一系列的修改，修正了其中的设置ActiveSheet瑕疵，增加了文件打开功能（即文件名赋值后自动打开文件）、文件关闭功能（以免只打开不关闭造成Excel占用内存太多），并且在打开新文件同时关闭以前打开的文件、保留文件打印功能。经过一番修改之后发现虽然主要变量及方法仍沿用ArmExcel的，但已丧失了ArmExcel的大部分原意，若还是自称ArmExcel组件系列可能自己都觉得惭愧，由于只能实现打印功能就暂称之为xlsPrint吧！
  希望xlsPrint能够减少大家程序开发的一点时间吧！（这已经是老饕目前的最高目标了）
  老饕
  2008-12-27
  本组件目前仅在Delphi7、Office2003、引用单元OfficeXP中测试过，其它版本的Delphi及Office均未测试，使用时请自己测试。
  本组件为开源项目，你可以任意修改、复制、分发。老饕仅希望大家在引用时能够保留本段话并在由此基础上开发出更好的组件后通过[e-mail]给我也分发一份。谢谢！
}

interface
uses
  Windows, SysUtils, Classes, Variants, ActiveX, ExcelXP;
type
 //用于页眉页脚
  TReportTitle=class(TPersistent)
  private
   FLeft: string;
   FCenter: string;
   FRight: string;
  public
  published
   property Left: string read Fleft write Fleft;
   property Center: string read Fcenter write Fcenter;
   property Right: string read FRight write FRight;
  end;

  TxlsPrint = class(TComponent)
  private
   msExcel: _Application;
   wBook: Variant;
   wSheet: variant;
   FFilename: string;
   FPrintTitleRows: STRING;//表头
   FHeader,FFooter: TReportTitle;
   FActiveSheet: string;
   procedure PageSetup;
   procedure SetActiveSheet(const Value:  string);
   procedure SetPrintTitleRows(const Value:  STRING);
   procedure OpenBook(Value: string);
  protected
    { Protected declarations }
  public
   constructor Create(AOwner: TComponent);override;
   destructor  Destroy; override;
   procedure   Close;
   procedure   CloseBook;
   procedure   PrintActiveSheet;
  published
   property FileName: string read FFileName write OpenBook;//FFileName;//模板文件名
   property Header: TReportTitle read Fheader write Fheader;//页眉
   property Footer: TReportTitle read FFooter write FFooter; //页脚
   PROPERTY PrintTitleRows: STRING READ FPrintTitleRows WRITE SetPrintTitleRows;//每页表头
   property ActiveSheet: string Read FActiveSheet write SetActiveSheet;//当前工作表
  end;

procedure Register;

implementation

uses
  ComObj;

{ TxlsPrint }

constructor TxlsPrint.create(aowner:  TComponent);
begin
  inherited Create(AOwner);

  Fheader:= TReportTitle.create;
  FFooter:= TReportTitle.create;
end;

destructor TxlsPrint.Destroy;
begin
 if not VarIsEmpty(wBook) then
   Close;
  Fheader.Free;
  FFooter.Free;

  inherited Destroy;
end;

procedure TxlsPrint.OpenBook(Value: string);
var
  TempIUnknown :  IUnknown;
  Result: HResult;
begin
  if (Value <> '') and (FileExists(Value)) then
  begin
    FFileName:= Value;
    FActiveSheet:= '';
    if not VarIsEmpty(wBook) then
    begin
      wBook.ActiveWorkBook.Close(False);
      wBook.WorkBooks.Open(FFileName);
      wSheet:= wBook.ActiveSheet;
      PageSetup;
    end
    else
    begin
      Result:= GetActiveObject(CLASS_ExcelApplication, nil, TempIUnknown);
      if Result = MK_E_UNAVAILABLE then // Excel application does not exist
        msExcel := CoExcelApplication.Create
      else
      begin // Word application exists
      // make sure no other error occured while trying to get Application class
        OleCheck(Result);
      // get _Application interface from TempIUnknown
        OleCheck(TempIUnknown.QueryInterface(_Application, msExcel));
      end;
      msExcel:= CoExcelApplication.Create;
      wBook:= msExcel.Application;
      if (FFileName <> '') and (FileExists(FFileName)) then
        wBook.WorkBooks.Open(FFileName)
      else
        wBook.WorkBooks.add;
      wSheet:= wBook.ActiveSheet;
      PageSetup;
   end;
  end;
end;

procedure TxlsPrint.CloseBook;
begin
  if not VarIsEmpty(wBook) then
    wBook.ActiveWorkBook.Close(False);
end;

procedure TxlsPrint.PrintActiveSheet;
begin
  wSheet.PrintOut;
end;

procedure TxlsPrint.Close;
begin
  if not VarIsEmpty(wBook) then
   begin
    wBook.DisplayAlerts:= False;
    wBook.quit;
    wBook:= UnAssigned;
   end;
end;

procedure TxlsPrint.PageSetup;
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;
end;


procedure TxlsPrint.SetActiveSheet(const Value:  string);
begin
  FActiveSheet:= Value;
  if (FActiveSheet <> '') and (Not VarIsEmpty(wBook)) then
  begin
    wBook.Sheets[fActiveSheet].Select;
    wSheet:= wBook.ActiveSheet;
  end;
end;

procedure TxlsPrint.SetPrintTitleRows(const Value:  STRING);
begin
  FPrintTitleRows := Value;
  if not VarIsEmpty(wSheet) then
   wSheet.PageSetup.PrintTitleRows:= PrintTitleRows;
end;

procedure Register;
begin
  RegisterComponents('Hxy', [TxlsPrint]);
end;

end.