⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 qimport3ods.pas

📁 Advanced Data Import Component Suite for Borland Delphi and C++ Builder allows you to import your da
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit QImport3ODS;

{$I QImport3VerCtrl.Inc}

interface

{$IFDEF ODS}
{$IFDEF VCL6}

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

type
  TODSCell = class(TCollectionItem)
  private
    FRow: Integer;
    FCol: Integer;
    FValue: qiString;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Value: qiString read FValue write FValue;
    property Row: Integer read FRow write FRow;
    property Col: Integer read FCol write FCol;
  end;

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

  TODSSpreadSheet = class(TCollectionItem)
  private
    FName: AnsiString;
    FColCount: Integer;
    FRowCount: Integer;
    FCells: TODSCellList;
    FDataCells: TqiStringGrid;
    FX: Integer;
    FY: Integer;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure LoadDataCells;
    property Cells: TODSCellList read FCells;
    property ColCount: Integer read FColCount write FColCount;
    property RowCount: Integer read FRowCount write FRowCount;
    property X: Integer read FX write FX;
    property Y: Integer read FY write FY;
    property Name: AnsiString read FName write FName;
    property DataCells: TqiStringGrid read FDataCells;
  end;

  TODSSpreadSheetList = class(TCollection)
  private
    function GetItems(Index: integer): TODSSpreadSheet;
    procedure SetItems(Index: integer; Value: TODSSpreadSheet);
  public
    function Add: TODSSpreadSheet;
    function GetSheetByName(Name: AnsiString): TODSSpreadSheet;
    property Items[Index: integer]: TODSSpreadSheet read GetItems
      write SetItems; default;
  end;

  TODSWorkbook = class
  private
    FWorkDir: qiString;
    FileName: qiString;
    FSpreadSheets: TODSSpreadSheetList;
    FXMLDoc: IXMLDOMDocument;
    FIsNotExpanding: Boolean;

    procedure SetSpreadSheets;
    procedure FindTables(NameOfFile: qiString);
    procedure ParseTable(Table: TODSSpreadSheet; Nodes: IXMLDOMNodeList;
      NumbOfRepColumns, NumbOfRepRows: Integer; IsSpanning: Boolean);
    procedure ExpandRowsNCols(Table: TODSSpreadSheet;
      ExpandValue: qiString;
      NumbOfRepRows, NumbOfRepColumns: Integer; IsSpanning: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Load;

    property WorkDir: qiString read FWorkDir write FWorkDir;
    property SpreadSheets: TODSSpreadSheetList read FSpreadSheets;
    property IsNotExpanding: Boolean read FIsNotExpanding write FIsNotExpanding;
  end;

  TODSFile = class(TBaseDocumentFile)
    private
      FWorkbook: TODSWorkbook;
    protected
      procedure LoadXML(WorkDir: qiString); override;
    public
      constructor Create; override;
      destructor Destroy; override;

      property Workbook: TODSWorkbook read FWorkbook;
    end;

  TQImport3ODS = class(TQImport3)
  private
    FODSFile: TODSFile;
    FCounter: Integer;
    FSheetName: AnsiString;
    FNotExpandMergedValue: Boolean;
    procedure SetSheetName(const Value: AnsiString);
    procedure SetExpandFlag(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: AnsiString read FSheetName write SetSheetName;
    property NotExpandMergedValue: Boolean read FNotExpandMergedValue
      write SetExpandFlag default true;
  end;

{$ENDIF}
{$ENDIF}

implementation

{$IFDEF ODS}
{$IFDEF VCL6}

uses
  EmsWideStrUtils;

{ TODSCell }

constructor TODSCell.Create(Collection: TCollection);
begin
  inherited;
  FValue := '';
  FCol := 0;
  FRow := 0;
end;

destructor TODSCell.Destroy;
begin
  inherited;
end;

{ TODSCellList }

function TODSCellList.Add: TODSCell;
begin
  Result := TODSCell(inherited Add);
end;

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

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

{ TODSSpreadSheet }

constructor TODSSpreadSheet.Create(Collection: TCollection);
begin
  inherited;
  FColCount := 0;
  FRowCount := 0;
  FX := -1;
  FY := -1;
  FCells := TODSCellList.Create(TODSCell);
  FDataCells := TqiStringGrid.Create(nil);
end;

destructor TODSSpreadSheet.Destroy;
begin
  FCells.Free;
  FDataCells.Free;
  inherited;
end;

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

{ TODSSpreadSheetList }

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

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

function TODSSpreadSheetList.Add: TODSSpreadSheet;
begin
  Result := TODSSpreadSheet(inherited Add);
end;

function TODSSpreadSheetList.GetSheetByName(Name: AnsiString): TODSSpreadSheet;
var
  i: Integer;
begin
  Result := nil;
  for i := 0 to Self.Count - 1 do
    if (UpperCase(Items[i].Name) = UpperCase(Name)) then
    begin
      Result := Items[i];
      Break;
    end;
end;

{ TODSWorkbook }

procedure TODSWorkBook.FindTables(NameOfFile: qiString);
var
  TableNodes: IXMLDOMNodeList;
  I: Integer;
  NumberOfSprSh: Integer;
begin
  NumberOfSprSh := -1;
  FXMLDoc.load(NameOfFile);
  TableNodes := FXMLDoc.selectNodes('//table:table');
  for I := 0 to TableNodes.length - 1 do
  begin
   if not
      assigned(TableNodes[I].attributes.getNamedItem('table:is-sub-table')) then
    begin
      FSpreadSheets.Add;
      Inc(NumberOfSprSh);
      FSpreadSheets[NumberOfSprSh].FName := AnsiString(
        TableNodes[I].attributes.getNamedItem('table:name').nodeValue);
      ParseTable(FSpreadSheets[NumberOfSprSh], TableNodes[I].childNodes, 0, 0, false);
      FSpreadSheets[NumberOfSprSh].LoadDataCells;
    end;
  end;
  if TableNodes.length = 0 then
    raise Exception.Create('No spreadsheets were found');
end;

procedure TODSWorkBook.ParseTable(Table: TODSSpreadSheet; Nodes: IXMLDOMNodeList;
  NumbOfRepColumns, NumbOfRepRows: Integer; IsSpanning: Boolean);
var
  I: Integer;
  NORR, NORC: Integer;
  IsSp: Boolean;
  TempCell: TODSCell;

  function CheckNotEmptySequence(Nds: IXMLDOMNodeList; start: Integer): Boolean;
  var
    j: Integer;
  begin
    Result := false;
    for j := start to Nds.length - 1 do
    begin
      if Nodes[j].hasChildNodes then
        Result := (Nds[j].childNodes.length > 1)
          or Nds[j].childNodes[0].hasChildNodes;
      if Result then
        break;
    end;
  end;

begin
  NORC := NumbOfRepColumns;
  NORR := NumbOfRepRows;
  IsSp := IsSpanning;
  for I := 0 to Nodes.length - 1 do
  begin
    NumbOfRepColumns := NORC;
    NumbOfRepRows := NORR;
    IsSpanning := IsSp;
    if Nodes[I].NodeName <> '#text' then
    begin
      if Nodes[I].NodeName = 'table:table-row' then
      begin
        Table.Y := Table.Y + 1;
        Table.X := -1;
        if not CheckNotEmptySequence(Nodes, i) then
          break;
        if assigned(Nodes[I].attributes.getNamedItem('table:number-rows-repeated')) then
          NumbOfRepRows :=
            Nodes[I].attributes.getNamedItem('table:number-rows-repeated').nodeValue - 1;
        if Table.Y + 1 >
          Table.RowCount then
            Table.RowCount := Table.Y + 1;
      end;
      if (Nodes[I].NodeName = 'table:table-cell')
        or (Nodes[I].NodeName = 'table:covered-table-cell') then
      begin
        Table.X := Table.X + 1;
        if Table.X + 1 > Table.ColCount then
          Table.ColCount := Table.X + 1;
        if Assigned(Nodes[I].attributes.getNamedItem('table:number-columns-repeated')) then
        NumbOfRepColumns :=
           Nodes[I].attributes.getNamedItem('table:number-columns-repeated').nodeValue - 1;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -