qexport4xls.pas

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

unit QExport4XLS;

{$I VerCtrl.inc}

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

interface

uses Classes, SysUtils, QExport4, QExport4IniFiles, DB, QExport4XLSFile,
  QExport4XLSCommon, QExport4CustomSource
    {$IFDEF VCL10}
      , WideStrings
    {$ELSE}
      , QExport4EmsWideStrings
    {$ENDIF}
     {$IFDEF VCL6}, Variants{$ENDIF}
     {$IFDEF WIN32}
       {$IFNDEF NOGUI}
         ,Graphics, ComCtrls, DBGrids, Grids
       {$ELSE}
         , QExportGraphics
       {$ENDIF}
       {$IFDEF OLE_STREAM}, ActiveX, ComObj{$ENDIF}
     {$ENDIF}
     {$IFDEF LINUX}
       {$IFNDEF NOGUI}
         , QGraphics, QComCtrls, QDBGrids, QGrids
       {$ELSE}
         , QExportGraphics
       {$ENDIF}
     {$ENDIF};

type
  TxlsColor = (clrBlack,   clrBrown,       clrOliveGreen,  clrDarkGreen,
               clrDarkTeal,       clrDarkBlue,  clrIndigo,   clrGray80Percent,
               clrDarkRed, clrOrange,      clrDarkYellow,  clrGreen,
               clrTeal,           clrBlue,      clrBlueGray, clrGray50Percent,
               clrRed,     clrLightOrange, clrLime,        clrSeaGreen,
               clrAqua,           clrLightBlue, clrViolet,   clrGray40Percent,
               clrPink,    clrGold,        clrYellow,      clrBrightGreen,
               clrTurquoise,      clrSkyBlue,   clrPlum,     clrGray25Percent,
               clrRose,    clrTan,         clrLightYellow, clrLihtGreen,
               clrLightTurquoise, clrPaleBlue,  clrLavender, clrWhite,
               clrColor1, clrColor2, clrColor3, clrColor4,
               clrColor5, clrColor6, clrColor7, clrColor8,
               clrColor9, clrColor10, clrColor11, clrColor12,
               clrColor13, clrColor14, clrColor15, clrColor16);


  TxlsFontScript = (fscNone, fscSuperscript, fscSubscript);

  TxlsFontStyle  = (xfsBold, xfsItalic, xfsStrikeOut);

  TxlsFontStyles = set of TxlsFontStyle;

  TxlsFontUnderline = (fulNone, fulSingle, fulDouble,
    fulSingleAccounting, fulDoubleAccounting);

  TxlsHorizontalAlignment = (halGeneral, halLeft, halCenter, halRight, halFill);

  TxlsVerticalAlignment = (valTop, valCenter, valBottom, valJustify);

  TxlsBorderStyle = (bstNone, bstThin, bstMedium, bstDashed, bstDotted,
                     bstThick, bstDouble, bstHair, bstMediumDashed,
                     bstDashDot, bstMediumDashDot, bstDashDotDot,
                     bstMediumDashDotDot, bstSlantedDashDot);

  TxlsPattern = (ptNone, ptSolid, ptChess, ptWhiteSpots, ptBlackSpots,
                 ptBoldHorizontal, ptBoldVertical, ptBoldDiagRight,
                 ptBoldDiagLeft, ptBoldChess, ptRingMail, ptThinGorizontal,
                 ptThinVertical, ptThinDiagLeft, ptThinDiagRight, ptCells,
                 ptCrissCross, ptThinSpots, ptThinThinSpots);

  {TxlsNotePattern = (npt5Percents, npt10Percents, npt20Percents, npt25Percents,
                     npt30Percents, npt40Percents, npt50Percents, npt60Percents,
                     npt70Percents, npt75Percents, npt80Percents, npt90Percents,
                     nptLightDownwardDiagonal, nptLightUpwardDiagonal,
                     nptDarkDownwardDiagonal, nptDarkUpwardDiagonal,
                     nptWideDownwardDiagonal, nptWideUpwardDiagonal,
                     nptLightVertical, nptLightHorizontal, nptNarrowVertical,
                     nptNarrowHorizontal, nptDarkVertical, nptDarkHorizontal,
                     nptDashedDownwardDiagonal, nptDashedUpwardDiagonal,
                     nptDashedHorizontal, nptDashedVertical, nptSmallConfetti,
                     nptLargeConfetti, nptZigZag, nptWave, nptDiagonalBrick,
                     nptHorizontalBrick, nptWeave, nptPlaid, nptDivot,
                     nptDottedGrid, nptDottedDiamond, nptShingle, nptTrellis,
                     nptSphere, nptSmallGrid, nptLargeGrid,
                     nptSmallCheckerBoard, nptLargeCheckerBoard,
                     nptOutlinedDiamond, nptSolidDiamond);}

  TxlsNoteGradient = (ngrHorizontal, ngrVertical, ngrDiagonalUp,
    ngrDiagonalDown, ngrFromCorner, ngrFromCenter);

  TxlsNoteFillType = (nftSolid, nftGradient{, nftPattern});

  TxlsAggregate = (aggNone, aggSum, aggAvg, aggMin, aggMax);

  TxlsHyperlinkStyle = (hlsURL, hlsLocalFile{, hlsUNC, hlsCurrentWorkbook});

  TxlsPercent = 0..100;
  
  TxlsOrientation = (xrtNoRotation, xlrTopToBottom, xlrCounterClockWise,
    xlrClockWise);

  TxlsChartStyle = (xcsColumn, xcsColumn3d, xcsBar, xcsBar3d, xcsLine,
                    xcsLineMark, xcsLine3d, xcsPie, xcsPie3d, xcsArea,
                    xcsArea3d, xcsSurface, xcsSurface3d, xcsRadar,
                    xcsRadarArea);

  TxlsChartLegendPlacement = (clpBottom, clpCorner, clpTop, clpRight, clpLeft);

  TxlsBorders = class;
  TxlsFill = class;
  TxlsAlignment = class;

  TQExport4XLS = class;

  TxlsFont = class(TPersistent)
  private
    FSize: integer;
    FStyle: TxlsFontStyles;
    FColor: TxlsColor;
    FScript: TxlsFontScript;
    FUnderline: TxlsFontUnderline;
    FCharset: TFontCharset;
    FName: WideString;
    FFontIndex: word;
    function IsName: Boolean;
    procedure AssignToBinary(Font: TbiffFont);
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    procedure AssignTo(Dest: TPersistent); override;
    function IsEqual(Font: TxlsFont): boolean;
    procedure SetDefault;
  published
    property Size: integer read FSize write FSize default 10;
    property Style: TxlsFontStyles read FStyle write FStyle default [];
    property Color: TxlsColor read FColor write FColor default clrBlack;
    property Script: TxlsFontScript read FScript write FScript default fscNone;
    property Underline: TxlsFontUnderline read FUnderline
      write FUnderline default fulNone;
    property Charset: TFontCharset read FCharset write FCharset
      default {$IFDEF WIN32}1{$ENDIF}
              {$IFDEF LINUX}{$IFNDEF NOGUI}fcsAnyCharSet{$ELSE}1{$ENDIF}{$ENDIF};
    property Name: WideString read FName write FName stored IsName;
  end;

  TxlsFontList = class(TList)
  private
    function Get(Index: integer): TxlsFont;
    procedure Put(Index: integer; Value: TxlsFont);
  public
    destructor Destroy; override;
    function Add(Item: TxlsFont): integer;
    function FontIndexByFont(Font: TxlsFont): integer;
    function ListIndexByFont(Font: TxlsFont): integer;

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

  TxlsTextFormat = class
  private
    FFormatIndex: word;
    FFormatString: WideString;      
  public
    constructor Create;
    function IsEqual(TextFormat: TxlsTextFormat): boolean;

    property FormatIndex: word read FFormatIndex write FFormatIndex;
    property FormatString: WideString read FFormatString write FFormatString;
  end;

  TxlsTextFormatList = class(TList)
  private
    function Get(Index: integer): TxlsTextFormat;
    procedure Put(Index: integer; Value: TxlsTextFormat);
  public
    destructor Destroy; override;
    function Add(Item: TxlsTextFormat): integer;
    function FormatIndexByString(const FormatString: string): integer;
    function ListIndexByString(const FormatString: string): integer;

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

  TxlsXFormat = class
  private
    FFormatIndex: word;
    FFont: TxlsFont;
    FTextFormat: TxlsTextFormat;
    FBorders: TxlsBorders;
    FFill: TxlsFill;
    FAlignment: TxlsAlignment;
    FWrap: boolean;
    FRotation: Byte;
    procedure SetBorders(const Value: TxlsBorders);
    procedure SetFill(const Value: TxlsFill);
    procedure SetAlignment(const Value: TxlsAlignment);
    procedure AssignToBinary(XF: TbiffXF);
  public
    constructor Create(AFont: TxlsFont; ATextFormat: TxlsTextFormat);
    destructor Destroy; override;
    function IsEqual(XFormat: TxlsXFormat): boolean;

    property FormatIndex: word read FFormatIndex write FFormatIndex;
    property Font: TxlsFont read FFont write FFont;
    property TextFormat: TxlsTextFormat read FTextFormat write FTextFormat;
    property Borders: TxlsBorders read FBorders write SetBorders;
    property Fill: TxlsFill read FFill write SetFill;
    property Alignment: TxlsAlignment read FAlignment write SetAlignment;
    property Wrap: boolean read FWrap write FWrap;
    property Rotation: Byte read FRotation write FRotation;
  end;

  TxlsXFormatList = class(TList)
  private
    function Get(Index: integer): TxlsXFormat;
    procedure Put(Index: integer; Value: TxlsXFormat);
  public
    destructor Destroy; override;
    function Add(Item: TxlsXFormat): integer;
    function FormatIndexByFormat(XFormat: TxlsXFormat): integer;
    function ListIndexByFormatIndex(Index: word): integer;
    function FormatByFormatIndex(Index: word): TxlsXFormat;

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

  TxlsXFormatField = class
  private
    FSheetIndex: integer;
    FFieldName: string;
    FXFormat: TxlsXFormat;
  public
    property SheetIndex: integer read FSheetIndex write FSheetIndex;
    property FieldName: string read FFieldName write FFieldName;
    property XFormat: TxlsXFormat read FXFormat write FXFormat;
  end;

  TxlsXFormatFieldList = class(TList)
  private
    function Get(Index: integer): TxlsXFormatField;
    procedure Put(Index: integer; Value: TxlsXFormatField);
  public
    destructor Destroy; override;
    function Add(Item: TxlsXFormatField): integer;
    function FormatIndexByFieldName(SheetIndex: integer; const FieldName: string): integer;
    function ListIndexByFieldName(SheetIndex: integer; const FieldName: string): integer;

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

  TxlsXFormatColRow = class
  private
    FSheetIndex: integer;
    FNumber: integer;
    FXFormat: TxlsXFormat;
  public
    property SheetIndex: integer read FSheetIndex write FSheetIndex;
    property Number: integer read FNumber write FNumber;
    property XFormat: TxlsXFormat read FXFormat write FXFormat;
  end;

  TxlsXFormatColRowList = class(TList)
  private
    function Get(Index: integer): TxlsXFormatColRow;
    procedure Put(Index: integer; Value: TxlsXFormatColRow);
  public
    destructor Destroy; override;
    function Add(Item: TxlsXFormatColRow): integer;
    function IndexByXF(XF: word): integer;
    function XFIndexByNumber(SheetIndex, Number: integer): word;

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

  TxlsBorder = class(TPersistent)
  private
    FStyle: TxlsBorderStyle;
    FColor: TxlsColor;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    function IsEqual(Border: TxlsBorder): boolean;
    procedure SetDefault;
  published
    property Style: TxlsBorderStyle read FStyle write FStyle default bstNone;
    property Color: TxlsColor read FColor write FColor default clrBlack;
  end;

  TxlsBorders = class(TPersistent)
  private
    FLeft: TxlsBorder;
    FRight: TxlsBorder;
    FTop: TxlsBorder;
    FBottom: TxlsBorder;
    FDiagDown: TxlsBorder;
    FDiagUp: TxlsBorder;
    procedure SetLeft(const Value: TxlsBorder);
    procedure SetRight(const Value: TxlsBorder);
    procedure SetTop(const Value: TxlsBorder);
    procedure SetBottom(const Value: TxlsBorder);
    procedure SetDiagDown(const Value: TxlsBorder);
    procedure SetDiagUp(const Value: TxlsBorder);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function IsEqual(Borders: TxlsBorders): boolean;
    procedure SetDefault;
  published
    property Left: TxlsBorder read FLeft write SetLeft;
    property Right: TxlsBorder read FRight write SetRight;
    property Top: TxlsBorder read FTop write SetTop;
    property Bottom: TxlsBorder read FBottom write SetBottom;
    property DiagDown: TxlsBorder read FDiagDown write SetDiagDown;
    property DiagUp: TxlsBorder read FDiagUp write SetDiagUp;
  end;

  TxlsFill = class(Tpersistent)
  private
    FBackground: TxlsColor;
    FPattern: TxlsPattern;
    FForeground: TxlsColor;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    function IsEqual(Fill: TxlsFill): boolean;
    procedure SetDefault;
  published
    property Background: TxlsColor read FBackground write FBackground default clrWhite;
    property Pattern: TxlsPattern read FPattern write FPattern default ptNone;
    property Foreground: TxlsColor read FForeground write FForeground default clrBlack;
  end;

  TxlsAlignment = class(TPersistent)
  private
    FHorizontal: TxlsHorizontalAlignment;
    FVertical: TxlsVerticalAlignment;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    function IsEqual(Alignment: TxlsAlignment): boolean;
    procedure SetDefault;
  published
    property Horizontal: TxlsHorizontalAlignment read FHorizontal write FHorizontal default halGeneral;
    property Vertical: TxlsVerticalAlignment read FVertical write FVertical default valBottom;
  end;