qimport3xlsx.pas

Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da

unit QImport3Xlsx;

{$I QImport3VerCtrl.Inc}

interface

{$IFDEF XLSX}
{$IFDEF VCL6}

uses
  QImport3StrTypes, QImport3, QImport3Common, BaseDocumentFile, Classes,
  SysUtils, IniFiles, msxml;

type
  TXlsxStyle = class(TCollectionItem)
  private
    FNumFmtId: Integer;                                 
  public
    property NumFmtId: Integer read FNumFmtId write FNumFmtId;
  end;

  TXlsxStyleList = class(TCollection)
  private
    function GetItem(Index: Integer): TXlsxStyle;
    procedure SetItem(Index: Integer; const Value: TXlsxStyle);
  public
    function Add: TXlsxStyle;
    property Items[Index: Integer]: TXlsxStyle read GetItem write SetItem; default;
  end;

  TXlsxSharedStrings = class(TCollectionItem)
  private
    FText: qiString;
  public
    property Text: qiString read FText write FText;
  end;

  TXlsxSharedStringList = class(TCollection)
  private
    function GetItem(Index: Integer): TXlsxSharedStrings;
    procedure SetItem(Index: Integer; const Value: TXlsxSharedStrings);
  public
    function Add: TXlsxSharedStrings;
    property Items[Index: Integer]: TXlsxSharedStrings read GetItem write SetItem; default;
  end;

  TXlsxMerge = class(TCollectionItem)
  private
//    FRange: string;
    FRange: qiString;
    FValue: qiString;
    FBeginRow: Integer;
    FBeginCol: Integer;
    FEndRow: Integer;
    FEndCol: Integer;
//    FFirstCellName: string;
    FFirstCellName: qiString;
//    procedure SetRange(const Value: string);
    procedure SetRange(const Value: qiString);
  public
//    property Range: string read FRange write SetRange;
    property Range: qiString read FRange write SetRange;
    property Value: qiString read FValue write FValue;
