qexport4xls.pas

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

  public
    function Add(Item: TxlsBoundSheet): integer;
    procedure CheckCell(SheetIndex, Row, Col: integer);
    procedure Delete(Index: integer);
    function IndexOfSheetIndex(SheetIndex: integer): integer;

    property Items[Index: integer]: TxlsBoundSheet read Get write Put; default;
  end;

  TExtendedColorIndex = 0..15;

  TXlsSubAggregate = class
  private
    FStartRow: Word;
    FPosRow: Word;
  public
    constructor Create(AStartRow, APosRow: Word);
    property StartRow: Word read FStartRow write FStartRow;
    property PosRow: Word read FPosRow write FPosRow;
  end;

  TXlsSubAggregates = class
  private
    FInnerList: TList;
    function GetCount: Integer;
    function GetItems(AIndex: Integer): TXlsSubAggregate;
    procedure SetItems(AIndex: Integer; const Value: TXlsSubAggregate);
  public
    constructor Create;
    destructor Destroy; override;
    function Add(AItem: TXlsSubAggregate): Integer;
    procedure Clear;
    property Count: Integer read GetCount;
    property Items[AIndex: Integer]: TXlsSubAggregate read GetItems write SetItems; default;
  end;

  TQExport4XLS = class(TQExport4FormatText)
  private
    FTextFormatList: TxlsTextFormatList;
    FFontList: TxlsFontList;
    FXFormatList: TxlsXFormatList;
    FXFormatFieldList: TxlsXFormatFieldList;
    FXFormatColRowList: TxlsXFormatColRowList;

    FBoundSheetList: TxlsBoundSheetList;
    FSSTStrings: TsstStrings;

    FLastTextFormat: integer;
    FLastFormat: integer;
    FLastFont: integer;

    FGlobalsInset: integer;
    // here we store position of the result stream for writing some global
    // settings (fonts, xfs, styles, boundsheets, country, supbook,
    // externsheets, msodrawing, sst) later

    FColWidthList: TList; // for AutoCalcColWidth
    FColInfoPosition: integer; // for AutoCalcColWidth
    FRowHeightList: TStringList; //for Pictures

    FIStorage: IStorage;
    FIStream: IStream;
    FStream: TStream;
    FBuffer: PByteArray;

    FSubAggControlColumn: string;

    procedure CreateLocalVariables;
    procedure FreeLocalVariables;

    procedure WriteGlobals;
    procedure WriteSheetStart(Sheet: TxlsSheet);
    procedure WriteSheetFinish(Sheet: TxlsSheet);
    procedure WriteGlobalInset;
    procedure WriteNotesChartsAndPictures(Sheet: TxlsSheet);
    procedure RecalculateColWidth(const Str: string; XF, ColIndex: integer);
    procedure CorrectColInfo;
    procedure CheckRowHeight(XF, RowIndex: integer);
  private
    FOptions: TXLSOptions;
    FFieldFormats: TxlsFieldFormats;
    FStripStyles: TxlsFormats;
    FStripType: TxlsStripType;
    FSheets: TxlsSheets;
    FExportStage: TxlsExportStage;
    FHeaderRows: word;
    FStartDataCol: byte;
    FFooterRows: word;
    FTotalCounter: integer;
    FHyperlinks: TxlsHyperlinks;
    FNotes: TxlsNotes;
    FCharts: TxlsCharts;
    FPictures: TxlsPictures;
    FImages: TxlsImages;
    FCells: TxlsCells;
    FMergedCells: TxlsMergedCellList;
    FBackground: TxlsGraphic;

    FOnAdvancedExportedRecord: TxlsExportedRecordEvent;
    FOnAdvancedGetExportText: TxlsGetExportTextEvent;
    FOnAdvancedBeforeExportRow: TxlsBeforeExportRowEvent;
    FOnGetHeaderParams: TGetHeaderFooterParamsEvent;
    FOnGetCaptionParams: TGetCaptionParamsEvent;
    FOnGetBeforeDataParams: TGetHeaderFooterParamsEvent;
    FOnGetDataParams: TGetDataParamsEvent;
    FOnGetAggregateParams: TGetAggregateParamsEvent;
    FOnGetFooterParams: TGetHeaderFooterParamsEvent;

    FOnBeforeExportSheet: TxlsExportSheetEvent;
    FOnAfterExportSheet: TxlsExportSheetEvent;

    procedure SetOptions(const Value: TXLSOptions);
    procedure SetFieldFormats(const Value: TxlsFieldFormats);
    procedure SetStripStyles(const Value: TxlsFormats);
    procedure SetSheets(const Value: TxlsSheets);
    procedure SetHyperlinks(const Value: TxlsHyperlinks);
    procedure SetNotes(const Value: TxlsNotes);
    procedure SetCharts(const Value: TxlsCharts);
    procedure SetPictures(const Value: TxlsPictures);
    procedure SetImages(const Value: TxlsImages);
    procedure SetCells(const Value: TxlsCells);
    procedure SetMergedCells(const Value: TxlsMergedCellList);
    procedure SetBackground(const Value: TxlsGraphic);
    procedure SetSubAggControlColumn(const Value: string);
  private
    procedure WriteRecord(ID, Length: word);
    procedure WriteWordRecord(ID, Value: word);
    procedure WriteBOF(BOFType: word);
    procedure WriteWriteAccess;
    procedure WriteWindow1;
    procedure WriteEOF;
    procedure WriteDelta;
    procedure WriteGuts;
    procedure WriteDefColWidth(Width: word);
    procedure WriteDefRowHeight(Height: double);
    procedure WriteCatchword(ID: word; const Value: WideString);
    procedure WriteColInfo(SheetIndex: integer);
    procedure WriteLabelSST(Row, Col, XF: word; const Str: WideString);
    procedure WriteBoolErr(Row, Col, XF: word; Value: boolean);
    procedure WriteNumber(Row, Col, XF: word; Value: double);
    procedure WriteBlank(Row, Col, XF: word);
    procedure WriteAggregate(Row, Col, StartRow, FinishRow: word;
      AggregateType: TxlsAggregate; XF: word);
    procedure WriteMergedCells(MergedCells: TxlsMergedCellList);
    procedure WriteWindow2;
    procedure WriteDimensions(FirstRow, LastRow: integer; FirstCol,
      LastCol: word);
    procedure WriteSelection;
    procedure WriteHyperlink(Hyperlink: TxlsHyperlink);
    procedure WriteNoteObj(ObjectID: word);
    procedure WriteTXO(TextLength: word; NoteFormat: TxlsNoteFormat);
    procedure WriteContinue1(const NoteText: WideString);
    procedure WriteTXORUN(TextLength: word; Font: TxlsFont);
    procedure WriteChartObj(ObjectID: word);
    procedure WritePictureObj(ObjectID: word);
    procedure WriteNote(Note: TxlsNote; ObjectID: integer);
    procedure WriteXLSChart(SheetIndex: integer; Chart: TxlsChart);
    procedure WriteSetup;
    procedure WriteBackground(Background: TxlsGraphic);
    procedure WriteFBI(HeightApplied, Scale, FontIndex: word);
    procedure WriteChart;
    procedure WriteSCL;
    procedure WritePlotGrowth;
    procedure WriteFrame(AutoSize, AutoPos: boolean);
    procedure WriteLineFormat(Color: cardinal; Pattern, Weight, FormatFlags,
      ColorIndex: word);
    procedure WriteAreaFormat(FgColor, BgColor: cardinal; Pattern, FormatFlags,
      FgColorIndex, BgColorIndex: word);
    procedure WriteSeries;
    procedure WriteAI(LinkType: byte; SheetIndex: integer;
      DataRange: TxlsDataRange);
    procedure WriteSeriesText(const Str: string; const WStr: WideString;
      IsUnicode: boolean);
    procedure WriteDataFormat(Index: integer);
    procedure WriteSerToCRT;
    procedure WriteShtProps;
    procedure WriteDefaultText(ObjectID: word);
    procedure WriteText;
    procedure WritePos(IsLegend: boolean; X1, Y1, X2, Y2: cardinal);
    procedure WriteFontX(FontIndex: word);
    procedure WriteAxesUsed;
    procedure WriteAxisParent;
    procedure WriteAxis(AxisType: word);
    procedure WriteCatSerRange;
    procedure WriteAxcExt;
    procedure WriteTick;
    procedure WriteValueRange;
    procedure WriteAxisLineFormat;
    procedure WriteChartFormat(Style: TxlsChartStyle);
    procedure WriteBar(IsBar: boolean);
    procedure WriteLine;
    procedure WritePie;
    procedure WriteArea;
    procedure WriteSurface;
    procedure WriteRadar;
    procedure WriteRadarArea;
    procedure Write3d;
    procedure WriteLegend(Placement: byte);
    procedure WriteObjectLink;
    procedure WriteSIIndex(Index: word);
  protected
    function GetWriter: TQXLSWriter;
    function GetWriterClass: TQExportWriterClass; override;

    procedure DoExport;
  public
    ExtendedPalette: array[0..15] of integer;
  public
    constructor Create(AOwner: Tcomponent); override;
    destructor Destroy; override;
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
    //{$IFDEF OLE_STREAM}
    procedure Execute; override;
    //{$ENDIF}

    function AddBooleanCell(Col, Row: word; Value: boolean): TxlsCell;
    function AddDateTimeCell(Col, Row: word; DateTimeFormat: string;
      Value: TDateTime): TxlsCell;
    function AddNumericCell(Col, Row: word; NumericFormat: string;
      Value: double): TxlsCell;
    function AddStringCell(Col, Row: word; const Value: string): TxlsCell;
    function AddMergedCells(FirstRow, LastRow, FirstCol,
      LastCol: word): TxlsMergedCells;
    procedure DefineExtendedColor(Index: TExtendedColorIndex; Color: TColor);

    property ExportStage: TxlsExportStage read FExportStage;
    property TotalCounter: integer read FTotalCounter;
  published
    property ColumnsWidth;
    property AutoCalcColWidth default false;

    property Options: TXLSOptions read FOptions write SetOptions;

    property FieldFormats: TxlsFieldFormats read FFieldFormats
      write SetFieldFormats;
    property StripStyles: TxlsFormats read FStripStyles
      write SetStripStyles;
    property StripType: TxlsStripType read FStripType
      write FStripType default ssNone;
    property Hyperlinks: TxlsHyperlinks read FHyperlinks
      write SetHyperlinks;
    property Notes: TxlsNotes read FNotes write SetNotes;
    property Charts: TxlsCharts read FCharts write SetCharts;
    property Sheets: TxlsSheets read FSheets write SetSheets;
    property Pictures: TxlsPictures read FPictures write SetPictures;
    property Images: TxlsImages read FImages write SetImages;
    property Cells: TxlsCells read FCells write SetCells;
    property MergedCells: TxlsMergedCellList read FMergedCells
      write SetMergedCells;
    property Background: TxlsGraphic read FBackground write SetBackground;

    property HeaderRows: word read FHeaderRows write FHeaderRows default 0;
    property StartDataCol: byte read FStartDataCol
      write FStartDataCol default 0;
    property FooterRows: word read FFooterRows write FFooterRows default 0;

    property SubAggControlColumn: string read FSubAggControlColumn
      write SetSubAggControlColumn;

    property OnAdvancedExportedRecord: TxlsExportedRecordEvent
      read FOnAdvancedExportedRecord write FOnAdvancedExportedRecord;
    property OnAdvancedGetExportText: TxlsGetExportTextEvent
      read FOnAdvancedGetExportText write FOnAdvancedGetExportText;
    property OnAdvancedBeforeExportRow: TxlsBeforeExportRowEvent
      read FOnAdvancedBeforeExportRow write FOnAdvancedBeforeExportRow;

    property OnGetHeaderParams: TGetHeaderFooterParamsEvent read
      FOnGetHeaderParams write FOnGetHeaderParams;
    property OnGetCaptionParams: TGetCaptionParamsEvent read
      FOnGetCaptionParams write FOnGetCaptionParams;
    property OnGetBeforeDataParams: TGetHeaderFooterParamsEvent read
      FOnGetBeforeDataParams write FOnGetBeforeDataParams;
    property OnGetDataParams: TGetDataParamsEvent read
      FOnGetDataParams write FOnGetDataParams;
    property OnGetAggregateParams: TGetAggregateParamsEvent read
      FOnGetAggregateParams write FOnGetAggregateParams;
    property OnGetFooterParams: TGetHeaderFooterParamsEvent read
      FOnGetFooterParams write FOnGetFooterParams;

    property OnBeforeExportSheet: TxlsExportSheetEvent
      read FOnBeforeExportSheet write FOnBeforeExportSheet;
    property OnAfterExportSheet: TxlsExportSheetEvent
      read FOnAfterExportSheet write FOnAfterExportSheet;
  end;

  function XLSClr2Str(Color: TxlsColor): string;
  function Str2XLSClr(const S: string): TxlsColor;

