Merge branch 'ImportXlsx'

Forms/MainFrm.pas

@@ -555,7 +555,7 @@ var
 begin
   if HintAndImportTypeSelect(bWithLevelCode, bWithoutGclBills) then
   begin
-    if SelectFile(sFileName, '.xls') then
+    if SelectExcelFile(sFileName) then
     begin
       Importor := Tdei_CustomBills.Create(CurProjectFrame.ProjectData);
       try
@@ -671,7 +671,7 @@ var
   sFileName: string;
   Importor: TBillsPriceExcelImport;
 begin
-  if SelectFile(sFileName, '.xls') then
+  if SelectExcelFile(sFileName) then
   begin
     Importor := TBillsPriceExcelImport.Create(CurProjectFrame.ProjectData);
     try
@@ -687,7 +687,7 @@ var
   sFileName: string;
   Importor: TDealBillsExcelImport;
 begin
-  if SelectFile(sFileName, '.xls') then
+  if SelectExcelFile(sFileName) then
   begin
     Importor := TDealBillsExcelImport.Create(CurProjectFrame.ProjectData);
     try
@@ -722,7 +722,7 @@ var
   sFileName: string;
   Exportor: TIDTreeExcelExportor;
 begin
-  if SaveFile(sFileName, '.xls') then
+  if SaveExcelFile(sFileName) then
   begin
     Exportor := TIDTreeExcelExportor.Create;
     try
@@ -809,7 +809,7 @@ var
   sFileName: string;
   Exportor: TIDTreeExcelExportor;
 begin
-  if SaveFile(sFileName, '.xls') then
+  if SaveExcelFile(sFileName) then
   begin
     Exportor := TIDTreeExcelExportor.Create;
     try

Frames/BillsCompileFme.pas

@@ -414,7 +414,7 @@ var
   sFileName: string;
   ExcelExportor: TExcelExportor;
 begin
-  if SaveFile(sFileName, '.xls') then
+  if SaveExcelFile(sFileName) then
   begin
     ExcelExportor := TExcelExportor.Create;
     try
@@ -544,7 +544,7 @@ var
 begin
   if TProjectData(FBillsCompileData.ProjectData).CanInsertNormalBills then
   begin
-    if SelectFile(sFileName, '.xls') then
+    if SelectExcelFile(sFileName) then
     begin
       Importor := TDEI_GclBills.Create(TProjectData(FBillsCompileData.ProjectData));
       try
@@ -629,7 +629,7 @@ var
 begin
   if TProjectData(FBillsCompileData.ProjectData).CanInsertNormalBills then
   begin
-    if SelectFile(sFileName, '.xls') then
+    if SelectExcelFile(sFileName) then
     begin
       Importor := TPlaneFxBillsExcelImport.Create(TProjectData(FBillsCompileData.ProjectData));
       try

Frames/BillsMeasureFme.pas

@@ -271,7 +271,7 @@ var
   sFileName: string;
   ExcelExportor: TExcelExportor;
 begin
-  if SaveFile(sFileName, '.xls') then
+  if SaveExcelFile(sFileName) then
   begin
     ExcelExportor := TExcelExportor.Create;
     try

TenderPartition/tpPartTenderSetFme.pas

@@ -114,7 +114,7 @@ var
   sFileName: string;
   Exportor: TMasterExcelExportor;
 begin
-  if SaveFile(sFileName, '.xls') then
+  if SaveExcelFile(sFileName) then
   begin
     Exportor := TMasterExcelExportor.Create;
     try
@@ -136,7 +136,7 @@ var
   sFileName: string;
   Exportor: TMasterExcelExportor;
 begin
-  if SaveFile(sFileName, '.xls') then
+  if SaveExcelFile(sFileName) then
   begin
     Exportor := TMasterExcelExportor.Create;
     try

Units/Connections.pas

@@ -505,8 +505,10 @@ begin
     end;
   finally
     vCon.Free;
-    DeleteFile(PChar(sConnectFile));
-    DeleteFile(PChar(sTempFile));
+    if FileExists(sConnectFile) then
+      DeleteFile(PChar(sConnectFile));
+    if FileExists(sConnectFile) then
+      DeleteFile(PChar(sTempFile));
   end;
 end;
 

Units/DealBillsExcelImport.pas

@@ -4,7 +4,7 @@ unit DealBillsExcelImport;
 interface
 
 uses
-  DetailExcelImport, ProjectData, Classes, sdDB;
+  DetailExcelImport, ProjectData, Classes, sdDB, OExport;
 
 type
   TDealBill = class
@@ -57,8 +57,8 @@ type
 
     FCurRow: Integer;
 
-    function LoadColumnsFromHead: Boolean;
-    procedure LoadDealBills;
+    function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
+    procedure LoadDealBills(ASheet: TExportWorkSheet);
     procedure WriteDealBills;
   protected
     procedure BeginImport; override;
@@ -102,18 +102,19 @@ end;
 
 procedure TDealBillsExcelImport.Import;
 begin
-  FCurRow := 1;
-  if LoadColumnsFromHead then
+  FCurRow := 0;
+  if LoadColumnsFromHead(OExport.OpenWorkSheet) then
   begin
-    LoadDealBills;
+    LoadDealBills(OExport.OpenWorkSheet);
     WriteDealBills;
   end
   else
     ErrorMessage('导入的Excel格式有误！');
 end;
 
-function TDealBillsExcelImport.LoadColumnsFromHead: Boolean;
+function TDealBillsExcelImport.LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
 var
+  vRow: TExportRow;
   iCol: Integer;
   sColName: string;
 begin
@@ -126,11 +127,12 @@ begin
   FQuantityCol := -1;
   FTotalPriceCol := -1;
 
-  while (not Result) and (FCurRow <= Excel.XlsFile.MaxRow) do
+  while (not Result) and (FCurRow < ASheet.Rows.Count) do
   begin
-    for iCol := 1 to Excel.XlsFile.MaxCol do
+    vRow := ASheet.Rows[FCurRow];
+    for iCol := 0 to vRow.Cells.Count - 1 do
     begin
-      sColName := GetCellValue(Excel.XlsFile, FCurRow, iCol);
+      sColName := GetCellTrimStr(vRow, iCol);
       sColName := StringReplace(sColName, ' ', '', [rfReplaceAll]);
 
       if SameText(sColName, '清单编号') or (Pos('子目号', sColName) > 0) then
@@ -153,7 +155,7 @@ begin
   end;
 end;
 
-procedure TDealBillsExcelImport.LoadDealBills;
+procedure TDealBillsExcelImport.LoadDealBills(ASheet: TExportWorkSheet);
 
   function CheckIsBillsCode(ACode: string): Boolean;
   const
@@ -183,12 +185,14 @@ procedure TDealBillsExcelImport.LoadDealBills;
   end;
 
 var
+  vRow: TExportRow;
   sB_Code, sFilterB_Code: string;
   vDealBill: TDealBill;
 begin
-  while (FCurRow <= Excel.XlsFile.MaxRow) do
+  while (FCurRow < ASheet.Rows.Count) do
   begin
-    sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
+    vRow := ASheet.Rows[FCurRow];
+    sB_Code := GetCellTrimStr(vRow, FB_CodeCol);
     sFilterB_Code := FilterBillsCode(sB_Code);
     if (sFilterB_Code <> '')then
     begin
@@ -196,11 +200,11 @@ begin
       begin
         vDealBill := TDealBill.Create;
         vDealBill.B_Code := sB_Code;
-        vDealBill.Name := GetCellTrimStr(Excel.XlsFile, FCurRow, FNameCol);
-        vDealBill.Units := GetCellTrimStr(Excel.XlsFile, FCurRow, FUnitsCol);
-        vDealBill.Price := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
-        vDealBill.Quantity := GetCellFloat(Excel.XlsFile, FCurRow, FQuantityCol);
-        vDealBill.TotalPrice := GetCellFloat(Excel.XlsFile, FCurRow, FTotalPriceCol);
+        vDealBill.Name := GetCellTrimStr(vRow, FNameCol);
+        vDealBill.Units := GetCellTrimStr(vRow, FUnitsCol);
+        vDealBill.Price := GetCellFloat(vRow, FPriceCol);
+        vDealBill.Quantity := GetCellFloat(vRow, FQuantityCol);
+        vDealBill.TotalPrice := GetCellFloat(vRow, FTotalPriceCol);
         FDealBills.AddDealBill(vDealBill);
       end;
     end;

Units/DetailExcelImport.pas

@@ -4,19 +4,18 @@ interface
 
 uses
   Classes, ProjectData, ScXlsOutput, MCacheTree, XLSAdapter, sdDB,
-  Variants, Forms, Controls;
+  Variants, Forms, Controls, OExport, OExport_VclForms;
 
 type
   TDetailExcelImport = class
   private
     FProjectData: TProjectData;
-    FTempFile: string;
-    FExcel: TXlsOutPut; 
+    FOExport: TOExport;
   protected