//    property FirstCellName: AnsiString read FFirstCellName;
    property FirstCellName: qiString read FFirstCellName;
    property BeginRow: Integer read FBeginRow;
    property BeginCol: Integer read FBeginCol;
    property EndRow: Integer read FEndRow;
    property EndCol: Integer read FEndCol;
  end;

  TXlsxMergeList = class(TCollection)
  private
    function GetItem(Index: Integer): TXlsxMerge;
    procedure SetItem(Index: Integer; const Value: TXlsxMerge);
  public
    function Add: TXlsxMerge;
    property Items[Index: Integer]: TXlsxMerge read GetItem write SetItem; default;
  end;

  TXlsxCell = class(TCollectionItem)
  private
    FName: string;
    FRow: Integer;
    FCol: Integer;
    FValue: qiString;
    FFormula: string;
    FIsFormulaExist: Boolean;
    FIsMerge: Boolean;
    procedure SetFormula(const Value: string);
    function GetName: string;
    procedure SetName(const Value: string);
  public
    constructor Create(Collection: TCollection); override;

    property Name: string read GetName write SetName;
    property Value: qiString read FValue write FValue;
    property Row: Integer read FRow write FRow;
    property Col: Integer read FCol write FCol;
    property IsMerge: Boolean read FIsMerge write FIsMerge;
    property Formula: string read FFormula write SetFormula;
    property IsFormulaExist: Boolean read FIsFormulaExist;
  end;

  TXlsxCellList = class(TCollection)
  private
    function GetItem(Index: Integer): TXlsxCell;
    procedure SetItem(Index: Integer; const Value: TXlsxCell);
  public
    function Add: TXlsxCell;
    property Items[Index: Integer]: TXlsxCell read GetItem write SetItem; default;
  end;

  TXlsxWorkSheet = class(TCollectionItem)
  private
    FName: string;
    FSheetID: integer;
    FColCount: Integer;
    FRowCount: Integer;
    FCells: TXlsxCellList;
    FDataCells: TqiStringGrid;
    FMergeCells: TXlsxMergeList;
    FIsHidden: boolean;
    procedure SetSheetID(const Value: integer);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;

    procedure FillMerge(Cell: TXlsxCell);
    procedure LoadDataCells;
    property Name: string read FName write FName;
    property SheetID: integer read FSheetID write SetSheetID;
    property ColCount: Integer read FColCount write FColCount;
    property RowCount: Integer read FRowCount write FRowCount;
    property Cells: TXlsxCellList read FCells;
    property DataCells: TqiStringGrid read FDataCells;
    property MergeCells: TXlsxMergeList read FMergeCells;
    property IsHidden: boolean read FIsHidden write FIsHidden;
  end;

  TXlsxWorkSheetList = class(TCollection)
  private
    function GetItems(Index: integer): TXlsxWorkSheet;
    procedure SetItems(Index: integer; Value: TXlsxWorkSheet);
  public
    function Add: TXlsxWorkSheet;
    property Items[Index: integer]: TXlsxWorkSheet read GetItems
      write SetItems; default;

    function GetFirstSheet: TXlsxWorkSheet;
    function GetSheetByName(Name: qiString): TXlsxWorkSheet;
    function GetSheetByID(id: integer): TXlsxWorkSheet;
  end;

  TXlsxWorkbook = class
  private
    FWorkDir: string;
    FXMLDoc: IXMLDOMDocument;
    FWorkSheets: TXlsxWorkSheetList;
    FSharedStrings: TXlsxSharedStringList;
    FStyles: TXlsxStyleList;
    FLoadHiddenSheets: Boolean;
    FNeedFillMerge: Boolean;
    procedure LoadSharedStrings;
    procedure LoadStyles;
    procedure SetWorkSheets;
    procedure LoadWorkSheets;
    procedure SetDataCells;
    procedure LoadSheet(SheetFile: string);
  private
    property Styles: TXlsxStyleList read FStyles;
  public
    constructor Create;
    destructor Destroy; override;
    
    procedure Load;
    property SharedStrings: TXlsxSharedStringList read FSharedStrings;
    property CurrFolder: string read FWorkDir write FWorkDir;
    property WorkSheets: TXlsxWorkSheetList read FWorkSheets;
    property LoadHiddenSheets: Boolean read FLoadHiddenSheets write FLoadHiddenSheets;
    property NeedFillMerge: Boolean read FNeedFillMerge write FNeedFillMerge;
  end;

  TXlsxFile = class(TBaseDocumentFile)
  private
    FWorkbook: TXlsxWorkbook;
  protected
    procedure LoadXML(CurrFolder: qiString); override;
  public
    constructor Create; override;
    destructor Destroy; override;
    property Workbook: TXlsxWorkbook read FWorkbook;
  end;
  
  TQImport3Xlsx = class(TQImport3)
  private
    FXlsxFile: TXlsxFile;
    FCounter: Integer;
    FSheetName: string;
    FLoadHiddenSheet: Boolean;
    FNeedFillMerge: Boolean;
    procedure SetSheetName(const Value: string);
    procedure SetLoadHiddenSheet(const Value: Boolean);
    procedure SetNeedFillMerge(const Value: Boolean);
  protected
    procedure BeforeImport; override;
    procedure StartImport; override;
    function CheckCondition: Boolean; override;
    function Skip: Boolean; override;
    procedure ChangeCondition; override;
    procedure FinishImport; override;
    procedure AfterImport; override;
    procedure FillImportRow; override;
    function ImportData: TQImportResult; override;
    procedure DoLoadConfiguration(IniFile: TIniFile); override;
    procedure DoSaveConfiguration(IniFile: TIniFile); override;
  public                                           
    constructor Create(AOwner: TComponent); override;
  published
    property FileName;
    property SkipFirstRows default 0;
    property SheetName: string read FSheetName write SetSheetName;
    property LoadHiddenSheet: boolean read FLoadHiddenSheet
      write SetLoadHiddenSheet default False;
    property NeedFillMerge: Boolean read FNeedFillMerge
      write SetNeedFillMerge default False;
  end;

function GetColIdFromString(Index: string): Integer;
function GetColIdFromColIndex(ColIndex: string): Integer;

{$ENDIF}
{$ENDIF}

implementation

{$IFDEF XLSX}
{$IFDEF VCL6}

uses
  StrUtils;

function GetColIdFromColIndex(ColIndex: string): Integer;
begin
  Result := 0;
  if ColIndex <> '' then
    case Length(ColIndex) of
      1: Result := Ord(ColIndex[1]) - 64;
      2: Result := (Ord(ColIndex[1]) - 64)*26 + (Ord(ColIndex[2]) - 64);
      3: Result := (Ord(ColIndex[1]) - 64)*676 + ((Ord(ColIndex[2]) - 64)*26 + Ord(ColIndex[3]) - 64);
    end;
end;

function GetColIdFromString(Index: string): Integer;
var
  ColValue: string;
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(Index) do
    if QImport3Common.CharInSet(Index[i],['0'..'9']) then
    begin
      ColValue := Copy(Index, 0, i - 1);
      if ColValue <> '' then
        case Length(ColValue) of
          1: Result := Ord(ColValue[1]) - 64;
          2: Result := (Ord(ColValue[1]) - 64)*26 + (Ord(ColValue[2]) - 64);
          3: Result := (Ord(ColValue[1]) - 64)*676 + ((Ord(ColValue[2]) - 64)*26 + Ord(ColValue[3]) - 64);
        end;
      Break;
    end;
end;

function GetRowIdFromString(Index: string): Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 1 to Length(Index) do
    if QImport3Common.CharInSet(Index[i], ['0'..'9']) then
    begin
      Result := StrToIntDef(Copy(Index, i, Length(Index)), 0);
      Break;
    end;
end;

{ TXlsxStyleList }

function TXlsxStyleList.GetItem(Index: Integer): TXlsxStyle;
begin
  Result := TXlsxStyle(inherited Items[Index]);
end;

procedure TXlsxStyleList.SetItem(Index: Integer; const Value: TXlsxStyle);
begin
  inherited Items[Index] := Value;
end;

function TXlsxStyleList.Add: TXlsxStyle;
begin
  Result := TXlsxStyle(inherited Add);
end;

{ TXlsxSharedStringList }

function TXlsxSharedStringList.GetItem(Index: Integer): TXlsxSharedStrings;
begin
  Result := TXlsxSharedStrings(inherited Items[Index]);
end;

procedure TXlsxSharedStringList.SetItem(Index: Integer; const Value: TXlsxSharedStrings);
begin
  inherited Items[Index] := Value;
end;

function TXlsxSharedStringList.Add: TXlsxSharedStrings;
begin
  Result := TXlsxSharedStrings(inherited Add);
end;

{ TXlsxMerge }

//procedure TXlsxMerge.SetRange(const Value: string);
procedure TXlsxMerge.SetRange(const Value: qiString);
begin
  if FRange <> Value then
  begin
    FRange := Value;
    FFirstCellName := Copy(Value, 1, Pos(':', Value) - 1);
    FBeginCol := GetColIdFromString(FFirstCellName);
    FBeginRow := GetRowIdFromString(FFirstCellName);
    FEndCol := GetColIdFromString(Copy(Value, Pos(':', Value)+ 1, Length(Value)));
    FEndRow := GetRowIdFromString(Copy(Value, Pos(':', Value)+ 1, Length(Value)));
  end;
end;

{ TXlsxMergeList }

function TXlsxMergeList.GetItem(Index: Integer): TXlsxMerge;
begin
  Result := TXlsxMerge(inherited Items[Index]);
end;

procedure TXlsxMergeList.SetItem(Index: Integer;
  const Value: TXlsxMerge);
begin
  inherited Items[Index] := Value;
end;

function TXlsxMergeList.Add: TXlsxMerge;
begin
  Result := TXlsxMerge(inherited Add);
end;

{ TXlsxCell }

