advgridexcel.pas

TMS Component Pack Pro v4.2

unit AdvGridExcel;
{$IFDEF LINUX}{$INCLUDE ../FLXCOMPILER.INC}{$ELSE}{$INCLUDE ..\FLXCOMPILER.INC}{$ENDIF}
{$IFDEF LINUX}{$INCLUDE ../FLXCONFIG.INC}{$ELSE}{$INCLUDE ..\FLXCONFIG.INC}{$ENDIF}
interface
{$IFDEF FLEXCELADVSTRINGGRID}
uses
  Windows, SysUtils, Classes, XLSAdapter, UExcelAdapter, UFlxUtils, AdvGrid, AdvGridWorkbook,
  UFlxFormats, UFlxMessages, BaseGrid, UXlsPictures, ShellAPI, Dialogs, Controls,
{$IFDEF ConditionalExpressions}{$IF CompilerVersion >= 14}Variants, {$IFEND}{$ENDIF} //Delphi 6 or above
{$IFDEF USEPNGLIB}
      //////////////////////////////// IMPORTANT ///////////////////////////////////////
      //To be able to display PNG images and WMFs, you have to install TPNGImage from http://pngdelphi.sourceforge.net/
      //If you don't want to install it, edit ../FLXCONFIG.INC and delete the line:
      // "{$DEFINE USEPNGLIB}" on the file
      //Note that this is only needed on Windows, CLX has native support for PNG
      ///////////////////////////////////////////////////////////////////////////////////
  pngimage, pngzlib,
      ///////////////////////////////////////////////////////////////////////////////////
      //If you are getting an error here, please read the note above.
      ///////////////////////////////////////////////////////////////////////////////////
{$ENDIF}
  Graphics, JPEG, AsgHTMLE, 
  UTextDelim, 
  UFlxNumberFormat, 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;

  TOverwriteMode = (omNever, omAlways, omWarn);

  TASGIOOptions = class(TPersistent)
  private
    FImportCellProperties: Boolean;
    FImportCellSizes: Boolean;
    FImportCellFormats: Boolean;
    FImportFormulas: Boolean;
    FImportImages: Boolean;
    FExportCellSizes: Boolean;
    FExportCellFormats: Boolean;
    FExportFormulas: Boolean;
    FExportCellProperties: Boolean;
    FExportWordWrapped: Boolean;
    FExportHTMLTags: Boolean;
    FExportHiddenColumns: Boolean;
    FExportShowInExcel: Boolean;
    FExportOverwriteMessage: string;
    FExportOverwrite: TOverwriteMode;
    FExportHardBorders: boolean;
    FUseExcelStandardColorPalette: Boolean;
    FExportShowGridLines: 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 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;
    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;

    ///<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 Widestring;
    FGridStartCol: Integer;
    FGridStartRow: Integer;
    FXlsStartRow: Integer;
    FXlsStartCol: Integer;
    FZoomSaved: Boolean;
    FZoom: Integer;
    FWorkSheet: Integer;
    FWorkSheetNum: Integer;
    FDateFormat: widestring;
    FTimeFormat: widestring;
    FOptions : TASGIOOptions;
    FOnDateTimeFormat: TFlxFormatCellEvent;
    FOnCellFormat: TFlxFormatCellGenericEvent;
    FOnProgress: TASGIOProgressEvent;
    // 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): widestring;
    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: widestring);
    function SupressCR(const s: Widestring): widestring;
    function FindSheet(const Workbook: TExcelFile; const SheetName: widestring; var 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: widestring): widestring;
    function NearestColorIndex(const Workbook: TExcelFile; const aColor: TColor; const UsedColors: BooleanArray): integer;
    function GetUsedPaletteColors(const Workbook: TExcelFile): BooleanArray;

  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: widestring); overload;
    procedure XLSExport(const FileName: TFileName; const SheetName: widestring = ''; const SheetPos: integer = -1; const SelectSheet: integer = 1);

    procedure LoadSheetNames(const FileName: string);
    property SheetNames[index: integer]: widestring 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: widestring read FDateFormat write FDateFormat;
    property TimeFormat: widestring read FTimeFormat write FTimeFormat;

    //Events
    property OnDateTimeFormat: TFlxFormatCellEvent read FOnDateTimeFormat write FOnDateTimeFormat;
    property OnCellFormat: TFlxFormatCellGenericEvent read FOnCellFormat write FOnCellFormat;
    property OnProgress: TASGIOProgressEvent read FOnProgress write FOnProgress;
  end;