-    function GetCellValue(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
-    function GetCellValueFormat(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
-    function GetCellTrimStr(AXlsFile: TXLSFile; ARow, ACol: Integer): string;
-    function GetCellFloat(AXlsFile: TXLSFile; ARow, ACol: Integer): Double;
+    function GetCellStr(ASheet: TExportWorkSheet; ARow, ACol: Integer): string; overload;
+    function GetCellStr(ARow: TExportRow; ACol: Integer): string; overload;
+    function GetCellTrimStr(ARow: TExportRow; ACol: Integer): string;
+    function GetCellFloat(ARow: TExportRow; ACol: Integer): Double;
 
     procedure BeginImport; virtual; abstract;
     procedure EndImport; virtual; abstract;
@@ -29,7 +28,7 @@ type
     procedure ImportFile(const AFileName: string);
 
     property ProjectData: TProjectData read FProjectData;
-    property Excel: TXlsOutPut read FExcel;
+    property OExport: TOExport read FOExport;
   end;
 
   // 平面分项清单格式导入，导入至某项目节节点之下
@@ -56,18 +55,18 @@ type
     FDrawingCol: Integer;
     FMemoCol: Integer;
 
-    procedure LoadXmjLevel1(AXlsFile: TXLSFile);
-    procedure LoadXmjLevel2(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
-    procedure LoadXmjLevel3(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
-    procedure LoadXmjLevel4(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
-    procedure LoadXmjLevel5(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
-    procedure LoadXmjLevel6(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
-    procedure LoadXmjLevel7(AXlsFile: TXLSFile; AParent: TBillsCacheNode);
+    procedure LoadXmjLevel1(ASheet: TExportWorkSheet);
+    procedure LoadXmjLevel2(ASheet: TExportWorkSheet; AParent: TBillsCacheNode);
+    procedure LoadXmjLevel3(ASheet: TExportWorkSheet; AParent: TBillsCacheNode);
+    procedure LoadXmjLevel4(ASheet: TExportWorkSheet; AParent: TBillsCacheNode);
+    procedure LoadXmjLevel5(ASheet: TExportWorkSheet; AParent: TBillsCacheNode);
+    procedure LoadXmjLevel6(ASheet: TExportWorkSheet; AParent: TBillsCacheNode);
+    procedure LoadXmjLevel7(ASheet: TExportWorkSheet; AParent: TBillsCacheNode);
 
-    procedure LoadBillsNode(AXlsFile: TXLSFile; AXmj: TBillsCacheNode);
+    procedure LoadBillsNode(ASheet: TExportWorkSheet; AXmj: TBillsCacheNode);
 
-    function LoadColumnsFromHead(AXlsFile: TXlsFile): Boolean;
-    procedure LoadFxBills(AXlsFile: TXLSFile);
+    function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
+    procedure LoadFxBills(ASheet: TExportWorkSheet);
 
     procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode);
     procedure WriteNodes(ADataSet: TsdDataSet);
@@ -92,9 +91,9 @@ type
     procedure BeginImport; override;
     procedure EndImport; override;
 
-    procedure LoadColumnsFromHead;
+    procedure LoadColumnsFromHead(ASheet: TExportWorkSheet);
     procedure UpdateBillsPrice(const AB_Code: string; APrice: Double);
-    procedure ImportBillsPriceData;
+    procedure ImportBillsPriceData(ASheet: TExportWorkSheet);
     procedure Import; override;
   end;
 
@@ -109,105 +108,53 @@ uses
 constructor TDetailExcelImport.Create(AProjectData: TProjectData);
 begin
   FProjectData := AProjectData;
-  FTempFile := GetTempFileName;
+  FOExport := TOExport.Create;
+  FOExport.UseProgress := False;
 end;
 
 destructor TDetailExcelImport.Destroy;
 begin
-  if FileExists(FTempFile) then
-    DeleteFile(FTempFile);
+  FOExport.Free;
   inherited;
 end;
 
-function TDetailExcelImport.GetCellFloat(AXlsFile: TXLSFile; ARow,
+function TDetailExcelImport.GetCellFloat(ARow: TExportRow;
   ACol: Integer): Double;
 begin
-  Result := StrToFloatDef(GetCellTrimStr(AXlsFile, ARow, ACol), 0);
+  Result := StrToFloatDef(GetCellTrimStr(ARow, ACol), 0);
 end;
 
-function TDetailExcelImport.GetCellTrimStr(AXlsFile: TXLSFile; ARow,
+function TDetailExcelImport.GetCellStr(ARow: TExportRow;
   ACol: Integer): string;
 begin
-  Result := Trim(GetCellValue(AXlsFile, ARow, ACol));
+  if (ACol < ARow.Cells.Count) and (ACol >= 0) then
+    Result := ARow.Cells[ACol].SqlText
+  else
+    Result := '';
 end;
 
-function TDetailExcelImport.GetCellValue(AXlsFile: TXLSFile; ARow,
-  ACol: Integer): string;
-var
-  xlsCell: TXlsCellValue;
+function TDetailExcelImport.GetCellStr(ASheet: TExportWorkSheet; ARow, ACol: Integer): string;
 begin
-  Result := '';
-  if not Assigned(AXlsFile) or (ARow = -1) or (ACol = -1) then Exit;
-  xlsCell := AXlsFile.CellValueX[ARow, ACol];
-  Result := VarToStrDef(xlsCell.Value, '');
+  if ARow < ASheet.Rows.Count then
+    Result := GetCellStr(ASheet.Rows[ARow], ACol)
+  else
+    Result := '';
 end;
 
-function TDetailExcelImport.GetCellValueFormat(AXlsFile: TXLSFile; ARow,
+function TDetailExcelImport.GetCellTrimStr(ARow: TExportRow;
   ACol: Integer): string;
-
-  function GetDigit(AFormat: WideString): Integer;
-  var
-    I: Integer;
-    bDigit: Boolean;
-  begin
-    Result := 0;
-    bDigit := False;
-    for I := 1 to Length(AFormat) do
-    begin
-      if AFormat[I] = '.' then
-      begin
-        if bDigit then Break
-        else bDigit := True;
-      end
-      else if AFormat[I] = ';' then Break
-      else if bDigit and (AFormat[I] = '0') then
-        Dec(Result);
-    end;
-  end;
-
-  function FormatNum(AValue: Variant; AFormat: WideString): string;
-  begin
-    Result := AValue;
-    if not VarIsNull(AValue) then
-    begin
-      if CheckNumeric(Result) then
-      begin
-        if Pos('%', AFormat) <> 0 then AValue := AValue * 100;
-        if AFormat <> '' then
-          Result := FloatToStr(AdvRoundTo(AValue, GetDigit(AFormat)))
-        else
-          Result := FloatToStr(AdvRoundTo(AValue, -2));
-        if Pos('%', AFormat) <> 0 then Result := Result + '%';
-        if AValue = '0' then Result := '';
-      end;
-    end;
-  end;
-
-var
-  xlsCell: TXlsCellValue;
-  FlxFormat: TFlxFormat;
 begin
-  Result := '';
-  if not Assigned(AXlsFile) or (ARow = -1) or (ACol = -1) then Exit;
-  xlsCell := AXlsFile.GetCellDataX(ARow, ACol);
-  Result := xlsCell.Value;
-  if xlsCell.XF <> -1 then
-  begin
-    FlxFormat := AXlsFile.FormatList[xlsCell.XF];
-    Result := FormatNum(xlsCell.Value, FlxFormat.Format);
-  end;
+  Result := Trim(GetCellStr(ARow, ACol));
 end;
 
 procedure TDetailExcelImport.ImportFile(const AFileName: string);
 begin
-  CopyFileOrFolder(AFileName, FTempFile);
-  FExcel := TXlsOutPut.Create(FTempFile);
   BeginImport;
   try
+    FOExport.LoadFromFile(AFileName);
     Import;
   finally
     EndImport;
-    FExcel.Free;
   end;
 end;
 
@@ -215,27 +162,29 @@ end;
 
 procedure TPlaneFxBillsExcelImport.Import;
 begin
-  FCurRow := 1;
-  if LoadColumnsFromHead(FExcel.XlsFile) then
+  FCurRow := 0;
+  if LoadColumnsFromHead(FOExport.OpenWorkSheet) then
   begin
-    LoadFxBills(FExcel.XlsFile);
+    LoadFxBills(FOExport.OpenWorkSheet);
     WriteNodes(FProjectData.BillsData.sddBills);
   end
   else
     ErrorMessage('导入的Excel格式有误！');
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadBillsNode(AXlsFile: TXLSFile;
+procedure TPlaneFxBillsExcelImport.LoadBillsNode(ASheet: TExportWorkSheet;
   AXmj: TBillsCacheNode);
 var
+  vRow: TExportRow;
   sB_Code, sName, sUnits: string;
   vGclNode: TBillsCacheNode;
   fPrice: Double;
 begin
-  sB_Code := Trim(GetCellValue(AXlsFile, FCurRow, FB_CodeCol));
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FNameCol));
-  sUnits := Trim(GetCellValue(AXlsFile, FCurRow, FUnitCol));
-  fPrice := StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FPriceCol), 0);
+  vRow := ASheet.Rows[FCurRow];
+  sB_Code := Trim(GetCellStr(vRow, FB_CodeCol));
+  sName := Trim(GetCellStr(vRow, FNameCol));
+  sUnits := Trim(GetCellStr(vRow, FUnitCol));
+  fPrice := StrToFloatDef(GetCellStr(vRow, FPriceCol), 0);
   if sB_Code <> '' then
   begin
     vGclNode := FCacheTree.FindGclChild(AXmj, sB_Code, sName, sUnits, fPrice);
@@ -245,20 +194,21 @@ begin
       vGclNode.B_Code := sB_Code;
       vGclNode.Name := sName;
       vGclNode.Units := sUnits;
-      vGclNode.OrgQuantity := StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FQuantityCol), 0);
+      vGclNode.OrgQuantity := StrToFloatDef(GetCellStr(vRow, FQuantityCol), 0);
       vGclNode.Price := fPrice;
-      vGclNode.DrawingCode := Trim(GetCellValue(AXlsFile, FCurRow, FDrawingCol));
-      vGclNode.MemoStr := Trim(GetCellValue(AXlsFile, FCurRow, FMemoCol));
+      vGclNode.DrawingCode := Trim(GetCellStr(vRow, FDrawingCol));
+      vGclNode.MemoStr := Trim(GetCellStr(vRow, FMemoCol));
     end
     else
-      vGclNode.OrgQuantity := vGclNode.OrgQuantity + StrToFloatDef(GetCellValue(AXlsFile, FCurRow, FQuantityCol), 0);
+      vGclNode.OrgQuantity := vGclNode.OrgQuantity + StrToFloatDef(GetCellStr(vRow, FQuantityCol), 0);
   end;
   Inc(FCurRow);
 end;
 
-function TPlaneFxBillsExcelImport.LoadColumnsFromHead(AXlsFile: TXlsFile): Boolean;
+function TPlaneFxBillsExcelImport.LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
 var
   iCol: Integer;
+  vRow: TExportRow;
   sColName: string;
 begin
   Result := False;
@@ -279,11 +229,12 @@ begin
   UpdateProgressHint('正在识别Excel数据格式');
   UpdateProgressPosition(0);
 
-  while not Result and (FCurRow <= AXlsFile.MaxRow) do
+  while not Result and (FCurRow <= ASheet.Rows.Count - 1) do
   begin
-    for iCol := 1 to AXlsFile.MaxCol do
+    vRow := ASheet.Rows[FCurRow];
+    for iCol := 0 to vRow.Cells.Count - 1 do
     begin
-      sColName := Trim(GetCellValue(AXlsFile, FCurRow, iCol));
+      sColName := vRow.Cells[iCol].SqlText;
       if sColName = '第1层' then
         FXmjLevel1Col := iCol
       else if sColName = '第2层' then
@@ -319,273 +270,333 @@ begin
   end;
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadFxBills(AXlsFile: TXLSFile);
+procedure TPlaneFxBillsExcelImport.LoadFxBills(ASheet: TExportWorkSheet);
 var
   iPos: Integer;
 begin
   UpdateProgressHint('正在解析平面台账数据');
-  while FCurRow <= AXlsFile.MaxRow do
+  while FCurRow < ASheet.Rows.Count do
   begin
-    iPos := FCurRow*100 div AXlsFile.MaxRow;
+    iPos := FCurRow * 100 div ASheet.Rows.Count;
     UpdateProgressPosition(iPos);
-    LoadXmjLevel1(AXlsFile);
+    LoadXmjLevel1(ASheet);
   end;
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadXmjLevel1(AXlsFile: TXLSFile);
+procedure TPlaneFxBillsExcelImport.LoadXmjLevel1(ASheet: TExportWorkSheet);
 var
+  vRow: TExportRow;
+  vCell: TExportCell;
   sName: string;
   vXmj: TBillsCacheNode;
   iEndRow: Integer;
 begin
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel1Col));
-  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel1Col] do
-    iEndRow := FCurRow + Bottom - Top;
-
-  if sName <> '' then
+  vRow := ASheet.Rows[FCurRow];
+  if FXmjLevel1Col < vRow.Cells.Count then
   begin
-    vXmj := FCacheTree.FindXmjChild(nil, '', sName);
-    if not Assigned(vXmj) then
-    begin
-      vXmj := FCacheTree.AddNode(nil);
-      vXmj.Name := sName;
-    end;
+    vCell := vRow.Cells[FXmjLevel1Col];
 
-    if FXmjLevel2Col <> -1 then
+    sName := Trim(vCell.SqlText);
+    iEndRow := FCurRow + vCell.RowSpan;
+    if (sName <> '') then
     begin
-      while FCurRow <= iEndRow do
-        LoadXmjLevel2(AXlsFile, vXmj);
+      vXmj := FCacheTree.FindXmjChild(nil, '', sName);
+      if not Assigned(vXmj) then
+      begin
+        vXmj := FCacheTree.AddNode(nil);
+        vXmj.Name := sName;
+      end;
+
+      if FXmjLevel2Col <> -1 then
+      begin
+        while FCurRow < iEndRow do
+          LoadXmjLevel2(ASheet, vXmj);
+      end
+      else
+      begin
+        while FCurRow < iEndRow do
+          LoadBillsNode(ASheet, vXmj);
+      end;
     end
     else
-    begin
-      while FCurRow <= iEndRow do
-        LoadBillsNode(AXlsFile, vXmj);
-    end;
+      Inc(FCurRow);
   end
   else
     Inc(FCurRow);
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadXmjLevel2(AXlsFile: TXLSFile;
+procedure TPlaneFxBillsExcelImport.LoadXmjLevel2(ASheet: TExportWorkSheet;
   AParent: TBillsCacheNode);
 var
+  vRow: TExportRow;
+  vCell: TExportCell;
   sName: string;
   vXmj: TBillsCacheNode;
   iEndRow: Integer;
 begin
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel2Col));
-  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel2Col] do
-    iEndRow := FCurRow + Bottom - Top;
-
-  if sName <> '' then
+  vRow := ASheet.Rows[FCurRow];
+  if FXmjLevel2Col < vRow.Cells.Count then
   begin
-    vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
-    if not Assigned(vXmj) then
-    begin
-      vXmj := FCacheTree.AddNode(AParent);
-      vXmj.Name := sName;
-    end;
+    vCell := vRow.Cells[FXmjLevel2Col];
 
+    sName := Trim(vCell.SqlText);
+    iEndRow := FCurRow + vCell.RowSpan;
 
-    if FXmjLevel3Col <> -1 then
+    if (sName <> '') then
     begin
-      while FCurRow <= iEndRow do
-        LoadXmjLevel3(AXlsFile, vXmj);
+      vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
+      if not Assigned(vXmj) then
+      begin
+        vXmj := FCacheTree.AddNode(AParent);
+        vXmj.Name := sName;
+      end;
+
+      if FXmjLevel3Col <> -1 then
+      begin
+        while FCurRow < iEndRow do
+          LoadXmjLevel3(ASheet, vXmj);
+      end
+      else
+      begin
+        while FCurRow < iEndRow do
+          LoadBillsNode(ASheet, vXmj);
+      end;
     end
     else
     begin
-      while FCurRow <= iEndRow do
-        LoadBillsNode(AXlsFile, vXmj);
+      while FCurRow < iEndRow do
+        LoadBillsNode(ASheet, AParent);
     end;
   end
   else
-  begin
-    while FCurRow <= iEndRow do
-      LoadBillsNode(AXlsFile, AParent);
-  end;
+    Inc(FCurRow);
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadXmjLevel3(AXlsFile: TXLSFile;
+procedure TPlaneFxBillsExcelImport.LoadXmjLevel3(ASheet: TExportWorkSheet;
   AParent: TBillsCacheNode);
 var
+  vRow: TExportRow;
+  vCell: TExportCell;
   sName: string;
   vXmj: TBillsCacheNode;
   iEndRow: Integer;
 begin
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel3Col));
-  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel3Col] do
-    iEndRow := FCurRow + Bottom - Top;
-
-  if sName <> '' then
+  vRow := ASheet.Rows[FCurRow];
+  if FXmjLevel3Col < vRow.Cells.Count then
   begin
-    vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
-    if not Assigned(vXmj) then
-    begin
-      vXmj := FCacheTree.AddNode(AParent);
-      vXmj.Name := sName;
-    end;
+    vCell := vRow.Cells[FXmjLevel3Col];
+
+    sName := Trim(vCell.SqlText);
+    iEndRow := FCurRow + vCell.RowSpan;
 
-    if FXmjLevel4Col <> -1 then
+    if (sName <> '') then
     begin
-      while FCurRow <= iEndRow do
-        LoadXmjLevel4(AXlsFile, vXmj);
+      vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
+      if not Assigned(vXmj) then
+      begin
+        vXmj := FCacheTree.AddNode(AParent);
+        vXmj.Name := sName;
+      end;
+
+      if FXmjLevel4Col <> -1 then
+      begin
+        while FCurRow < iEndRow do
+          LoadXmjLevel4(ASheet, vXmj);
+      end
+      else
+      begin
+        while FCurRow < iEndRow do
+          LoadBillsNode(ASheet, vXmj);
+      end;
     end
     else
     begin
-      while FCurRow <= iEndRow do
-        LoadBillsNode(AXlsFile, vXmj);
+      while FCurRow < iEndRow do
+        LoadBillsNode(ASheet, AParent);
     end;
   end
   else
-  begin
-    while FCurRow <= iEndRow do
-      LoadBillsNode(AXlsFile, AParent);
-  end;
+    Inc(FCurRow);
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadXmjLevel4(AXlsFile: TXLSFile;
+procedure TPlaneFxBillsExcelImport.LoadXmjLevel4(ASheet: TExportWorkSheet;
   AParent: TBillsCacheNode);
 var
+  vRow: TExportRow;
+  vCell: TExportCell;
   sName: string;
   vXmj: TBillsCacheNode;
   iEndRow: Integer;
 begin
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel4Col));
-  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel4Col] do
-    iEndRow := FCurRow + Bottom - Top;
-
-  if sName <> '' then
+  vRow := ASheet.Rows[FCurRow];
+  if FXmjLevel4Col < vRow.Cells.Count then
   begin
-    vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
-    if not Assigned(vXmj) then
-    begin
-      vXmj := FCacheTree.AddNode(AParent);
-      vXmj.Name := sName;
-    end;
+    vCell := vRow.Cells[FXmjLevel4Col];
+
+    sName := Trim(vCell.SqlText);
+    iEndRow := FCurRow + vCell.RowSpan;
 
-    if FXmjLevel5Col <> -1 then
+    if (sName <> '') then
     begin
-      while FCurRow <= iEndRow do
-        LoadXmjLevel5(AXlsFile, vXmj);
+      vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
+      if not Assigned(vXmj) then
+      begin
+        vXmj := FCacheTree.AddNode(AParent);
+        vXmj.Name := sName;
+      end;
+
+      if FXmjLevel5Col <> -1 then
+      begin
+        while FCurRow < iEndRow do
+          LoadXmjLevel5(ASheet, vXmj);
+      end
+      else
+      begin
+        while FCurRow < iEndRow do
+          LoadBillsNode(ASheet, vXmj);
+      end;
     end
     else
     begin
-      while FCurRow <= iEndRow do
-        LoadBillsNode(AXlsFile, vXmj);
+      while FCurRow < iEndRow do
+        LoadBillsNode(ASheet, AParent);
     end;
   end
   else
-  begin
-    while FCurRow <= iEndRow do
-      LoadBillsNode(AXlsFile, AParent);
-  end;
+    Inc(FCurRow);
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadXmjLevel5(AXlsFile: TXLSFile;
+procedure TPlaneFxBillsExcelImport.LoadXmjLevel5(ASheet: TExportWorkSheet;
   AParent: TBillsCacheNode);
 var
+  vRow: TExportRow;
+  vCell: TExportCell;
   sName: string;
   vXmj: TBillsCacheNode;
   iEndRow: Integer;
 begin
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel5Col));
-  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel5Col] do
-    iEndRow := FCurRow + Bottom - Top;
-
-  if sName <> '' then
+  vRow := ASheet.Rows[FCurRow];
+  if FXmjLevel5Col < vRow.Cells.Count then
   begin
-    vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
-    if not Assigned(vXmj) then
-    begin
-      vXmj := FCacheTree.AddNode(AParent);
-      vXmj.Name := sName;
-    end;
+    vCell := vRow.Cells[FXmjLevel5Col];
 
-    if FXmjLevel6Col <> -1 then
+    sName := Trim(vCell.SqlText);
+    iEndRow := FCurRow + vCell.RowSpan;
+
+    if (sName <> '') then
     begin
-      while FCurRow <= iEndRow do
-        LoadXmjLevel6(AXlsFile, vXmj);
+      vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
+      if not Assigned(vXmj) then
+      begin
+        vXmj := FCacheTree.AddNode(AParent);
+        vXmj.Name := sName;
+      end;
+
+      if FXmjLevel6Col <> -1 then
+      begin
+        while FCurRow < iEndRow do
+          LoadXmjLevel6(ASheet, vXmj);
+      end
+      else
+      begin
+        while FCurRow < iEndRow do
+          LoadBillsNode(ASheet, vXmj);
+      end;
     end
     else
     begin
-      while FCurRow <= iEndRow do
-        LoadBillsNode(AXlsFile, vXmj);
+      while FCurRow < iEndRow do
+        LoadBillsNode(ASheet, AParent);
     end;
   end
   else
-  begin
-    while FCurRow <= iEndRow do
-      LoadBillsNode(AXlsFile, AParent);
-  end;
+    Inc(FCurRow);
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadXmjLevel6(AXlsFile: TXLSFile;
+procedure TPlaneFxBillsExcelImport.LoadXmjLevel6(ASheet: TExportWorkSheet;
   AParent: TBillsCacheNode);
 var
+  vRow: TExportRow;
+  vCell: TExportCell;
   sName: string;
   vXmj: TBillsCacheNode;
   iEndRow: Integer;
 begin
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel6Col));
+  vRow := ASheet.Rows[FCurRow];
+  if FXmjLevel6Col < vRow.Cells.Count then
+  begin
+    vCell := vRow.Cells[FXmjLevel6Col];
 
-  with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel6Col] do
-    iEndRow := FCurRow + Bottom - Top;
+    sName := Trim(vCell.SqlText);
+    iEndRow := FCurRow + vCell.RowSpan;
 
-  if sName <> '' then
-  begin
-    vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
-    if not Assigned(vXmj) then
+    if (sName <> '') then
     begin
-      vXmj := FCacheTree.AddNode(AParent);
-      vXmj.Name := sName;
-    end;
+      vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
+      if not Assigned(vXmj) then
+      begin
+        vXmj := FCacheTree.AddNode(AParent);
+        vXmj.Name := sName;
+      end;
 
-    if FXmjLevel7Col <> -1 then
-    begin
-      while FCurRow <= iEndRow do
-        LoadXmjLevel7(AXlsFile, vXmj);
+      if FXmjLevel7Col <> -1 then
+      begin
+        while FCurRow < iEndRow do
+          LoadXmjLevel7(ASheet, vXmj);
+      end
+      else
+      begin
+        while FCurRow < iEndRow do
+          LoadBillsNode(ASheet, vXmj);
+      end;
     end
     else
     begin
-      while FCurRow <= iEndRow do
-        LoadBillsNode(AXlsFile, vXmj);
+      while FCurRow < iEndRow do
+        LoadBillsNode(ASheet, AParent);
     end;
   end
   else
-  begin
-    while FCurRow <= iEndRow do
-      LoadBillsNode(AXlsFile, AParent);
-  end;
+    Inc(FCurRow);
 end;
 
-procedure TPlaneFxBillsExcelImport.LoadXmjLevel7(AXlsFile: TXLSFile;
+procedure TPlaneFxBillsExcelImport.LoadXmjLevel7(ASheet: TExportWorkSheet;
   AParent: TBillsCacheNode);
 var
+  vRow: TExportRow;
+  vCell: TExportCell;
   sName: string;
   vXmj: TBillsCacheNode;
   iEndRow: Integer;
 begin
-  sName := Trim(GetCellValue(AXlsFile, FCurRow, FXmjLevel7Col));
-  if sName <> '' then
+  vRow := ASheet.Rows[FCurRow];
+  if FXmjLevel7Col < vRow.Cells.Count then
   begin
-    vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
-    if not Assigned(vXmj) then
-    begin
-      vXmj := FCacheTree.AddNode(AParent);
-      vXmj.Name := sName;
-    end;
+    vCell := vRow.Cells[FXmjLevel7Col];
+
+    sName := Trim(vCell.SqlText);
+    iEndRow := FCurRow + vCell.RowSpan;
 
-    with AXlsFile.CellMergedBounds[FCurRow, FXmjLevel7Col] do
-      iEndRow := FCurRow + Bottom - Top;
+    if (sName <> '') then
+    begin
+      vXmj := FCacheTree.FindXmjChild(AParent, '', sName);
+      if not Assigned(vXmj) then
+      begin
+        vXmj := FCacheTree.AddNode(AParent);
+        vXmj.Name := sName;
+      end;
 
-    while FCurRow <= iEndRow do
-      LoadBillsNode(AXlsFile, vXmj);
+      while FCurRow < iEndRow do
+        LoadBillsNode(ASheet, vXmj);
+    end
+    else
+    begin
+      while FCurRow < iEndRow do
+        LoadBillsNode(ASheet, AParent);
+    end;
   end
   else
-  begin
-    while FCurRow <= iEndRow do
-      LoadBillsNode(AXlsFile, AParent);  
-  end;
+    Inc(FCurRow);
 end;
 
 procedure TPlaneFxBillsExcelImport.WriteNodes(ADataSet: TsdDataSet);
@@ -668,7 +679,7 @@ procedure TBillsPriceExcelImport.BeginImport;
 begin
   ShowProgressHint('导入Excel清单单价', 100);
   FProjectData.BillsData.sddBills.BeginUpdate;
-  FCurRow := 1;
+  FCurRow := 0;
 end;
 
 procedure TBillsPriceExcelImport.EndImport;
@@ -680,12 +691,15 @@ begin
 end;
 
 procedure TBillsPriceExcelImport.Import;
+var
+  vSheet: TExportWorkSheet;
 begin
-  LoadColumnsFromHead;
-  ImportBillsPriceData;
+  vSheet := OExport.OpenWorkSheet;
+  LoadColumnsFromHead(vSheet);
+  ImportBillsPriceData(vSheet);
 end;
 
-procedure TBillsPriceExcelImport.ImportBillsPriceData;
+procedure TBillsPriceExcelImport.ImportBillsPriceData(ASheet: TExportWorkSheet);
 
   function CheckIsBillsCode(ACode: string): Boolean;
   const
@@ -706,40 +720,44 @@ procedure TBillsPriceExcelImport.ImportBillsPriceData;
   end;
 
 var
+  vRow: TExportRow;
   iPos: Integer;
   sB_Code: string;
   fPrice: Double;
 begin
   UpdateProgressHint('写入读取的Excel数据');
   UpdateProgressPosition(0);
-  while (FCurRow <= Excel.XlsFile.MaxRow) do
+  while (FCurRow < ASheet.Rows.Count) do
   begin
-    sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
+    vRow := ASheet.Rows[FCurRow];
+    sB_Code := Trim(GetCellStr(vRow, FB_CodeCol));
     if (sB_Code <> '') and CheckIsBillsCode(sB_Code) then
     begin
-      fPrice := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
+      fPrice := StrToFloatDef(Trim(GetCellStr(vRow, FPriceCol)), 0);
       UpdateBillsPrice(sB_Code, fPrice);
     end;
     Inc(FCurRow);
-    iPos := FCurRow * 100 div Excel.XlsFile.MaxRow;
+    iPos := (FCurRow + 1) * 100 div ASheet.Rows.Count;
     UpdateProgressPosition(iPos);
   end;
   UpdateProgressPosition(100);
 end;
 
-procedure TBillsPriceExcelImport.LoadColumnsFromHead;
+procedure TBillsPriceExcelImport.LoadColumnsFromHead(ASheet: TExportWorkSheet);
 var
+  vRow: TExportRow;
   iCol: Integer;
   sColName: string;
 begin
   FB_CodeCol := -1;
   FNameCol := -1;
   FPriceCol := -1;
-  while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow <= Excel.XlsFile.MaxRow) do
+  while ((FB_CodeCol = -1) or (FPriceCol = -1)) and (FCurRow < ASheet.Rows.Count) do
   begin
-    for iCol := 1 to Excel.XlsFile.MaxCol do
+    vRow := ASheet.Rows[FCurRow];
+    for iCol := 0 to vRow.Cells.Count - 1 do
     begin
-      sColName := GetCellTrimStr(Excel.XlsFile, FCurRow, iCol);
+      sColName := Trim(GetCellStr(vRow, iCol));
       if SameText(sColName, '清单编号') or SameText(sColName, '子目号') then
         FB_CodeCol := iCol
       else if SameText(sColName, '名称') then

Units/ExcelImport_Bills.pas

@@ -5,7 +5,7 @@ unit ExcelImport_Bills;
 interface
 
 uses
-  DetailExcelImport, Classes, MCacheTree, sdDB, ProjectData;
+  DetailExcelImport, Classes, MCacheTree, sdDB, ProjectData, OExport;
 
 type
   Tdei_CustomBills = class(TDetailExcelImport)
@@ -42,12 +42,12 @@ type
 
     procedure CheckFixedIDNodes;
 
-    procedure LoadColumnsFromHead;
+    procedure LoadColumnsFromHead(ASheet: TExportWorkSheet);
 
     procedure LoadBaseTree(ATree: TBillsCacheTree);
 
-    procedure LoadNode;
-    procedure LoadNodes;
+    procedure LoadNode(ARow: TExportRow);
+    procedure LoadNodes(ASheet: TExportWorkSheet);
 
     procedure WriteNode(ADataSet: TsdDataSet; ANode: TBillsCacheNode);
     procedure WriteNodes(ADataSet: TsdDataSet);
@@ -70,7 +70,7 @@ begin
   Screen.Cursor := crHourGlass;
   ShowProgressHint('导入Excel数据', 100, '读取Excel数据', 100);
 
-  FCurRow := 1;
+  FCurRow := 0;
   FIsFirstPart := True;
   FCacheTree := TBillsCacheTree.Create;
   FCacheTree.NewNodeID := 101;
@@ -204,8 +204,8 @@ begin
     LoadBaseTree(FBaseTree)
   else
     LoadBaseTree(FCacheTree);
-  LoadColumnsFromHead;
-  LoadNodes;
+  LoadColumnsFromHead(OExport.OpenWorkSheet);
+  LoadNodes(OExport.OpenWorkSheet);
   WriteNodes(ProjectData.BillsData.sddBills);
 end;
 
@@ -229,8 +229,9 @@ begin
   end;
 end;
 
-procedure Tdei_CustomBills.LoadColumnsFromHead;
+procedure Tdei_CustomBills.LoadColumnsFromHead(ASheet: TExportWorkSheet);
 var
+  vRow: TExportRow;
   iCol: Integer;
   sColName: string;
 begin
@@ -248,9 +249,10 @@ begin
   FMemoCol := -1;
   FLevelCol := -1;
 
-  for iCol := 1 to Excel.XlsFile.MaxCol do
+  vRow := ASheet.Rows[FCurRow];
+  for iCol := 0 to vRow.Cells.Count - 1 do
   begin
-    sColName := GetCellTrimStr(Excel.XlsFile, FCurRow, iCol);
+    sColName := GetCellTrimStr(vRow, iCol);
 
     if Pos('项目节', sColName) > 0 then
       FCodeCol := iCol
@@ -282,17 +284,17 @@ begin
   Inc(FCurRow);
 end;
 
-procedure Tdei_CustomBills.LoadNode;
+procedure Tdei_CustomBills.LoadNode(ARow: TExportRow);
 var
   sLevelCode, sCode, sB_Code, sName: string;
   Node: TBillsCacheNode;
   vValue: Variant;
   iFixedID: Integer;
 begin
-  sLevelCode := GetCellTrimStr(Excel.XlsFile, FCurRow, FLevelCol);
-  sCode := GetCellTrimStr(Excel.XlsFile, FCurRow, FCodeCol);
-  sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
-  sName := GetCellTrimStr(Excel.XlsFile, FCurRow, FNameCol);
+  sLevelCode := GetCellTrimStr(ARow, FLevelCol);
+  sCode := GetCellTrimStr(ARow, FCodeCol);
+  sB_Code := GetCellTrimStr(ARow, FB_CodeCol);
+  sName := GetCellTrimStr(ARow, FNameCol);
 
   // 含层次编号时，层次编号为空不导入
   // 不含层次编号时，仅导入第一部分，且项目节编号、清单编号均未空时不导入
@@ -339,26 +341,26 @@ begin
   Node.Code := sCode;
   Node.B_Code := sB_Code;
   Node.Name := sName;
-  Node.Units := GetCellTrimStr(Excel.XlsFile, FCurRow, FUnitsCol);
-  Node.Price := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
-  Node.OrgQuantity := GetCellFloat(Excel.XlsFile, FCurRow, FOrgQuantityCol);
-  Node.MisQuantity := GetCellFloat(Excel.XlsFile, FCurRow, FMisQuantityCol);
-  Node.OthQuantity := GetCellFloat(Excel.XlsFile, FCurRow, FOthQuantityCol);
-  Node.DgnQuantity1 := GetCellFloat(Excel.XlsFile, FCurRow, FDgnQuantity1Col);
-  Node.DgnQuantity2 := GetCellFloat(Excel.XlsFile, FCurRow, FDgnQuantity2Col);
-  Node.DrawingCode := GetCellTrimStr(Excel.XlsFile, FCurRow, FDrawingCol);
-  Node.MemoStr := GetCellTrimStr(Excel.XlsFile, FCurRow, FMemoCol);
+  Node.Units := GetCellTrimStr(ARow, FUnitsCol);
+  Node.Price := GetCellFloat(ARow, FPriceCol);
+  Node.OrgQuantity := GetCellFloat(ARow, FOrgQuantityCol);
+  Node.MisQuantity := GetCellFloat(ARow, FMisQuantityCol);
+  Node.OthQuantity := GetCellFloat(ARow, FOthQuantityCol);
+  Node.DgnQuantity1 := GetCellFloat(ARow, FDgnQuantity1Col);
+  Node.DgnQuantity2 := GetCellFloat(ARow, FDgnQuantity2Col);
+  Node.DrawingCode := GetCellTrimStr(ARow, FDrawingCol);
+  Node.MemoStr := GetCellTrimStr(ARow, FMemoCol);
 end;
 
-procedure Tdei_CustomBills.LoadNodes;
+procedure Tdei_CustomBills.LoadNodes(ASheet: TExportWorkSheet);
 var
   iPos, iSubPos: Integer;
 begin
-  while (FCurRow <= Excel.XlsFile.MaxRow){ and FIsFirstPart }do
+  while (FCurRow < ASheet.Rows.Count){ and FIsFirstPart }do
   begin
-    LoadNode;
+    LoadNode(ASheet.Rows[FCurRow]);
     Inc(FCurRow);
-    iSubPos := FCurRow * 100 div Excel.XlsFile.MaxRow;
+    iSubPos := (FCurRow + 1) * 100 div ASheet.Rows.Count;
     iPos := iSubPos div 2;
     UpdateProgressPosition(iPos, iSubPos);
   end;

Units/ExcelImport_GclBills.pas

@@ -4,7 +4,7 @@ unit ExcelImport_GclBills;
 interface
 
 uses
-  Classes, DetailExcelImport, MCacheTree, sdDB;
+  Classes, DetailExcelImport, MCacheTree, sdDB, OExport;
 
 type
   TDEI_GclBills = class(TDetailExcelImport)
@@ -25,7 +25,7 @@ type
 
     procedure Import; override;
 
-    procedure ImportSheet;
+    procedure ImportSheet(ASheet: TExportWorkSheet);
 
     procedure WriteNode(ADataSet: TsdDataSet; ANode: TGclCacheNode);
     procedure WriteNodes(ADataSet: TsdDataSet);
@@ -36,7 +36,7 @@ type
 implementation
 
 uses
-  Forms, mDataRecord, Controls, ProgressHintFrm, UtilMethods;
+  Forms, mDataRecord, Controls, ProgressHintFrm, UtilMethods, SysUtils;
 
 { TDEI_GclBills }
 
@@ -53,11 +53,11 @@ begin
 
   FSelectSheets := TList.Create;
 
-  FB_CodeCol := 1;
-  FNameCol := 2;
-  FUnitsCol := 3;
-  FQuantityCol := 4;
-  FPriceCol :=  5;
+  FB_CodeCol := 0;
+  FNameCol := 1;
+  FUnitsCol := 2;
+  FQuantityCol := 3;
+  FPriceCol :=  4;
 end;
 
 procedure TDEI_GclBills.EndImport;
@@ -93,34 +93,34 @@ begin
       ImportSheet(FSelectSheets.Items[i]);
     end;
   end;}
-  ImportSheet;
+  ImportSheet(OExport.OpenWorkSheet);
   WriteNodes(ProjectData.BillsData.sddBills);
 end;
 
-procedure TDEI_GclBills.ImportSheet;
+procedure TDEI_GclBills.ImportSheet(ASheet: TExportWorkSheet);
 var
-  iPos: Integer; 
+  vRow: TExportRow;
+  iPos, iRow: Integer;
   sB_Code, sName: string;
   Node: TGclCacheNode;
 begin
-  FCurRow := 2;
-  while (FCurRow <= Excel.XlsFile.MaxRow) do
+  for iRow := 1 to ASheet.Rows.Count do
   begin
-    sB_Code := GetCellTrimStr(Excel.XlsFile, FCurRow, FB_CodeCol);
-    sName := GetCellTrimStr(Excel.XlsFile, FCurRow, FNameCol);
+    vRow := ASheet.Rows[iRow];
+    sB_Code := GetCellTrimStr(vRow, FB_CodeCol);
+    sName := GetCellTrimStr(vRow, FNameCol);
 
     if (sB_Code <> '') or (sName <> '') then
     begin
       Node := FCacheTree.AddNodeByData(sB_Code, sName);
       Node.B_Code := sB_Code;
       Node.Name := sName;
-      Node.Units := GetCellTrimStr(Excel.XlsFile, FCurRow, FUnitsCol);
-      Node.Price := GetCellFloat(Excel.XlsFile, FCurRow, FPriceCol);
-      Node.Quantity := GetCellFloat(Excel.XlsFile, FCurRow, FQuantityCol);
+      Node.Units := GetCellTrimStr(vRow, FUnitsCol);
+      Node.Price := GetCellFloat(vRow, FPriceCol);
+      Node.Quantity := GetCellFloat(vRow, FQuantityCol);
     end;
 
-    Inc(FCurRow);
-    iPos := FCurRow * 100 div Excel.XlsFile.MaxRow;
+    iPos := (iRow + 1) * 100 div ASheet.Rows.Count;
     UpdateProgressPosition(iPos);
   end;
 end;

Units/ExportExcel.pas

@@ -4,24 +4,26 @@ interface
 
 uses
   Classes, ZjGrid, ScXlsOutput, ScXlsCustomUD, Windows, StdCtrls,
-  sdIDTree, sdDB, Graphics, SysUtils, ProgressHintFrm, Forms, Controls;
+  sdIDTree, sdDB, Graphics, SysUtils, ProgressHintFrm, Forms, Controls,
+  OExport, OExport_Vcl, OExport_VclForms;
 
 type
   TExcelExportor = class
   private
-    FXlsOutPut: TXlsOutPut;
+    FOExport: TOExport;
     FGrid: TZJGrid;
     FTempFile: string;
     FFileName: string;
 
-    procedure InitialPage(AGrid: TZJGrid; AXlsPage: TXlsCustomPage);
+    procedure InitialPage(AGrid: TZJGrid; ASheet: TExportWorkSheet);
   protected
     procedure BeforeExport;
     procedure EndExport;
   public
     constructor Create;
     destructor Destroy; override;
-    procedure ExportToXlsPage(AGrid: TZJGrid; AXlsPage: TXlsCustomPage);
+
+    procedure ExportToSheet(AGrid: TZJGrid; ASheet: TExportWorkSheet);
     procedure ExportToFile(AGrid: TZJGrid; const AFileName: string);
   end;
 
@@ -40,7 +42,7 @@ type
     // 列宽
     Width: Integer;
     // 对齐方式
-    HorTextAlign: TUDHTextAlign;
+    HorTextAlign: TCellHAlignment;
     //VerTextAlign: TUDVTextAlign;
   end;
 
@@ -48,11 +50,11 @@ type
 
   TColInfos = array [0..30] of TColInfo;
 
-  // 仿照DataSet的Lookup以及数据库的AutoUpdate已达到关于sdIDTree导出数据至Excel的普适性
+  // 仿照DataSet的Lookup以及数据库的AutoUpdate, 以达到关于sdIDTree导出数据至Excel的普适性
   // 导出前须根据所需列信息，以及查询数据库（列信息须与查询数据库对等，否则将会报错，并不检查列与数据库是否匹配）
   TIDTreeExcelExportor = class
   private
-    FXlsOutPut: TXlsOutPut;
+    FOExport: TOExport;
     FDataSetList: TList;
     FColInfos: PColInfos;
     FColCount: Integer;
