xlsexport2.pas

一个经典的读写Excel的控件

unit XLSExport2;

{
********************************************************************************
******* XLSReadWriteII V2.00                                             *******
*******                                                                  *******
******* Copyright(C) 1999,2004 Lars Arvidsson, Axolot Data               *******
*******                                                                  *******
******* email: [e-mail]                                     *******
******* URL:   http://www.axolot.com                                     *******
********************************************************************************
** Users of the XLSReadWriteII component must accept the following            **
** disclaimer of warranty:                                                    **
**                                                                            **
** XLSReadWriteII is supplied as is. The author disclaims all warranties,     **
** expressedor implied, including, without limitation, the warranties of      **
** merchantability and of fitness for any purpose. The author assumes no      **
** liability for damages, direct or consequential, which may result from the  **
** use of XLSReadWriteII.                                                     **
********************************************************************************
}

{$B-}

interface

uses Classes, SysUtils, XLSReadWriteII2, XLSRWIIResourceStrings2;

type TXLSExport2 = class(TComponent)
private
    procedure SetFilename(const Value: string);
protected
    FFilename: string;
    FXLS: TXLSReadWriteII2;
    FCurrSheetIndex: integer;
    FCol1,FCol2: integer;
    FRow1,FRow2: integer;

    procedure OpenFile;        virtual;
    procedure WriteFilePrefix; virtual;
    procedure WritePagePrefix; virtual;
    procedure WriteRowPrefix;  virtual;
    procedure WriteCell(SheetIndex,Col,Row: integer); virtual;
    procedure WriteRowSuffix;  virtual;
    procedure WritePageSuffix; virtual;
    procedure WriteFileSuffix; virtual;
    procedure CloseFile;       virtual;
    procedure WriteData;       virtual;
public
    constructor Create(AOwner: TComponent); override;
    procedure Write;
    procedure SaveToStream(Stream: TStream); virtual;
published
    property Col1: integer read FCol1 write FCol1;
    property Col2: integer read FCol2 write FCol2;
    property Filename: string read FFilename write SetFilename;
    property Row1: integer read FRow1 write FRow1;
    property Row2: integer read FRow2 write FRow2;
    property XLS: TXLSReadWriteII2 read FXLS write FXLS;
    end;

implementation

{ TXLSExport }

procedure TXLSExport2.CloseFile;
begin

end;

constructor TXLSExport2.Create(AOwner: TComponent);
begin
  inherited;
  FCol1 := -1;
  FCol2 := -1;
  FRow1 := -1;
  FRow2 := -1;
end;

procedure TXLSExport2.OpenFile;
begin

end;

procedure TXLSExport2.SaveToStream(Stream: TStream);
begin
  if FXLS = Nil then
    raise Exception.Create(ersNoTXLSReadWriteIIDefined);
  WriteData;
end;

procedure TXLSExport2.SetFilename(const Value: string);
begin
  FFilename := Value;
end;

procedure TXLSExport2.Write;
begin
  if FFilename = '' then
    raise Exception.Create(ersFilenameIsMissing);
  if FXLS = Nil then
    raise Exception.Create(ersNoTXLSReadWriteIIDefined);
  OpenFile;
  try
    WriteData;
  finally
    CloseFile;
  end;
end;

procedure TXLSExport2.WriteCell(SheetIndex, Col, Row: integer);
begin

end;

procedure TXLSExport2.WriteData;
var
  i,Col,Row: integer;
  C1,C2,R1,R2: integer;
begin
  WriteFilePrefix;
  try
    for i := 0 to FXLS.Sheets.Count - 1 do begin
      FXLS.Sheets[i].CalcDimensions;
      if FCol1 >= 0 then C1 := FCol1 else C1 := FXLS.Sheets[i].FirstCol;
      if FCol2 >= 0 then C2 := FCol2 else C2 := FXLS.Sheets[i].LastCol;
      if FRow1 >= 0 then R1 := FRow1 else R1 := FXLS.Sheets[i].FirstRow;
      if FRow2 >= 0 then R2 := FRow2 else R2 := FXLS.Sheets[i].LastRow;
      FCurrSheetIndex := i;
      WritePagePrefix;
      for Row := R1 to R2 do begin
        WriteRowPrefix;
        for Col := C1 to C2 do
          WriteCell(i,Col,Row);
        WriteRowSuffix;
      end;
      WritePageSuffix;
    end;
  except
    raise Exception.CreateFmt('Error on exporting cell %d:%d',[Col,Row]);
  end;
  WriteFileSuffix;
end;

procedure TXLSExport2.WriteFilePrefix;
begin

end;

procedure TXLSExport2.WriteFileSuffix;
begin

end;

procedure TXLSExport2.WritePagePrefix;
begin

end;

procedure TXLSExport2.WritePageSuffix;
begin

end;

procedure TXLSExport2.WriteRowPrefix;
begin

end;

procedure TXLSExport2.WriteRowSuffix;
begin

end;

end.