qexport4xlsfile.pas

Advanced.Export.Component.v4.01.rar,delphi 第三方控件

unit QExport4XLSFile;

{$I VerCtrl.inc}

{$IFDEF VCL6}
  {$WARN SYMBOL_PLATFORM OFF}
{$ENDIF}

interface

uses Classes, SysUtils {$IFDEF VCL6}, Variants{$ENDIF}, QExport4XLSCommon,
  ActiveX, Windows;

type
  TxlsSection = class;
  TbiffXFList = class;
  TbiffFormatList = class;
  TbiffSSTList = class;

  TbiffContinue = class;

  TbiffRecord = class
  private
    FSection: TxlsSection;
    FID: word;
    FDataSize: word;
    FData: PByteArray;
    FContinue: TbiffContinue;
    FOnDestroy: TNotifyEvent;

    function GetXFList: TbiffXFList;
    function GetFormatList: TbiffFormatList;
    function GetSSTList: TbiffSSTList;
  protected
    function GetDataSize: integer; virtual;
    function GetTotalSize: integer; virtual;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); virtual;
    destructor Destroy; override;
    procedure AddContinue(const Continue: TbiffContinue);
    procedure Save(Stream: TStream); virtual;
    procedure Clear; virtual;

    property Section: TxlsSection read FSection;
    property XFList: TbiffXFList read GetXFList;
    property FormatList: TbiffFormatList read GetFormatList;
    property SSTList: TbiffSSTList read GetSSTList;

    property ID: word read FID;
    property DataSize: word read FDataSize write FDataSize;
    property Data: PByteArray read FData;
    property TotalSize: integer read GetTotalSize;

    property Continue: TbiffContinue read FContinue;

    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  end;

  TbiffContinue = class(TbiffRecord);

  TbiffBOF = class(TbiffRecord)
  private
    function GetVersion: word;
    procedure SetVersion(Value: word);
    function GetDataType: word;
    procedure SetDataType(Value: word);
    function GetBuildID: word;
    procedure SetBuildID(Value: word);
    function GetBuildYear: word;
    procedure SetBuildYear(Value: word);
    function GetHistoryFlags: integer;
    procedure SetHistoryFlags(Value: integer);
    function GetLowVersion: integer;
    procedure SetLowVersion(Value: integer);
//    function GetBOFType: word;
  public
    property Version: word read GetVersion write SetVersion;
    property DataType: word read GetDataType write SetDataType;
    property BuildID: word read GetBuildID write SetBuildID;
    property BuildYear: word read GetBuildYear write SetBuildYear;
    property HistoryFlags: integer read GetHistoryFlags write SetHistoryFlags;
    property LowVersion: integer read GetLowVersion write SetLowVersion;