@@ -64,9 +66,9 @@ type
     function GetCellValue(ANode: TsdIDTreeNode; ColInfo: TColInfo): Variant;
     // 故换成直接使用String
     function GetCellStr(ANode: TsdIDTreeNode; ColInfo: TColInfo): string;
-    procedure ExportNodeData(ANode: TsdIDTreeNode; AXlsPage: TXlsCustomPage; const ALevelCode: string);
-    procedure ExportTreeNode(ANode: TsdIDTreeNode; AXlsPage: TXlsCustomPage; const ALevelCode: string);
-    procedure DefineHeader(AXlsPage: TXlsCustomPage);
+    procedure ExportNodeData(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
+    procedure ExportTreeNode(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet; const ALevelCode: string);
+    procedure DefineHeader(ASheet: TExportWorkSheet);
   protected
     procedure BeforeExport;
     procedure AfterExport;
@@ -77,7 +79,7 @@ type
     procedure AddLookupDataSet(ADataSet: TsdDataSet);
     procedure DefineCol(AColInfos: PColInfos; AColCount: Integer);
 
-    procedure ExportToXlsPage(ATree: TsdIDTree; AXlsPage: TXlsCustomPage);
+    procedure ExportToSheet(ATree: TsdIDTree; ASheet: TExportWorkSheet);
     procedure ExportToFile(ATree: TsdIDTree; const AFileName: string);
 
     property HasLevelCode: Boolean read FHasLevelCode write FHasLevelCode;
@@ -85,7 +87,7 @@ type
 
   TMasterExcelExportor = class
   private
-    FXlsOutPut: TXlsOutPut;
+    FOExport: TOExport;
     FColInfos: PColInfos;
     FRelaColInfos: PColInfos;
     FColCount: Integer;
@@ -97,9 +99,9 @@ type
     FMasterFieldName: string;
 
     function GetCellValue(ARec: TsdDataRecord; ColInfo: TColInfo): Variant;
-    procedure ExportRecord(ARec: TsdDataRecord; AXlsPage: TXlsCustomPage; ARow: Integer; AColInfos: PColInfos);
-    procedure ExportData(AXlsPage: TXlsCustomPage);
-    procedure DefineHeader(AXlsPage: TXlsCustomPage);
+    procedure ExportRecord(ARec: TsdDataRecord; ASheet: TExportWorkSheet; AColInfos: PColInfos);
+    procedure ExportData(ASheet: TExportWorkSheet);
+    procedure DefineHeader(ASheet: TExportWorkSheet);
   protected
     procedure BeforeExport;
     procedure AfterExport;
@@ -111,104 +113,104 @@ type
     procedure DefineMasterDataSet(ADataSet: TsdDataSet; const AKeyFieldName: string);
     procedure DefineRelaDataSet(ADataSet: TsdDataSet; const AMasterFieldName: string);
 
-    procedure ExportToXlsPage(AXlsPage: TXlsCustomPage);
+    procedure ExportToSheet(ASheet: TExportWorkSheet);
     procedure ExportToFile(const AFileName: string);
   end;
 
 const
   ciLedger: array [0..8] of TColInfo =(
-    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: htaLeft),
-    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
-    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
-    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
-    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
-    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
+    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
+    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
+    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
+    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
+    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
+    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
   );
 
   ciLedgerWithMis: array [0..10] of TColInfo =(
-    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: htaLeft),
-    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
-    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
-    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
-    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '施工图数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
-    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
+    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
+    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
+    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
+    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
+    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '施工图数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
+    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
   );
 
   ciFxBills: array [0..10] of TColInfo =(
-    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: htaLeft),
-    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
-    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
-    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
-    (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
-    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
+    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
+    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
+    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
+    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
+    (FieldName: 'OrgTotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
+    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
   );
 
   ciFxBillsWithMis: array [0..12] of TColInfo =(
-    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: htaLeft),
-    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
-    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
-    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
-    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: htaLeft),
-    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
+    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '预算项目节'; Width: 120; HorTextAlign: cahLeft),
+    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单子目号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
+    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
+    (FieldName: 'OrgQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'MisQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计错漏数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'OthQuantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '其他错漏数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'DgnQuantity1'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量1'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'DgnQuantity2'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '设计数量2'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
+    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '合价'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 100; HorTextAlign: cahLeft),
+    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
   );
 
   ciTpPegGcl: array [0..9] of TColInfo =(
-    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: htaLeft),
-    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
-    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
-    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
-    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
+    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
+    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
+    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
+    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
+    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
   );
 
   ciTpGclPeg_Gcl: array [0..9] of TColInfo =(
-    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: htaLeft),
-    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
-    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
-    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
-    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
+    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
+    (FieldName: 'Name'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
+    (FieldName: 'Units'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
+    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
+    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
   );
 
   ciTpGclPeg_Peg: array [0..9] of TColInfo =(
-    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'PegXmjCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: htaLeft),
-    (FieldName: 'PegXmjName'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: htaLeft),
-    (FieldName: 'PegXmjUnits'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: htaCenter),
-    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: htaRight),
-    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: htaRight),
-    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: htaRight),
-    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: htaLeft),
-    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: htaLeft)
+    (FieldName: 'B_Code'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '清单编号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'PegXmjCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '项目节编号'; Width: 120; HorTextAlign: cahLeft),
+    (FieldName: 'PegXmjName'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '名称'; Width: 200; HorTextAlign: cahLeft),
+    (FieldName: 'PegXmjUnits'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单位'; Width: 40; HorTextAlign: cahCenter),
+    (FieldName: 'Price'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '单价'; Width: 60; HorTextAlign: cahRight),
+    (FieldName: 'Quantity'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '数量'; Width: 90; HorTextAlign: cahRight),
+    (FieldName: 'TotalPrice'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '金额'; Width: 80; HorTextAlign: cahRight),
+    (FieldName: 'Peg'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '桩号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'DrawingCode'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '图号'; Width: 80; HorTextAlign: cahLeft),
+    (FieldName: 'MemoStr'; KeyField: ''; LookupKeyField: ''; LookupDataSetIndex: -1; TitleCaption: '备注'; Width: 80; HorTextAlign: cahLeft)
   );
 
 implementation
@@ -216,6 +218,14 @@ implementation
 uses
   ZhAPI, Variants, UtilMethods, Math;
 
+function GetExportor(const AFileType: string): TOCustomExporter;
+begin
+  if SameText(AFileType, '.xls') then
+    Result := TOCustomExporterXLS.Create
+  else if SameText(AFileType, '.xlsx') then
+    Result := TOCustomExporterXLSX.Create;
+end;
+
 { TExcelExportor }
 
 procedure TExcelExportor.BeforeExport;
@@ -226,7 +236,9 @@ end;
 
 constructor TExcelExportor.Create;
 begin
-  FXlsOutPut := TXlsOutPut.Create;
+  FOExport := TOExport.Create;
+  FOExport.UseProgress := False;
+
   FTempFile := GetTempFileName;
 end;
 
@@ -234,7 +246,7 @@ destructor TExcelExportor.Destroy;
 begin
   if FileExists(FTempFile) then
     DeleteFileOrFolder(FTempFile);
-  FXlsOutPut.Free;
+  FOExport.Free;
   inherited;
 end;
 
@@ -246,111 +258,122 @@ end;
 
 procedure TExcelExportor.ExportToFile(AGrid: TZJGrid;
   const AFileName: string);
+var
+  vExportor: TOCustomExporter;
 begin
   FFileName := AFileName;
   FGrid := AGrid;
   BeforeExport;
   try
-    ExportToXlsPage(AGrid, FXlsOutPut.AddPage);
-    FXlsOutPut.SaveToFile(FTempFile);
+    vExportor := GetExportor(ExtractFileExt(AFileName));
+    ExportToSheet(AGrid, FOExport.AddWorkSheet);
+    FOExport.SaveToFile(FTempFile, vExportor);
     if not FileExists(FFileName) or QuestMessage('存在同名文件，是否替换？') then
       CopyFileOrFolder(FTempFile, FFileName);
   finally
+    vExportor.Free;
     EndExport;
   end;
 end;
 
-procedure TExcelExportor.ExportToXlsPage(AGrid: TZJGrid;
-  AXlsPage: TXlsCustomPage);
+procedure TExcelExportor.ExportToSheet(AGrid: TZJGrid;
+  ASheet: TExportWorkSheet);
 
-  procedure SetXlsCellTextAlign(AXlsCell: TXlsCustomCell; AGridCell: TzjCell);
+  procedure SetXlsCellTextAlign(ACell: TExportCell; AGridCell: TzjCell);
   begin
     case AGridCell.TextAlign of
       gaTopLeft:
       begin
-        AXlsCell.VTextAlign := vtaTop;
-        AXlsCell.HTextAlign := htaLeft;
+        ACell.SetVAlignment(cavTop);
+        ACell.SetAlignment(cahLeft);
       end;
       gaTopCenter:
       begin
-        AXlsCell.VTextAlign := vtaTop;
-        AXlsCell.HTextAlign := htaCenter;
+        ACell.SetVAlignment(cavTop);
+        ACell.SetAlignment(cahCenter);
       end;
       gaTopRight:
       begin
-        AXlsCell.VTextAlign := vtaTop;
-        AXlsCell.HTextAlign := htaRight;
+        ACell.SetVAlignment(cavTop);
+        ACell.SetAlignment(cahRight);
       end;
       gaCenterLeft:
       begin
-        AXlsCell.VTextAlign := vtaCenter;
-        AXlsCell.HTextAlign := htaLeft;
+        ACell.SetVAlignment(cavCenter);
+        ACell.SetAlignment(cahLeft);
       end;
       gaCenterCenter:
       begin
-        AXlsCell.VTextAlign := vtaCenter;
-        AXlsCell.HTextAlign := htaCenter;
+        ACell.SetVAlignment(cavCenter);
+        ACell.SetAlignment(cahCenter);
       end;
       gaCenterRight:
       begin
-        AXlsCell.VTextAlign := vtaCenter;
-        AXlsCell.HTextAlign := htaRight;
+        ACell.SetVAlignment(cavCenter);
+        ACell.SetAlignment(cahRight);
       end;
       gaBottomLeft:
       begin
-        AXlsCell.VTextAlign := vtaBottom;
-        AXlsCell.HTextAlign := htaLeft;
+        ACell.SetVAlignment(cavBottom);
+        ACell.SetAlignment(cahLeft);
       end;
       gaBottomCenter:
       begin
-        AXlsCell.VTextAlign := vtaBottom;
-        AXlsCell.HTextAlign := htaCenter;
+        ACell.SetVAlignment(cavBottom);
+        ACell.SetAlignment(cahCenter);
       end;
       gaBottomRight:
       begin
-        AXlsCell.VTextAlign := vtaBottom;
-        AXlsCell.HTextAlign := htaRight;
+        ACell.SetVAlignment(cavBottom);
+        ACell.SetAlignment(cahRight);
       end;
     end;
     if goWarpText in AGridCell.Grid.Options then
-      AXlsCell.WartText := True;
+      ACell.WrapText := True;
   end;
 
-  procedure ExportGridCell(AGridCell: TzjCell);
+  procedure ExportGridCell(AGridCell: TzjCell; ARow: TExportRow);
   var
+    vCell: TExportCell;
     XlsCell: TXlsCustomCell;
   begin
-    if AGridCell = nil then Exit;
-    XlsCell := AXlsPage.AddCell(AGridCell.Col, AGridCell.Row, AGridCell.Text);
-    SetXlsCellTextAlign(XlsCell, AGridCell);
-    XlsCell.Font.Name := AGridCell.Font.Name;
-    XlsCell.Font.Size := AGridCell.Font.Size;
-    XlsCell.Width := AGridCell.Width;
-    XlsCell.Height := AGridCell.Height;
+    if (AGridCell = nil) then Exit;
+    if ARow.Cells.Count >= AGridCell.Col + 1 then
+      vCell := ARow.Cells[AGridCell.Col]
+    else
+      vCell := ARow.AddCellString(AGridCell.Text);
+    SetXlsCellTextAlign(vCell, AGridCell);
+    vCell.Font.Name := AGridCell.Font.Name;
+    vCell.Font.Size := AGridCell.Font.Size;
+    vCell.RowSpan := AGridCell.Height;
+    vCell.ColSpan := AGridCell.Width;
+    vCell.Width := FGrid.ColWidths[AGridCell.Col];
+    vCell.Height := FGrid.RowHeights[AGridCell.Row];
   end;
 
 var
   iColumn, iRow: Integer;
+  vRow: TExportRow;
 begin
-  InitialPage(AGrid, AXlsPage);
   for iRow := 0 to AGrid.RowCount - 1 do
   begin
     UpdateProgressHint(Format('导出第%d行数据', [iRow + 1]));
     UpdateProgressHint(1);
+    vRow := ASheet.AddRow;
     for iColumn := 0 to AGrid.ColCount - 1 do
-      ExportGridCell(AGrid.Cells[iColumn, iRow]);
+      ExportGridCell(AGrid.Cells[iColumn, iRow], vRow);
   end;
 end;
 
 procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
-  AXlsPage: TXlsCustomPage);
+  ASheet: TExportWorkSheet);
 
   procedure InitialColumnWidth;
   var
     iColumn: Integer;
   begin
     for iColumn := 0 to AGrid.ColCount - 1 do
