rm_wawexcel.pas

这是一个功能强大

unit RM_wawExcel;

{$I rm.inc}

interface

uses
  Windows, Classes, SysUtils, Graphics, Math,
{$IFDEF COMPILER6_UP}Variants, {$ENDIF}
  RM_wawConsts, RM_wawExcelFmt, RM_wawBIFF8;

const
  sDefaultFontName = 'Arial';
  sXLSWorksheetTitlePrefix = 'Sheet';

//  XLSDefaultRowHeight = $FF;   //waw
  XLSDefaultRowHeight = $11D; //waw
  XLSDefaultColumnWidthInChars = 8;

  MaxDefaultColors = $10;
  MaxBiffRecordSize = $2024;

  mergeBlockItemsCount = $0400;

  sErrorInvalidPictureFormat = 'Invalid picture format';

type
  TCardinalArray = array[$0..$0] of Cardinal;

  PCardinalArray = ^TCardinalArray;

  TwawXLSBorder = class(TObject)
  private
    FColor: TColor;
    FLineStyle: TwawXLSLineStyleType;
    FWeight: TwawXLSWeightType;
  public
    property Color: TColor read FColor write FColor;
    property LineStyle: TwawXLSLineStyleType read FLineStyle write FLineStyle;
    property Weight: TwawXLSWeightType read FWeight write FWeight;
    constructor Create;
    destructor Destroy; override;
  end;

  TwawXLSBorders = class(TObject)
  private
    FBorders: array[TwawXLSBorderType] of TwawXLSBorder;
    function GetItem(i: TwawXLSBorderType): TwawXLSBorder;
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetAttributes(ABorders: TwawXLSBorderTypes; AColor: TColor;
      ALineStyle: TwawXLSLineStyleType; AWeight: TwawXLSWeightType);
    property Borders[i: TwawXLSBorderType]: TwawXLSBorder read GetItem; default;
  end;

  TDynWordArray = array of Word;

  TwawXLSWorksheet = class;
  TwawXLSWorkbook = class;

  TwawXLSRange = class(TObject)
  private
    FWorksheet: TwawXLSWorksheet;
    FPlace: TRect;
    FBorders: TwawXLSBorders;
    FFont: TFont;
    FHorizontalAlignment: TwawXLSHorizontalAlignmentType;
    FVerticalAlignment: TwawXLSVerticalAlignmentType;
    FWrapText: Boolean;
    FRotation: Byte;
    FFormat: string;
    FValue: Variant;
    FFillPattern: TwawXLSFillPattern;
    FForegroundFillPatternColor: TColor;
    FBackgroundFillPatternColor: TColor;
    FFormula: string;
    FExportData: Pointer;
    function GetWorkbook: TwawXLSWorkbook;
    function GetCellDataType: TwawCellDataType;
    procedure SetValue(Value: Variant);
  public
    property Worksheet: TwawXLSWorksheet read FWorksheet;
    property Workbook: TwawXLSWorkbook read GetWorkbook;
    property Place: TRect read FPlace;
    property Borders: TwawXLSBorders read FBorders;
    property Font: TFont read FFont;
    property HorizontalAlignment: TwawXLSHorizontalAlignmentType
      read FHorizontalAlignment write FHorizontalAlignment;
    property VerticalAlignment: TwawXLSVerticalAlignmentType
      read FVerticalAlignment write FVerticalAlignment;
    property Value: Variant read FValue write SetValue;
    property WrapText: Boolean read FWrapText write FWrapText;
    property Rotation: Byte read FRotation write FRotation;
    property Format: string read FFormat write FFormat;
    property FillPattern: TwawXLSFillPattern read FFillPattern write FFillPattern;
    property ForegroundFillPatternColor: TColor
      read FForegroundFillPatternColor
      write FForegroundFillPatternColor;
    property BackgroundFillPatternColor: TColor
      read FBackgroundFillPatternColor
      write FBackgroundFillPatternColor;
    property ExportData: Pointer read FExportData write FExportData;
    property CellDataType: TwawCellDataType read GetCellDataType;
    property Formula: string read FFormula write FFormula;
    constructor Create(AWorksheet: TwawXLSWorksheet);
    destructor Destroy; override;
  end;

  TwawXLSRow = class(TObject)
  private
    FInd: Integer;
    FHeight: Integer;
    function GetPixelHeight: Integer;
    procedure SetPixelHeight(value: Integer);
    function GetInchHeight: Double;
    procedure SetInchHeight(value: Double);
    function GetCentimeterHeight: Double;
    procedure SetCentimeterHeight(value: Double);
    function GetExcelHeight: Double;
    procedure SetExcelHeight(value: Double);
  public
    property Ind: Integer read FInd;
    property Height: Integer read FHeight write FHeight;
    property PixelHeight: Integer read GetPixelHeight write SetPixelHeight;
    property InchHeight: Double read GetInchHeight write SetInchHeight;
    property CentimeterHeight: Double read GetCentimeterHeight write SetCentimeterHeight;
    property ExcelHeight: Double read GetExcelHeight write SetExcelHeight;
    constructor Create;
  end;

  TwawXLSCol = class(TObject)
  private
    FInd: Integer;
    FWidth: Integer;
    procedure SetWidth(Value: Integer);
    function GetPixelWidth: Integer;
    procedure SetPixelWidth(value: Integer);
    function GetInchWidth: Double;
    procedure SetInchWidth(value: Double);
    function GetCentimeterWidth: Double;
    procedure SetCentimeterWidth(value: Double);
    function GetExcelWidth: Double;
    procedure SetExcelWidth(value: Double);
  public
    property Ind: Integer read FInd write FInd;
    property Width: Integer read FWidth write SetWidth;
    property PixelWidth: Integer read GetPixelWidth write SetPixelWidth;
    property InchWidth: Double read GetInchWidth write SetInchWidth;
    property CentimeterWidht: Double read GetCentimeterWidth write SetCentimeterWidth;
    property ExcelWidth: Double read GetExcelWidth write SetExcelWidth;
    constructor Create;
  end;

  TwawXLSPageSetup = class(TObject)
  private
    FBlackAndWhite: Boolean;
    FCenterFooter: string;
    FCenterHeader: string;
    FCenterHorizontally: Boolean;
    FCenterVertically: Boolean;
    FDraft: Boolean;
    FFirstPageNumber: Integer;
    FFitToPagesTall: Integer;
    FFitToPagesWide: Integer;
    FLeftFooter: string;
    FLeftHeader: string;
    FOrder: TwawXLSOrderType;
    FOrientation: TwawXLSOrientationType;
    FPaperSize: TwawXLSPaperSizeType;
    FPrintGridLines: Boolean;
    FPrintHeaders: Boolean;
    FPrintNotes: Boolean;
    FRightFooter: string;
    FRightHeader: string;
    FLeftMargin: Double;
    FRightMargin: Double;
    FTopMargin: Double;
    FBottomMargin: Double;
    FFooterMargin: Double;
    FHeaderMargin: Double;
    FZoom: Integer;
    FCopies: Integer;
  public
    property LeftFooter: string read FLeftFooter write FLeftFooter;
    property LeftHeader: string read FLeftHeader write FLeftHeader;
    property CenterFooter: string read FCenterFooter write FCenterFooter;
    property CenterHeader: string read FCenterHeader write FCenterHeader;
    property RightFooter: string read FRightFooter write FRightFooter;
    property RightHeader: string read FRightHeader write FRightHeader;
    property CenterHorizontally: Boolean read FCenterHorizontally write FCenterHorizontally;
    property CenterVertically: Boolean read FCenterVertically write FCenterVertically;
    property LeftMargin: Double read FLeftMargin write FLeftMargin;
    property RightMargin: Double read FRightMargin write FRightMargin;
    property TopMargin: Double read FTopMargin write FTopMargin;
    property BottomMargin: Double read FBottomMargin write FBottomMargin;
    property HeaderMargin: Double read FHeaderMargin write FHeaderMargin;
    property FooterMargin: Double read FFooterMargin write FFooterMargin;
    property PaperSize: TwawXLSPaperSizeType read FPaperSize write FPaperSize;
    property Orientation: TwawXLSOrientationType read FOrientation write FOrientation;
    property Order: TwawXLSOrderType read FOrder write FOrder;
    property FirstPageNumber: Integer read FFirstPageNumber write FFirstPageNumber;
    property FitToPagesTall: Integer read FFitToPagesTall write FFitToPagesTall;
    property FitToPagesWide: Integer read FFitToPagesWide write FFitToPagesWide;
    property Copies: Integer read FCopies write FCopies;
    property Zoom: Integer read FZoom write FZoom;
    property BlackAndWhite: Boolean read FBlackAndWhite write FBlackAndWhite;
    property Draft: Boolean read FDraft write FDraft;
    property PrintNotes: Boolean read FPrintNotes write FPrintNotes;
    property PrintGridLines: Boolean read FPrintGridLines write FPrintGridLines;
    property PrintHeaders: Boolean read FPrintHeaders write FPrintHeaders;
    constructor Create;
  end;

  TwawImage = class(TObject)
  private
    FLeft: Integer;
    FLeftCO: Integer;
    FTop: Integer;
    FTopCO: Integer;
    FRight: Integer;
    FRightCO: Integer;
    FBottom: Integer;
    FBottomCO: Integer;
    FPicture: TPicture;
    FOwnsImage: Boolean;
    FBorderLineColor: TColor;
    FBorderLineStyle: TwawXLSImageBorderLineStyle;
    FBorderLineWeight: TwawXLSImageBorderLineWeight;
    FScalePercentX: Integer;
    FScalePercentY: Integer;
  public
    property Left: Integer read FLeft write FLeft;
    property LeftCO: Integer read FLeftCO write FLeftCO;
    property Top: Integer read FTop write FTop;
    property TopCO: Integer read FTopCO write FTopCO;
    property Right: Integer read FRight write FRight;
    property RightCO: Integer read FRightCO write FRightCO;
    property Bottom: Integer read FBottom write FBottom;
    property BottomCO: Integer read FBottomCO write FBottomCO;
    property Picture: TPicture read FPicture;
    property BorderLineColor: TColor read FBorderLineColor write FBorderLineColor;
    property BorderLineStyle: TwawXLSImageBorderLineStyle
      read FBorderLineStyle write FBorderLineStyle;
    property BorderLineWeight: TwawXLSImageBorderLineWeight
      read FBorderLineWeight write FBorderLineWeight;
    property ScalePercentX: Integer read FScalePercentX write FScalePercentX;
    property ScalePercentY: Integer read FScalePercentY write FScalePercentY;
    constructor Create(_Left: Integer; _Top: Integer; _Right: Integer;
      _Bottom: Integer; _Picture: TPicture; _OwnsImage: Boolean);
    constructor CreateScaled(_Left: Integer; _LeftCO: Integer;
      _Top: Integer; _TopCO: Integer; _ScalePercentX: Integer;
      _ScalePercentY: Integer; _Picture: TPicture; _OwnsImage: Boolean);
    constructor CreateWithOffsets(_Left: Integer; _LeftCO: Integer;
      _Top: Integer; _TopCO: Integer; _Right: Integer; _RightCO: Integer;
      _Bottom: Integer; _BottomCO: Integer; _Picture: TPicture;
      _OwnsImage: Boolean);
    destructor Destroy; override;
  end;

  TwawImages = class(TList)
  private
    function GetItm(i: Integer): TwawImage;
  public
    property Items[i: Integer]: TwawImage read GetItm; default;
    procedure Clear; override;
    destructor Destroy; override;
  end;

  TwawXLSWorksheet = class(TObject)
  private
    FWorkbook: TwawXLSWorkbook;
    FTitle: string;
    FPageSetup: TwawXLSPageSetup;
    FImages: TwawImages;
    FRanges: TList;
    FCols: TList;
    FRows: TList;
    FPageBreaks: TList;
    FDimensions: TRect;
    FMaxRangeLength: Integer;
    procedure SetTitle(Value: string);
    function GetCol(ColIndex: Integer): TwawXLSCol;
    function GetRow(RowIndex: Integer): TwawXLSRow;
    function GetRangesCount: Integer;
    function GetXLSRange(RangeIndex: Integer): TwawXLSRange;
    function GetColsCount: Integer;
    function GetRowsCount: Integer;
    function GetIndexInWorkBook: Integer;
    function GetColByIndex(i: Integer): TwawXLSCol;
    function GetRowByIndex(i: Integer): TwawXLSRow;
    function GetPageBreak(i: Integer): Integer;
    function GetPageBreaksCount: Integer;
    function AddRow(RowIndex: Integer): TwawXLSRow;
    function AddCol(ColIndex: Integer): TwawXLSCol;
    procedure SetMaxRangeLength(Value: Integer);
    procedure ResetMaxRangeLength;
    function GetRangeSp(xl: Integer; yt: Integer; xr: Integer; yb: Integer): TwawXLSRange;
    function SeekTop(Value: Integer): Integer;
    function ScanGet(Index: Integer; R: TRect; var RemoveFlag: Boolean): TwawXLSRange;
  public
    property Title: string read FTitle write SetTitle;
    property PageSetup: TwawXLSPageSetup read FPageSetup;
    property Ranges[xl: Integer; yt: Integer; xr: Integer; yb: Integer]: TwawXLSRange read GetRangeSp; default;
    property Cols[ColIndex: Integer]: TwawXLSCol read GetCol;
    property Rows[RowIndex: Integer]: TwawXLSRow read GetRow;
    property RangeByIndex[RangeIndex: Integer]: TwawXLSRange read GetXLSRange;
    property RangesCount: Integer read GetRangesCount;
    property ColByIndex[ColIndex: Integer]: TwawXLSCol read GetColByIndex;
    property ColsCount: Integer read GetColsCount;
    property RowByIndex[RowIndex: Integer]: TwawXLSRow read GetRowByIndex;
    property RowsCount: Integer read GetRowsCount;
    property IndexInWorkBook: Integer read GetIndexInWorkBook;
    property Images: TwawImages read FImages;
    property PageBreaks[i: Integer]: Integer read GetPageBreak;
    property PageBreaksCount: Integer read GetPageBreaksCount;
    property Workbook: TwawXLSWorkbook read FWorkbook;
    property Dimensions: TRect read FDimensions;
    function GetDefaultColumnPixelWidth: Integer;
    function GetDefaultRowPixelHeight: Integer;
    function FindRow(RowIndex: Integer): TwawXLSRow;
    function FindCol(ColIndex: Integer): TwawXLSCol;
    function FindPageBreak(RowNumber: Integer): Integer;
    function AddImage(Left: Integer; Top: Integer; Right: Integer;
      Bottom: Integer; Picture: TPicture; OwnsImage: Boolean): TwawImage;
    function AddImageWithOffsets(Left: Integer; LeftCO: Integer;
      Top: Integer; TopCO: Integer; Right: Integer; RightCO: Integer;
      Bottom: Integer; BottomCO: Integer; Picture: TPicture;
      OwnsImage: Boolean): TwawImage;
    function AddImageScaled(Left: Integer; LeftCO: Integer; Top: Integer;
      TopCO: Integer; ScalePercentX: Integer; ScalePercentY: Integer;
      Picture: TPicture; OwnsImage: Boolean): TwawImage;
    procedure AddPageBreakAfterRow(RowNumber: Integer);
    procedure DeletePageBreakAfterRow(RowNumber: Integer);
    constructor Create(AWorkbook: TwawXLSWorkbook);
    destructor Destroy; override;
  end;

  TwawXLSWorkbook = class(TObject)
  private
    FUserNameOfExcel: string;
    FSheets: TList;
    procedure SetUserNameOfExcel(Value: string);
    procedure ClearSheets;
    function GetSheetsCount: Integer;
    function GetXLSWorkSheet(i: Integer): TwawXLSWorksheet;
  public
    property UserNameOfExcel: string read FUserNameOfExcel write SetUserNameOfExcel;
    property SheetsCount: Integer read GetSheetsCount;
    property Sheets[i: Integer]: TwawXLSWorksheet read GetXLSWorkSheet;
    procedure SaveAsXLSToFile(FileName: string);
    procedure SaveAsHTMLToFile(FileName: string);
    function AddSheet: TwawXLSWorksheet;
    function GetSheetIndex(SheetTitle: string): Integer;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
  end;

  TwawCustomWriter = class(TObject)
  public
    procedure Save(WorkBook: TwawXLSWorkbook; FileName: string);
      virtual;
  end;

function PointInRect(X: Integer; Y: Integer; var R: TRect): Boolean;

function RectOverRect(var r1: TRect; var r2: TRect): Boolean;

implementation

uses
  RM_wawWriters;

function GetCharacterWidth: Integer;
var
  F: TFont;
  SaveFont: HFont;
  DC: HDC;
  TM: TEXTMETRIC;
begin
  SaveFont := HFont(nil);
  DC := GetDC(0);
  F := TFont.Create;
  try
    F.Name := sDefaultFontName;
    F.Size := wawDefFontSize;
    SaveFont := SelectObject(DC, F.Handle);
    GetTextMetrics(DC, TM);
    result := TM.tmAveCharWidth + TM.tmOverhang + 1;