procedure Register;
{$ENDIF}
implementation
{$IFDEF FLEXCELADVSTRINGGRID}

procedure Register;
begin
  RegisterComponents('TMS Grids', [TAdvGridExcelIO]);
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);
            (Picture.Graphic as TBitmap).Canvas.StretchDraw(Rect(0, 0, Round(w * Zoom100), Round(h * Zoom100)), TmpPic.Graphic);
          finally
            FreeAndNil(TmpPic);
          end; //finally
        except
          //CurrentGrid.RemovePicture(Anchor.Col1+GridStartCol-XlsStartCol, Anchor.Row1+GridStartRow-XlsStartRow);
          CurrentGrid.RemovePicture(StartX + GridStartCol - XlsStartCol, StartY + GridStartRow - XlsStartRow);
          //Dont raise... is not a major error;
        end; //except
      finally
        FreeAndNil(Pic);
      end; //Finally
    end;
  end;
end;

procedure TAdvGridExcelIO.ImportNodes(const Workbook: TExcelFile; const first, last, level: integer);
var
  StartNode: integer;
  r: integer;
  CurrentLevel: integer;
begin
  r:=first;
  while r<=last do
  begin
    CurrentLevel:=Workbook.GetRowOutlineLevel(r);
    if CurrentLevel=Level then
    begin
      StartNode:=r;
      inc(r);
      while (r<=last) and (Workbook.GetRowOutlineLevel(r)>=CurrentLevel) do inc(r);
      if (r-StartNode>1) then
        CurrentGrid.AddNode(StartNode-1, r-StartNode+1);
    end
    else inc(r);
  end;
end;

procedure TAdvGridExcelIO.ImportAllNodes(const Workbook: TExcelFile; const first, last: integer);
var
  i: integer;
begin
  for i:=1 to 7 do
    ImportNodes(Workbook, first, last, i);
end;

function TAdvGridExcelIO.WideAdjustLineBreaks(const w: widestring): widestring;
var
  i, p: integer;
begin
  SetLength(Result, Length(w)*2);
  p:=0;
  for i:=1 to Length(w) do
  begin
    if w[i]=#10 then
    begin
      Result[p+i]:=#13;
      inc(p);
    end;
    Result[p+i]:=w[i];
  end;
  SetLength(Result, Length(w)+p);
end;

procedure TAdvGridExcelIO.ImportData(const Workbook: TExcelFile);
var
  r, c, i: integer;
  Fm: TFlxFormat;
  Mb: TXlsCellRange;

  MaxC, MaxR, cg, rg: integer;

  XF: integer;

  Zoom100: extended;
  FontColor: integer;
  w: widestring;
  v: variant;
  HAlign: TAlignment;

  HasTime, HasDate: boolean;
  Formula: string;
begin
  Assert(Workbook <> nil, 'AdvGridWorkbook can''t be nil');
  Assert(CurrentGrid <> nil, 'AdvStringGrid can''t be nil');

  if FZoomSaved then Zoom100 := Workbook.SheetZoom / 100 else Zoom100 := FZoom / 100;

  CurrentGrid.Clear;

  if FAutoResizeGrid then
  begin
    if Workbook.MaxRow - XlsStartRow + 1 + GridStartRow > CurrentGrid.FixedRows then
      CurrentGrid.RowCount := Workbook.MaxRow - XlsStartRow + 1 + GridStartRow;
    if Workbook.MaxCol - XlsStartCol + 1 + GridStartCol > CurrentGrid.FixedCols then