-      AXlsPage.Widths[iColumn] := AGrid.ColWidths[iColumn];
+      ASheet.Cols[iColumn].SetWidth(AGrid.ColWidths[iColumn]);
   end;
 
   procedure InitialRowHeight;
@@ -358,7 +381,7 @@ procedure TExcelExportor.InitialPage(AGrid: TZJGrid;
     iRow: Integer;
   begin
     for iRow := 0 to AGrid.RowCount - 1 do
-      AXlsPage.Heights.Items[iRow] := AGrid.RowHeights[iRow];
+      ASheet.Rows[iRow].SetHeight(AGrid.RowHeights[iRow]);
   end;
 
 begin
@@ -370,7 +393,7 @@ end;
 
 constructor TIDTreeExcelExportor.Create;
 begin
-  FXlsOutPut := TXlsOutPut.Create;
+  FOExport := TOExport.Create;
   FDataSetList := TList.Create;
   FTempFile := GetTempFileName;
 end;
@@ -380,28 +403,32 @@ begin
   if FileExists(FTempFile) then
     DeleteFileOrFolder(FTempFile);
   FDataSetList.Free;
-  FXlsOutPut.Free;
+  FOExport.Free;
   inherited;
 end;
 
 procedure TIDTreeExcelExportor.ExportToFile(ATree: TsdIDTree;
   const AFileName: string);
+var
+  vExportor: TOCustomExporter;
 begin
   FTree := ATree;
   BeforeExport;
   try
-    ExportToXlsPage(ATree, FXlsOutPut.AddPage);
+    vExportor := GetExportor(ExtractFileExt(AFileName));
+    ExportToSheet(ATree, FOExport.AddWorkSheet);
     UpdateProgressHint('保存0号台账Excel数据');
-    FXlsOutPut.SaveToFile(FTempFile);
+    FOExport.SaveToFile(FTempFile, vExportor);
     if not FileExists(AFileName) or QuestMessage('存在同名文件，是否替换？') then
       CopyFileOrFolder(FTempFile, AFileName);
   finally
+    vExportor.Free;
     AfterExport;
   end;
 end;
 
 procedure TIDTreeExcelExportor.ExportTreeNode(ANode: TsdIDTreeNode;
-  AXlsPage: TXlsCustomPage; const ALevelCode: string);
+  ASheet: TExportWorkSheet; const ALevelCode: string);
 
   function GetFirstChildLevelCode(const ACode: string): string;
   begin
@@ -438,72 +465,45 @@ begin
   UpdateProgressHint(sHint);
   UpdateProgressHint(1);
 
-  ExportNodeData(ANode, AXlsPage, ALevelCode);
-  ExportTreeNode(ANode.FirstChild, AXlsPage, GetFirstChildLevelCode(ALevelCode));
-  ExportTreeNode(ANode.NextSibling, AXlsPage, GetNextSiblingLevelCode(ALevelCode));
+  ExportNodeData(ANode, ASheet, ALevelCode);
+  ExportTreeNode(ANode.FirstChild, ASheet, GetFirstChildLevelCode(ALevelCode));
+  ExportTreeNode(ANode.NextSibling, ASheet, GetNextSiblingLevelCode(ALevelCode));
 end;
 
 procedure TIDTreeExcelExportor.ExportNodeData(ANode: TsdIDTreeNode;
-  AXlsPage: TXlsCustomPage; const ALevelCode: string);
-
-  function ExportCell(ACol, ARow: Integer; AValue: Variant): TXlsCustomCell;
-  begin
-    Result := nil;
-
-    // -----------
-    if VarIsNull(AValue) then Exit;
-    // -----------
-    // 当数据超过3w3k行时，运行至某行时，AddCell会内存溢出
-    // 可能是Cell的数目超过某个限度时，报错
-    // 如果AValue为Null时不AddCell，则3w3k行可以安全度过
-
-    case VarType(AValue) of
-      varSmallInt, varInteger, varSingle, varDouble,
-      varCurrency, varShortInt, varByte, varWord,
-      varLongWord, varInt64:
-      begin
-        if AValue <> 0 then
-          Result := AXlsPage.AddCell(ACol, ARow, AValue);
-      end
-      else Result := AXlsPage.AddCell(ACol, ARow, AValue);
-    end;
-  end;
-
+  ASheet: TExportWorkSheet; const ALevelCode: string);
 var
   iCol: Integer;
   ColInfo: TColInfo;
+  vRow: TExportRow;
+  vCell: TExportCell;
   XlsCell: TXlsCustomCell;
   sStr: string;
 begin
   if not Assigned(ANode) then Exit;
+  vRow := ASheet.AddRow;
+  vRow.Height := 20;
   for iCol := 0 to FColCount - 1 do
   begin
     ColInfo := FColInfos[iCol];
-    XlsCell := ExportCell(iCol, ANode.MajorIndex + 1, GetCellValue(ANode, ColInfo));
-    {sStr := GetCellStr(ANode, ColInfo);
-    if sStr = '' then Continue;
-    XlsCell := AXlsPage.AddCell(iCol, ANode.MajorIndex + 1, sStr);}
-    if Assigned(XlsCell) then
-    begin
-      XlsCell.HTextAlign := ColInfo.HorTextAlign;
-      //XlsCell.VTextAlign := ColInfo.VerTextAlign;
-      XlsCell.Font.Name := 'SmartSimSun';
-      XlsCell.Font.Size := 9;
-    end;
+    vCell := vRow.AddCellString(GetCellStr(ANode, ColInfo));
+    vCell.Alignment := ColInfo.HorTextAlign;
+    vCell.Font.Name := 'SmartSimSun';
+    vCell.Font.Size := 9;
   end;
   if HasLevelCode then
   begin
-    XlsCell := ExportCell(FColCount, ANode.MajorIndex + 1, ALevelCode);
-    XlsCell.Font.Name := 'SmartSimSun';
-    XlsCell.Font.Size := 9;
+    vCell := vRow.AddCellString(ALevelCode);
+    vCell.Font.Name := 'SmartSimSun';
+    vCell.Font.Size := 9;
   end;
 end;
 
-procedure TIDTreeExcelExportor.ExportToXlsPage(ATree: TsdIDTree;
-  AXlsPage: TXlsCustomPage);
+procedure TIDTreeExcelExportor.ExportToSheet(ATree: TsdIDTree;
+  ASheet: TExportWorkSheet);
 begin