//    property BOFType: word read GetBOFType;
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;
  end;

  TbiffEOF = class(TbiffRecord);

  TbiffBoundSheet = class(TbiffRecord)
  private
    function GetBOFPos: integer;
    procedure SetBOFPos(Value: integer);
    function GetVisibility: byte;
    procedure SetVisibility(Value: byte);
    function GetSheetType: byte;
    procedure SetSheetType(Value: byte);
    function GetNameLen: byte;
    procedure SetNameLen(Value: byte);
    function GetNameOpt: byte;
    procedure SetNameOpt(Value: byte);
    function GetName: WideString;
    procedure SetName(const Value: WideString);
  public
    property BOFPos: integer read GetBOFPos write SetBOFPos;
    property Visibility: byte read GetVisibility write SetVisibility;
    property SheetType: byte read GetSheetType write SetSheetType;
    property NameLen: byte read GetNameLen write SetNameLen;
    property NameOpt: byte read GetNameOpt write SetNameOpt;
    property Name: WideString read GetName write SetName;
  end;

  TbiffCountry = class(TbiffRecord)
  private
    function GetCountryDef: word;
    procedure SetCountryDef(Value: word);
    function GetCountryWinIni: word;
    procedure SetCountryWinIni(Value: word);
  public
    property CountryDef: word read GetCountryDef write SetCountryDef;
    property CountryWinIni: word read GetCountryWinIni write SetCountryWinIni;
  end;

  TbiffString = class(TbiffRecord)
  private
    function GetValue: WideString;
  public
    property Value: WideString read GetValue;
  end;

  TbiffColRow = class(TbiffRecord)
  private
    function GetCol: word;
    procedure SetCol(Value: word);
    function GetRow: word;
    procedure SetRow(Value: word);
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;

    property Col: word read GetCol write SetCol;
    property Row: word read GetRow write SetRow;
  end;

  TbiffCellType = (bctString, bctBoolean, bctNumeric, bctDateTime, bctUnknown);

  TxlsWorkSheet = class;

  TbiffCell = class(TbiffColRow)
  private
    FWorkSheet: TxlsWorkSheet;
    function GetXFIndex: word;
    procedure SetXFIndex(Value: word);
    function GetFormatIndex: word;
    function GetCellName: string;
  protected
    function GetCellType: TbiffCellType; virtual;
    function GetIsFormula: boolean; virtual;
    function GetIsString: boolean;
    function GetIsBoolean: boolean;
    function GetIsFloat: boolean;
    function GetIsDateTime: boolean;
    function GetIsDateOnly: boolean;
    function GetIsTimeOnly: boolean;
    function GetIsVariant: boolean;
    function GetAsString: WideString; virtual;
    procedure SetAsString(const Value: WideString); virtual;
    function GetAsBoolean: boolean; virtual;
    procedure SetAsBoolean(Value: boolean); virtual;
    function GetAsFloat: double; virtual;
    procedure SetAsFloat(Value: double); virtual;
    function GetAsDateTime: TDateTime; virtual;
    procedure SetAsDateTime(Value: TDateTime); virtual;
    function GetAsVariant: variant; virtual;
    procedure SetAsVariant(Value: variant); virtual;
  public
    constructor Create(Section: TxlsSection; ID, DataSize: word;
      Data: PByteArray); override;

    property WorkSheet: TxlsWorkSheet read FWorkSheet;
    property XFIndex: word read GetXFIndex write SetXFIndex;
    property FormatIndex: word read GetFormatIndex{ write SetFormatIndex};

    property CellType: TbiffCellType read GetCellType;

    property IsFormula: boolean read GetIsFormula;
    property IsString: boolean read GetIsString;
    property IsBoolean: boolean read GetIsBoolean;
    property IsFloat: boolean read GetIsFloat;
    property IsDateTime: boolean read GetIsDateTime;
    property IsDateOnly: boolean read GetIsDateOnly;
    property IsTimeOnly: boolean read GetIsTimeOnly;
    property IsVariant: boolean read GetIsVariant;

    property AsString: WideString read GetAsString write SetAsString;
    property AsBoolean: boolean read GetAsBoolean write SetAsBoolean;
    property AsFloat: double read GetAsFloat write SetAsFloat;
    property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
    property AsVariant: variant read GetAsVariant write SetAsVariant;
    property Value: variant read GetAsVariant write SetAsVariant;
    property CellName: string read GetCellName;
  end;

  TbiffBlank = class(TbiffCell);

  TbiffBoolErr = class(TbiffCell)
  protected
    function GetCellType: TbiffCellType; override;

    function GetAsBoolean: boolean; override;
    procedure SetAsBoolean(Value: boolean); override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
  end;

  TbiffNumber = class(TbiffCell)
  protected
    function GetCellType: TbiffCellType; override;

    function GetAsFloat: double; override;
    procedure SetAsFloat(Value: double); override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
  end;

  TbiffRK = class(TbiffCell)
  private
    function GetIsDateTime: boolean;
  protected
    function GetCellType: TbiffCellType; override;

    function GetAsFloat: double; override;
    procedure SetAsFloat(Value: double); override;
    function GetAsDateTime: TDateTime; override;
    procedure SetAsDateTime(Value: TDateTime); override;
    function GetAsVariant: variant; override;
    procedure SetAsVariant(Value: variant); override;
    function GetAsString: WideString; override;
    procedure SetAsString(const Value: WideString); override;
  end;

  PsstString = ^TsstString;
  TsstString = record
    FID: integer;
    FValue: WideString;
    FRefCount: integer;
  end;

  TsstStrings = class;

  TsstStringList = class(TList)
  private
    FItemOwner: boolean;
    FStrings: TsstStrings;

    function Get(Index: Integer): PsstString;
    procedure Put(Index: Integer; Item: PsstString);
  public
    constructor Create(Strings: TsstStrings);
    destructor Destroy; override;
    function Add(Item: PsstString): integer;
    procedure Delete(Index: integer);
    function Find(const Value: WideString; var Index: integer): boolean;
    procedure Insert(Index: integer; Item: PsstString);
    procedure Sort;
    procedure Save(Index: integer; Stream: TStream);

    property ItemOwner: boolean read FItemOwner write FItemOwner;
    property Items[Index: Integer]: PsstString read Get write Put; default;
    property Strings: TsstStrings read FStrings;
  end;

  TsstStrings = class
  private
    FPlainList: TsstStringList;
    FSortedList: TsstStringList;
    FContinueList: TList;
    FCurrentSize: integer;
    FTotalSize: integer;
    FBytesWritten: integer;
    FContinueIndex: integer;
    FTotalCount: integer;
    FUniqueCount: integer;
  public
    constructor Create;
    destructor Destroy; override;
    function AddString(const Value: WideString): integer;