constructor TXlsxCell.Create(Collection: TCollection);
begin
  inherited;
  FCol := 0;
  FRow := 0;
  FName := '';
  FValue := '';
  FIsMerge := False;
  FFormula := '';
  FIsFormulaExist := False;
end;

procedure TXlsxCell.SetFormula(const Value: string);
begin
  if FFormula <> Value then
  begin
    FFormula := Value;
    FIsFormulaExist := True;
  end;
end;

function TXlsxCell.GetName: string;
begin
  if not Self.IsMerge then
    Result := FName
  else
    Result := 'Merge';
end;

procedure TXlsxCell.SetName(const Value: string);
begin
  if not Self.IsMerge then
    FName := Value;
end;

{ TXlsxCellList }

function TXlsxCellList.Add: TXlsxCell;
begin
  Result := TXlsxCell(inherited Add);
end;

function TXlsxCellList.GetItem(Index: Integer): TXlsxCell;
begin
  Result := TXlsxCell(inherited Items[Index]);
end;

procedure TXlsxCellList.SetItem(Index: Integer; const Value: TXlsxCell);
begin
  inherited Items[Index] := Value;
end;

{ TXlsxWorkSheet }

procedure TXlsxWorkSheet.SetSheetID(const Value: integer);
const
  sSheetIDCheck = 'Sheet ID must be > 0!';
begin
  if Value < 1 then
    raise Exception.Create(sSheetIDCheck);

  if FSheetID <> Value then
    FSheetID := Value;
end;

constructor TXlsxWorkSheet.Create(Collection: TCollection);
begin
  inherited;
  FColCount := 0;
  FRowCount := 0;
  FIsHidden := False;
  FCells := TXlsxCellList.Create(TXlsxCell);
  FMergeCells := TXlsxMergeList.Create(TXlsxMerge);
  FDataCells := TqiStringGrid.Create(nil);
end;

destructor TXlsxWorkSheet.Destroy;
begin
  FCells.Free;
  FMergeCells.Free;
  FDataCells.Free;
  inherited;
end;

procedure TXlsxWorkSheet.FillMerge(Cell: TXlsxCell);
var
  i: Integer;
begin
  for i := 0 to FMergeCells.Count - 1 do
    if (Cell.Row in [FMergeCells[i].BeginRow..FMergeCells[i].EndRow]) and
      (Cell.Col in [FMergeCells[i].BeginCol..FMergeCells[i].EndCol]) and
      (not ((Cell.Row = FMergeCells[i].BeginRow) and (Cell.Col = FMergeCells[i].BeginCol)))
    then Cell.Value := FMergeCells[i].Value;
end;

procedure TXlsxWorkSheet.LoadDataCells;
var
  i: Integer;
begin
  FDataCells.ColCount := FColCount;
  FDataCells.RowCount := FRowCount;
  for i := 0 to FCells.Count - 1 do
    FDataCells.Cells[FCells[i].Col - 1, Cells[i].Row - 1] := Cells[i].Value;
end;

{ TXlsxWorkSheetList }

function TXlsxWorkSheetList.GetItems(Index: integer): TXlsxWorkSheet;
begin
  Result := TXlsxWorkSheet(inherited Items[Index]);
end;

procedure TXlsxWorkSheetList.SetItems(Index: integer;
  Value: TXlsxWorkSheet);
begin
  inherited Items[Index] := Value;
end;

function TXlsxWorkSheetList.Add: TXlsxWorkSheet;
begin
  Result := TXlsxWorkSheet(inherited Add);
end;

function TXlsxWorkSheetList.GetFirstSheet: TXlsxWorkSheet;
const
  sSheetCountMustBeMore0 = 'Sheets Count must be > 0!';
begin
  if Self.Count > 0 then
    Result := Items[0]
  else
    raise Exception.Create(sSheetCountMustBeMore0);
end;

function TXlsxWorkSheetList.GetSheetByName(
  Name: qiString): TXlsxWorkSheet;
var
  i: Integer;
begin
  Result := nil;
  if Name = qiString('') then
    Result := GetFirstSheet
  else