-  DefineHeader(AXlsPage);
-  ExportTreeNode(ATree.FirstNode, AXlsPage, '1');
+  DefineHeader(ASheet);
+  ExportTreeNode(ATree.FirstNode, ASheet, '1');
 end;
 
 function TIDTreeExcelExportor.GetCellValue(ANode: TsdIDTreeNode;
@@ -532,29 +532,33 @@ begin
     Result := ARec.ValueByName(ColInfo.FieldName).Value;
 end;
 
-procedure TIDTreeExcelExportor.DefineHeader(AXlsPage: TXlsCustomPage);
+procedure TIDTreeExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
 var
   iCol: Integer;
   ColInfo: TColInfo;
+  vRow: TExportRow;
+  vCell: TExportCell;
   XlsCell: TXlsCustomCell;
 begin
+  vRow := ASheet.AddRow;
+  vRow.Height := 20;
   for iCol := 0 to FColCount - 1 do
   begin
     ColInfo := FColInfos[iCol];
-    XlsCell := AXlsPage.AddCell(iCol, 0, ColInfo.TitleCaption);
-    XlsCell.HTextAlign := htaCenter;
-    XlsCell.Font.Name := '黑体';
-    XlsCell.Font.Size := 10;
-    XlsCell.Font.Style := [fsBold];
-    AXlsPage.Widths[iCol] := ColInfo.Width;
+    vCell := vRow.AddCellString(ColInfo.TitleCaption);
+    vCell.SetAlignment(cahCenter);
+    vCell.SetVAlignment(cavCenter);
+    vCell.Font.Name := '黑体';
+    vCell.Font.Size := 10;
+    vCell.Width := ColInfo.Width;
   end;
   if HasLevelCode then
   begin
-    XlsCell := AXlsPage.AddCell(iCol, 0, '层次编号');
-    XlsCell.HTextAlign := htaCenter;
-    XlsCell.Font.Name := '黑体';
-    XlsCell.Font.Size := 10;
-    XlsCell.Font.Style := [fsBold];
+    vCell := vRow.AddCellString('层次编号');
+    vCell.SetAlignment(cahCenter);
+    vCell.SetVAlignment(cavCenter);
+    vCell.Font.Name := '黑体';
+    vCell.Font.Size := 10;
   end;
 end;
 
@@ -619,7 +623,7 @@ end;
 
 constructor TMasterExcelExportor.Create;
 begin
-  FXlsOutPut := TXlsOutPut.Create;
+  FOExport := TOExport.Create;
   FTempFile := GetTempFileName;
 end;
 
@@ -631,21 +635,24 @@ begin
   FRelaColInfos := ARelaColInfo;
 end;
 
-procedure TMasterExcelExportor.DefineHeader(AXlsPage: TXlsCustomPage);
+procedure TMasterExcelExportor.DefineHeader(ASheet: TExportWorkSheet);
 var
   iCol: Integer;
   ColInfo: TColInfo;
-  XlsCell: TXlsCustomCell;
+  vRow: TExportRow;
+  vCell: TExportCell;
 begin
+  vRow := ASheet.AddRow;
+  vRow.Height := 20;
   for iCol := 0 to FColCount - 1 do
   begin
     ColInfo := FColInfos[iCol];
-    XlsCell := AXlsPage.AddCell(iCol, 0, ColInfo.TitleCaption);
-    XlsCell.HTextAlign := htaCenter;
-    XlsCell.Font.Name := '黑体';
-    XlsCell.Font.Size := 10;
-    XlsCell.Font.Style := [fsBold];
-    AXlsPage.Widths[iCol] := ColInfo.Width;
+    vCell := vRow.AddCellString(ColInfo.TitleCaption);
+    vCell.SetAlignment(cahCenter);
+    vCell.SetVAlignment(cavCenter);
+    vCell.Font.Name := '黑体';
+    vCell.Font.Size := 10;
+    vCell.Width := ColInfo.Width;
   end;
 end;
 
@@ -667,7 +674,7 @@ destructor TMasterExcelExportor.Destroy;
 begin
   if FileExists(FTempFile) then
     DeleteFileOrFolder(FTempFile);
-  FXlsOutPut.Free;
+  FOExport.Free;
   inherited;
 end;
 
@@ -676,100 +683,75 @@ begin
   Screen.Cursor := crDefault;
 end;
 
-procedure TMasterExcelExportor.ExportData(AXlsPage: TXlsCustomPage);
+procedure TMasterExcelExportor.ExportData(ASheet: TExportWorkSheet);
 var
-  i, j, iRow: Integer;
+  i, j: Integer;
   Rec, RelaRec: TsdDataRecord;
 begin
-  iRow := 1;
   for i := 0 to FMasterDataSet.RecordCount - 1 do
   begin
     Rec := FMasterDataSet.Records[i];
-    ExportRecord(Rec, AXlsPage, iRow, FColInfos);
-    Inc(iRow);
+    ExportRecord(Rec, ASheet, FColInfos);
     for j := 0 to FRelaDataSet.RecordCount - 1 do
     begin
       RelaRec := FRelaDataSet.Records[j];
       if (RelaRec.ValueByName(FMasterFieldName).Value = Rec.ValueByName(FKeyFieldName).Value) then
       begin
         if Assigned(FRelaColInfos) then
-          ExportRecord(RelaRec, AXlsPage, iRow, FRelaColInfos)
+          ExportRecord(RelaRec, ASheet, FRelaColInfos)
         else
-          ExportRecord(RelaRec, AXlsPage, iRow, FColInfos);
-        Inc(iRow);
+          ExportRecord(RelaRec, ASheet, FColInfos);
       end;
     end;
   end;
 end;
 
 procedure TMasterExcelExportor.ExportRecord(ARec: TsdDataRecord;
-  AXlsPage: TXlsCustomPage; ARow: Integer; AColInfos: PColInfos);
-
-  function ExportCell(ACol, ARow: Integer; AValue: Variant): TXlsCustomCell;
-  begin
-    Result := nil;
-
-    // -----------
-    if VarIsNull(AValue) then Exit;
-    // -----------
-    // 当数据超过3w3k行时，运行至某行时，AddCell会内存溢出
-    // 可能是Cell的数目超过某个限度时，报错
-    // 如果AValue为Null时不AddCell，则3w3k行可以安全度过
-
-    case VarType(AValue) of
-      varSmallInt, varInteger, varSingle, varDouble,
-      varCurrency, varShortInt, varByte, varWord,
-      varLongWord, varInt64:
-      begin
-        if AValue <> 0 then
-          Result := AXlsPage.AddCell(ACol, ARow, AValue);
-      end
-      else Result := AXlsPage.AddCell(ACol, ARow, AValue);
-    end;
-  end;
-
+  ASheet: TExportWorkSheet; AColInfos: PColInfos);
 var
   iCol: Integer;
   ColInfo: TColInfo;
-  XlsCell: TXlsCustomCell;
+  vRow: TExportRow;
+  vCell: TExportCell;
   sStr: string;
 begin
   if not Assigned(ARec) then Exit;
 
+  vRow := ASheet.AddRow;
   for iCol := 0 to FColCount - 1 do
   begin
     ColInfo := AColInfos[iCol];
-    XlsCell := ExportCell(iCol, ARow, GetCellValue(ARec, ColInfo));
-    if Assigned(XlsCell) then
-    begin
-      XlsCell.HTextAlign := ColInfo.HorTextAlign;
-      XlsCell.Font.Name := 'SmartSimSun';
-      XlsCell.Font.Size := 9;
-    end;
+    vCell := vRow.AddCellVariant(GetCellValue(ARec, ColInfo));
+    vCell.Font.Name := 'SmartSimSun';
+    vCell.Font.Size := 9;
   end;
 end;
 
 procedure TMasterExcelExportor.ExportToFile(const AFileName: string);
+var
+  vExportor: TOCustomExporter;
 begin
   if not Assigned(FMasterDataSet) then Exit;
 
   BeforeExport;
   try
-    ExportToXlsPage(FXlsOutPut.AddPage);
-    FXlsOutPut.SaveToFile(FTempFile);
+    vExportor := GetExportor(ExtractFileExt(AFileName));
+    ExportToSheet(FOExport.AddWorkSheet);
+    FOExport.SaveToFile(FTempFile, vExportor);
     if not FileExists(AFileName) or QuestMessage('存在同名文件，是否替换？') then
       CopyFile(PChar(FTempFile), PChar(AFileName), False);
   finally
+    vExportor.Free;
     AfterExport;
   end;
 end;
 
-procedure TMasterExcelExportor.ExportToXlsPage(AXlsPage: TXlsCustomPage);
+procedure TMasterExcelExportor.ExportToSheet(ASheet: TExportWorkSheet);
 begin
   if not Assigned(FMasterDataSet) then Exit;
 
-  DefineHeader(AXlsPage);
-  ExportData(AXlsPage);
+  DefineHeader(ASheet);
+  ExportData(ASheet);
 end;
 
 function TMasterExcelExportor.GetCellValue(ARec: TsdDataRecord;

Units/UtilMethods.pas

@@ -50,6 +50,8 @@ type
   function SelectFile(var AFileName: string; const AExt: string): Boolean;
   function SelectFiles(AFiles: TStrings; const AExt: string): Boolean;
   function SaveFile(var FileName: string; const AExt: string): Boolean;
+  function SelectExcelFile(var AFileName: string): Boolean;
+  function SaveExcelFile(var FileName: string): Boolean;
   function SelectOutputDirectory(const ATitle: string; var ADirectory: string;
     AParentHandle: THandle = 0; AHasNewFolderBtn: Boolean = True): Boolean;
   function FixPathByAppPath(AFileName: string): string;
@@ -447,6 +449,56 @@ begin
   end;
 end;
 
+function SelectExcelFile(var AFileName: string): Boolean;
+var
+  odFile: TOpenDialog;
+begin
+  odFile := TOpenDialog.Create(nil);
+  try
+    odFile.Filter := 'ExcelÎļþ(*.xls)|*.xls;|ExcelÎļþ(*.xlsx)|*.xlsx;';
+    if odFile.Execute then
+    begin
+      Application.ProcessMessages;
+      AFileName := odFile.FileName;
+      Result := True;
+    end
+    else
+      Result := False;
+  finally
+    odFile.Free;
+  end;
+end;
+
+function SaveExcelFile(var FileName: string): Boolean;
+
+  function CheckFileName(AFileName: string; AExt: string): string;
+  begin
+    if SameText(ExtractFileExt(AFileName), AExt) then
+      Result := AFileName
+    else
+      Result := ExtractFilePath(AFileName) + ExtractFileName(AFileName) + AExt;
+  end;
+
+var
+  sdFile: TSaveDialog;
+begin
+  sdFile := TSaveDialog.Create(nil);
+  try
+    sdFile.FileName := FileName;
+    sdFile.Filter := 'ExcelÎļþ(*.xls)|*.xls;|ExcelÎļþ(*.xlsx)|*.xlsx;';
+    Result := sdFile.Execute;
+    if Result then
+    begin
+      case sdFile.FilterIndex of
+        1: FileName := CheckFileName(sdFile.FileName, '.xls');
+        2: FileName := CheckFileName(sdFile.FileName, '.xlsx');
+      end;
+    end;
+  finally
+    sdFile.Free;
+  end;
+end;
+
 function SelectOutputDirectory(const ATitle: string; var ADirectory: string;
   AParentHandle: THandle; AHasNewFolderBtn: Boolean): Boolean;
 var