tmsadvgridexcel.pas

TMS Component Pack V5.0包含了超过 280 个为 Delphi 以及 C++Builder 设计的 TMS 生产控件

unit tmsAdvGridExcel;
{$INCLUDE ..\FLXCOMPILER.INC}
{$INCLUDE ..\FLXCONFIG.INC}
interface
{$IFDEF FLEXCELADVSTRINGGRID}
uses
  Windows, SysUtils, Classes, tmsXLSAdapter, tmsUExcelAdapter, tmsUFlxUtils, AdvGrid, AdvGridWorkbook,
  tmsUFlxFormats, tmsUFlxMessages, BaseGrid, tmsUXlsPictures, ShellAPI, Dialogs, Controls, Printers, tmsXlsMessages,
{$IFDEF FLX_NEEDSVARIANTS}Variants,{$ENDIF} //Delphi 6 or above

  {$INCLUDE UsePngLib.inc}

  Graphics, AsgHTMLE,
  {$IFDEF FLX_NEEDSJPEG} JPEG, {$ENDIF}
  tmsUFlxNumberFormat, Grids;
const
  CellOfs = 0;
type
  TFlxFormatCellEvent = procedure(Sender: TAdvStringGrid; const GridCol, GridRow, XlsCol, XlsRow: integer; const Value: WideString; var DateFormat, TimeFormat: WideString) of object;
  TFlxFormatCellGenericEvent = procedure(Sender: TAdvStringGrid; const GridCol, GridRow, XlsCol, XlsRow: integer; const Value: WideString; var Format: TFlxFormat) of object;

  TASGIOProgressEvent = procedure(Sender: TObject; SheetNum, SheetTot, RowNum, RowTot: integer) of object;
  TExportColumnFormatEvent = procedure (Sender: TObject; GridCol, GridRow, XlsCol, XlsRow: integer; const Value: WideString; var ExportCellAsString: boolean) of object;
  TGetCommentBoxSizeEvent = procedure (Sender: TObject; const Comment: WideString; var Height, Width: integer) of object;

  TOverwriteMode = (omNever, omAlways, omWarn);

  TInsertInSheet =
  (
      //Clears everything on the sheet before exporting the grid.
      InsertInSheet_Clear,

      //Overwrites existing cells, but does not clear any existing information on the sheet.
      InsertInSheet_OverwriteCells,

      //Inserts the grid inside the existing sheet, moving all the other rows down.
      InsertInSheet_InsertRows,

      //Inserts the grid inside the existing sheet, moving all the other columns to the right.
      InsertInSheet_InsertCols,

      //Inserts the grid inside the existing sheet, moving all the other rows down (Grid.RowCount - 2) rows.
      //The first two rows will be overwrited. This can be used to export for example inside of a chart.
      InsertInSheet_InsertRowsExceptFirstAndSecond,

      //Inserts the grid inside the existing sheet, moving all the other columns right (Grid.ColCount - 2) columns.
      //The first two columns will be overwrited. This can be used to export for example inside of a chart.
      InsertInSheet_InsertColsExceptFirstAndSecond

  )  ;

  TASGIOOptions = class(TPersistent)
  private
    FImportCellProperties: Boolean;
    FImportCellSizes: Boolean;
    FImportCellFormats: Boolean;
    FImportFormulas: Boolean;
    FImportImages: Boolean;
    FImportPrintOptions: boolean;
    FExportCellSizes: Boolean;
    FExportCellFormats: Boolean;
    FExportFormulas: Boolean;
    FExportCellProperties: Boolean;
    FExportWordWrapped: Boolean;
    FExportHTMLTags: Boolean;
    FExportHiddenColumns: Boolean;
    FExportHiddenRows: Boolean;
    FExportShowInExcel: Boolean;
    FExportOverwriteMessage: string;
    FExportOverwrite: TOverwriteMode;
    FExportHardBorders: boolean;
    FUseExcelStandardColorPalette: Boolean;
    FExportShowGridLines: boolean;
    FImportLockedCellsAsReadonly: boolean;
    FExportReadonlyCellsAsLocked: boolean;
    FExportPrintOptions: boolean;
    FExportSummaryRowsBelowDetail: boolean;
  public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
  published
    property ImportFormulas: Boolean read FImportFormulas write FImportFormulas default True;
    property ImportImages: Boolean read FImportImages write FImportImages default True;
    property ImportCellFormats: Boolean read FImportCellFormats write FImportCellFormats default True;
    property ImportCellProperties: Boolean read FImportCellProperties write FImportCellProperties default False;
    property ImportCellSizes: Boolean read FImportCellSizes write FImportCellSizes default True;
    property ImportLockedCellsAsReadonly: Boolean read FImportLockedCellsAsReadonly write FImportLockedCellsAsReadonly default false;
    property ExportOverwrite: TOverwriteMode read FExportOverwrite write FExportOverwrite default omNever;
    property ExportOverwriteMessage: string read FExportOverwriteMessage write FExportOverwriteMessage;
    property ExportFormulas: Boolean read FExportFormulas write FExportFormulas default True;
    property ExportCellFormats: Boolean read FExportCellFormats write FExportCellFormats default True;
    property ExportCellProperties: Boolean read FExportCellProperties write FExportCellProperties default True;
    property ExportCellSizes: Boolean read FExportCellSizes write FExportCellSizes default True;
    property ExportHiddenColumns: Boolean read FExportHiddenColumns write FExportHiddenColumns default False;
    //this property is not ready yet.
    //property ExportHiddenRows: Boolean read FExportHiddenRows write FExportHiddenRows default False;
    property ExportReadonlyCellsAsLocked: Boolean read FExportReadonlyCellsAsLocked write FExportReadonlyCellsAsLocked default False;
    property ExportWordWrapped: Boolean read FExportWordWrapped write FExportWordWrapped default False;
    property ExportHTMLTags: Boolean read FExportHTMLTags write FExportHTMLTags default True;
    property ExportShowInExcel: Boolean read FExportShowInExcel write FExportShowInExcel default False;
    property ExportHardBorders: Boolean read FExportHardBorders write FExportHardBorders default False;
    property ExportShowGridLines: Boolean read FExportShowGridLines write FExportShowGridLines default True;

    property ExportPrintOptions: Boolean read FExportPrintOptions write FExportPrintOptions default True;
    property ImportPrintOptions: Boolean read FImportPrintOptions write FImportPrintOptions default True;

    property ExportSummaryRowsBelowDetail: Boolean read FExportSummaryRowsBelowDetail write FExportSummaryRowsBelowDetail default False;

    ///<summary>
    /// When true, the standard Excel color palette will be used while exporting. Excel 97/2003 have only 53 available colors,
    /// and any color that does not match must be replaced with the nearest one. If this property is false,
    /// the Excel color palette will be changed to better display the real grid colors. Note that when you want to
    /// edit the generated file, having a custom palette might make it difficult to find the color you need.
    ///</summary>
    property UseExcelStandardColorPalette: Boolean read FUseExcelStandardColorPalette write FUseExcelStandardColorPalette default True;
  end;

  TAGrid = class(TAdvStringGrid)
  end;

  TOneRowBorder= record
    HasBottom: boolean;
    HasRight: boolean;
    BottomColor: integer;
    RightColor: integer;
  end;

  TRowBorderArray = array of TOneRowBorder;

  TAdvGridExcelIO = class(TComponent)
  private
    { Private declarations }
    FAdvStringGrid: TAdvStringGrid;
    FAdvGridWorkbook: TAdvGridWorkbook;
    FAdapter: TExcelAdapter;
    FAutoResizeGrid: boolean;
    FUseUnicode: boolean;
    FSheetNames: array of UTF16String;
    FGridStartCol: Integer;
    FGridStartRow: Integer;
    FXlsStartRow: Integer;
    FXlsStartCol: Integer;
    FZoomSaved: Boolean;
    FZoom: Integer;
    FWorkSheet: Integer;
    FWorkSheetNum: Integer;
    FDateFormat: UTF16String;
    FTimeFormat: UTF16String;
    FOptions : TASGIOOptions;
    FOnDateTimeFormat: TFlxFormatCellEvent;
    FOnCellFormat: TFlxFormatCellGenericEvent;
    FOnProgress: TASGIOProgressEvent;
    FOnExportColumnFormat: TExportColumnFormatEvent;
    FOnGetCommentBoxSize: TGetCommentBoxSizeEvent;

    // procedure SetAdapter(const Value: TExcelAdapter);
    procedure SetAdvStringGrid(const Value: TAdvStringGrid);
    procedure SetAdvGridWorkbook(const Value: TAdvGridWorkbook);
    function CurrentGrid: TAGrid;
    procedure ImportData(const Workbook: TExcelFile);
    procedure ExportData(const Workbook: TExcelFile);
    procedure CloseFile(var Workbook: TExcelFile);
    function CellFormatDef(const Workbook: TExcelFile; const aRow, aCol: integer): TFlxFormat;
    function GetColor(const Workbook: TExcelFile; const Fm: TFlxFormat): TColor;
    function GetSheetNames(index: integer): UTF16String;
    function GetSheetNamesCount: integer;
    procedure SetGridStartCol(const Value: integer);
    procedure SetGridStartRow(const Value: integer);
    procedure SetXlsStartCol(const Value: integer);
    procedure SetXlsStartRow(const Value: integer);
    procedure OpenText(const Workbook: TExcelFile; const FileName: TFileName; const Delimiter: Char);
    procedure SetZoom(const Value: integer);
    procedure ImportImages(const Workbook: TExcelFile; const Zoom100: extended);
    procedure ExportImage(const Workbook: TExcelFile; const Pic: TGraphic; const rx, cx, cg, rg: integer);
    procedure InternalXLSImport(const FileName: TFileName; const SheetNumber: integer; const SheetName: UTF16String);
    function SupressCR(s: UTF16String): UTF16String;
    function FindSheet(const Workbook: TExcelFile; const SheetName: UTF16String; out index: integer): boolean;
    procedure SetOptions(const Value: TASGIOOptions);
    procedure SetBorders(const cg, rg: integer; var LastRowBorders:TRowBorderArray; SpanRow, SpanCol: integer; var Fm: TFlxFormat; const Workbook: TExcelFile; const UsedColors: BooleanArray);
    procedure CopyFmToMerged(const Workbook: TExcelFile;
      const cp: TCellProperties; const rx, cx: integer; const Fm: TFlxFormat);
    procedure ImportNodes(const Workbook: TExcelFile; const first, last, level: integer);
    procedure ImportAllNodes(const Workbook: TExcelFile; const first, last: integer);
    function WideAdjustLineBreaks(const w: UTF16String): UTF16String;
    function NearestColorIndex(const Workbook: TExcelFile; const aColor: TColor; const UsedColors: BooleanArray): integer;
    function GetUsedPaletteColors(const Workbook: TExcelFile): BooleanArray;
    procedure OpenFile(const Workbook: TExcelFile; const FileName: string);
    procedure ResizeCommentBox(const Workbook: TExcelFile; const Comment: string; var h, w: integer);
    function GetVersion: string;
    procedure SetVersion(const Value: string);
    function RichToText(const RTFText: string): string;

  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    { Public declarations }
    procedure XLSImport(const FileName: TFileName); overload;
    procedure XLSImport(const FileName: TFileName; const SheetNumber: integer); overload;
    procedure XLSImport(const FileName: TFileName; const SheetName: UTF16String); overload;
    procedure XLSExport(const FileName: TFileName; const SheetName: UTF16String = ''; const SheetPos: integer = -1; const SelectSheet: integer = 1; const InsertInSheet: TInsertInSheet = InsertInSheet_Clear);

    procedure LoadSheetNames(const FileName: string);
    property SheetNames[index: integer]: UTF16String read GetSheetNames;
    property SheetNamesCount: integer read GetSheetNamesCount;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
   { Published declarations }
    //property Adapter: TExcelAdapter read FAdapter write SetAdapter;
    property AdvStringGrid: TAdvStringGrid read FAdvStringGrid write SetAdvStringGrid;
    property AdvGridWorkbook: TAdvGridWorkbook read FAdvGridWorkbook write SetAdvGridWorkbook;

    property AutoResizeGrid: Boolean read FAutoResizeGrid write FAutoResizeGrid default true;

    property Options: TASGIOOptions read FOptions write SetOptions;

    property UseUnicode: boolean read FUseUnicode write FUseUnicode;

    property GridStartRow: integer read FGridStartRow write SetGridStartRow default 1;
    property GridStartCol: integer read FGridStartCol write SetGridStartCol default 1;
    property XlsStartRow: integer read FXlsStartRow write SetXlsStartRow default 1;
    property XlsStartCol: integer read FXlsStartCol write SetXlsStartCol default 1;

    property ZoomSaved: boolean read FZoomSaved write FZoomSaved default true;
    property Zoom: integer read FZoom write SetZoom default 100;

    property DateFormat: UTF16String read FDateFormat write FDateFormat;
    property TimeFormat: UTF16String read FTimeFormat write FTimeFormat;

    property Version: string read GetVersion write SetVersion;

    //Events

    property OnDateTimeFormat: TFlxFormatCellEvent read FOnDateTimeFormat write FOnDateTimeFormat;
    property OnCellFormat: TFlxFormatCellGenericEvent read FOnCellFormat write FOnCellFormat;
    property OnProgress: TASGIOProgressEvent read FOnProgress write FOnProgress;
    property OnExportColumnFormat: TExportColumnFormatEvent read FOnExportColumnFormat write FOnExportColumnFormat;
    property OnGetCommentBoxSize: TGetCommentBoxSizeEvent read FOnGetCommentBoxSize write FOnGetCommentBoxSize;


  end;

{$ENDIF}

implementation
{$IFDEF FLEXCELADVSTRINGGRID}


const
  RtfStart = '{\rtf';

type
TTmpCanvas = class
  private
    bmp: TBitmap;
  public
    Canvas: TCanvas;

    constructor Create;
    destructor Destroy; override;
end;



{ TAdvGridExcelIO }

procedure TAdvGridExcelIO.CloseFile(var Workbook: TExcelFile);
begin
  if Workbook = nil then exit;
  try
    Workbook.CloseFile;
  except
    //nothing;
  end; //Except
  try
    Workbook.Disconnect;
  except
    //nothing;
  end; //Except
  FreeAndNil(Workbook);
end;

function TAdvGridExcelIO.CellFormatDef(const Workbook: TExcelFile; const aRow, aCol: integer): TFlxFormat;
var
  XF: integer;
begin
  XF := Workbook.CellFormat[aRow, aCol];
  if XF < 0 then
  begin

    XF := Workbook.RowFormat[aRow];
    if XF <= 0 then XF := Workbook.ColumnFormat[aCol];
  end;
  if (XF < 0) then XF := 15;
  Result := Workbook.FormatList[XF];
end;

function TAdvGridExcelIO.GetColor(const Workbook: TExcelFile; const Fm: TFlxFormat): TColor;
var
  bc: TColor;