implementation

uses QExport4Common, QExport4Types, QExport4XLSUtils, TypInfo,
  QExport4XLSConsts, Math
  {$IFDEF WIN32}, Windows, fuQExport4About, FileCtrl, QExport4StrIDs{$ENDIF}
  {$IFDEF LINUX}, VKCodes, QExport4Consts{$ENDIF};

{$IFDEF TRIAL}
{$IFDEF WIN32}
function IsIDERuning: Boolean;
begin
  Result := (FindWindow('TAppBuilder', nil) <> 0) or
            (FindWindow('TPropertyInspector', nil) <> 0) or
            (FindWindow('TAlignPalette', nil) <> 0);
end;
{$ENDIF}
{$ENDIF}

procedure CheckTrial;
begin
{$IFDEF TRIAL}
{$IFDEF WIN32}
  if not IsIDERuning then
    ShowAboutForm;
{$ENDIF}
{$ENDIF}
end;

function XLSClr2Str(Color: TxlsColor): string;
begin
  Result := ColorToString(XLS_STANDARD_PALETTE[Integer(Color)]);
end;

function Str2XLSClr(const S: string): TxlsColor;
var
  i: integer;
begin
  Result := clrBlack;
  for i := Low(XLS_STANDARD_PALETTE) to High(XLS_STANDARD_PALETTE) do
    if Integer(StringToColor(S)) = XLS_STANDARD_PALETTE[i] then begin
      Result := TxlsColor(i);
      Break;
    end;
end;

function PictureTypeByFileName(const FileName: string): TxlsPictureType;
var
  Ext: string;
begin
  Result := ptUndefined;

  Ext := ExtractFileExt(FileName);
  if Ext <> EmptyStr
    then Delete(Ext, 1, 1)
    else Exit;

  if AnsiUpperCase(Ext) = 'WMF' then
    Result := ptWMF
  else if AnsiUpperCase(Ext) = 'EMF' then
    Result := ptEMF
  else if (AnsiUpperCase(Ext) = 'JPG') or (AnsiUpperCase(Ext) = 'JPEG') then
    Result := ptJPEG
  else