//    procedure Clear;
    procedure Save(Stream: TStream);
//    procedure CalcContinue(First: integer; var Last: integer;
//      var RecordSize: word);

//    property Count: integer read GetCount;
//    property PlainItems[Index: integer]: TsstString read GetPlainItem
//      write SetPlainItem;
//    property SortedItems[Index: integer]: TsstString read GetSortedItem
//      write SetSortedItem;
  end;

  TxlsCharSize = 1..2;

  TxlsString = class
    FIsWideStr: boolean;

    FStrLen: word;
    FOptionFlags: byte;
    FWideData: WideString;
    FShortData: string;

    FRTFNumber: word;
    FRTFData: PByteArray;
    FFarEastDataSize: word;
    FFarEastData: PByteArray;

    function GetLenOfLen: byte;
    function GetHasWideChar: boolean;
    function GetCharSize: byte;
    function GetHasRichText: boolean;
    function GetFarEast: boolean;
    function GetValue: WideString;

    function GetTotalSize: integer;
  public
    constructor CreateR(IsWideStr: boolean; var ARecord: TbiffRecord;
      var Offset: integer);
    constructor CreateWS(IsWideStr: boolean; const Str: WideString);
    {constructor Create(IsWideStr: boolean; var ARecord: TbiffRecord;
      var Offset: integer); overload;
    constructor Create(IsWideStr: boolean; const Str: WideString); overload;}
    function Compare(Str: TxlsString): integer; //-1 if less, 0 if equal, 1 if more
    procedure Save(Stream: TStream);

    property OptionFlags: byte read FOptionFlags;
    property ShortData: string read FShortData;
    property WideData: WideString read FWideData;

    property LenOfLen: byte read GetLenOfLen;
    property HasWideChar: boolean read GetHasWideChar;
    property CharSize: byte read GetCharSize;
    property HasRichText: boolean read GetHasRichText;
    property HasFarEast: boolean read GetFarEast;
    property Value: WideString read GetValue;

    property TotalSize: integer read GetTotalSize;
  end;

  TxlsSSTEntry = class
  private
    FRefCount: integer;
    FValue: TxlsString;
    FTableIndex: integer;
    FStreamPosition: integer;
    FSSTPosition: integer;
    FIndex: integer;
    FOnDestroy: TNotifyEvent;

    function GetTotalSize: integer;
  public
    constructor CreateXS(Str: TxlsString);
    constructor CreateWS(Str: WideString);
    destructor Destroy; override;

    procedure IncRef;
    procedure DecRef;
    procedure Save(Stream: TStream; StartPosition: integer);

    property RefCount: integer read FRefCount;
    property Value: TxlsString read FValue;
    property TableIndex: integer read FTableIndex write FTableIndex;
    property TotalSize: integer read GetTotalSize;
    property Index: integer read FIndex;

    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  end;