begin
  if Fm.FillPattern.Pattern = 1 then Result := $FFFFFF
  else
  begin
    bc := Fm.FillPattern.FgColorIndex;
    if (bc > 0) and (integer(bc) <= 56) then
      Result := Workbook.ColorPalette[bc] else
      Result := $FFFFFF;
  end;
end;

procedure TAdvGridExcelIO.ImportImages(const Workbook: TExcelFile; const Zoom100: extended);
var
  i: integer;
  Pic: TStream;
  PicType: TXlsImgTypes;
  Picture, TmpPic: TPicture;
  Bmp: TBitmap;
  Anchor: TClientAnchor;
  Handled: boolean;
  w, h: integer;

  StartX, StartY, SpanX, SpanY: integer;
begin
  if FOptions.ImportImages then
  begin
    for i := 0 to Workbook.PicturesCount[-1] - 1 do
    begin
      Pic := TMemoryStream.Create;
      try
        Workbook.GetPicture(-1, i, Pic, PicType, Anchor);

        if Anchor.Dx1 > 1024 div 2 then StartX := Anchor.Col1 + 1 else StartX := Anchor.Col1;
        SpanX := Anchor.Col2 - StartX + 1;
        if Anchor.Dy1 > 255 div 2 then StartY := Anchor.Row1 + 1 else StartY := Anchor.Row1;
        SpanY := Anchor.Row2 - StartY + 1;

        //Resize the grid if too small
        if FAutoResizeGrid then
        begin
          if Anchor.Col2 + GridStartCol - XlsStartCol + 2 > CurrentGrid.ColCount then
            if Anchor.Col2 + GridStartCol - XlsStartCol + 2 > CurrentGrid.FixedCols then
              CurrentGrid.ColCount := Anchor.Col2 + GridStartCol - XlsStartCol + 2;
          if Anchor.Row2 + GridStartRow - XlsStartRow + 2 > CurrentGrid.RowCount then
            if Anchor.Row2 - XlsStartRow + GridStartRow + 2 > CurrentGrid.FixedRows then
              CurrentGrid.RowCount := Anchor.Row2 - XlsStartRow + GridStartRow + 2;
        end;

        if Anchor.Row1 < XlsStartRow then continue;
        if Anchor.Col1 < XlsStartCol then continue;

        if Anchor.Col2 + GridStartCol - XlsStartCol > CurrentGrid.ColCount then continue;
        if Anchor.Row2 + GridStartRow - XlsStartRow > CurrentGrid.RowCount then continue;

        Picture := CurrentGrid.CreatePicture(StartX + GridStartCol - XlsStartCol, StartY + GridStartRow - XlsStartRow, false, noStretch, 0, haLeft, vaTop);
        try
          //Merge picture cells so we get a better size.

          CurrentGrid.MergeCells(StartX + GridStartCol - XlsStartCol, StartY + GridStartRow - XlsStartRow, SpanX, SpanY);
          //Load the image
          Pic.Position := 0;
          CalcImgDimentions(Workbook, Anchor, w, h);
          TmpPic := TPicture.Create;
          try
            SaveImgStreamToGraphic(Pic, PicType, TmpPic, Handled);
            if not Handled then
              raise Exception.Create('Not handled'); //This will be catched below. It is an internal exception so image is deleted
            Bmp := TBitmap.Create;
            try
              Picture.Graphic := Bmp;
            finally
              FreeAndNil(Bmp); //Remember TPicture.Graphic keeps a COPY of the TGraphic
            end;
            (Picture.Graphic as TBitmap).Width := Round(w * Zoom100);
            (Picture.Graphic as TBitmap).Height := Round(h * Zoom100);