Преглед изворни кода

Merge branch 'master' of http://192.168.1.12:3000/maixinrong/measure

builder пре 8 година
родитељ
комит
57128f5320

+ 216 - 4
DataModules/ReportMemoryDm/rmWeiWuZjjlGatherDm.dfm

@@ -7,11 +7,182 @@ object rmWeiWuZjjlGatherData: TrmWeiWuZjjlGatherData
   object cdsZjjl: TClientDataSet
     Active = True
     Aggregates = <>
+    FieldDefs = <
+      item
+        Name = 'Code'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'CertificateCode'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'BGLCode'
+        DataType = ftMemo
+        Size = 60535
+      end
+      item
+        Name = 'PegName'
+        DataType = ftWideString
+        Size = 255
+      end
+      item
+        Name = 'BeginPeg'
+        DataType = ftWideString
+        Size = 255
+      end
+      item
+        Name = 'EndPeg'
+        DataType = ftWideString
+        Size = 255
+      end
+      item
+        Name = 'FBFXName'
+        DataType = ftWideString
+        Size = 255
+      end
+      item
+        Name = 'UnitName'
+        DataType = ftWideString
+        Size = 255
+      end
+      item
+        Name = 'DrawingCode'
+        DataType = ftWideString
+        Size = 255
+      end
+      item
+        Name = 'FormulaMemo'
+        DataType = ftMemo
+        Size = 60535
+      end
+      item
+        Name = 'RelaFile'
+        DataType = ftMemo
+        Size = 60535
+      end
+      item
+        Name = 'BillsCode'
+        DataType = ftString
+        Size = 50
+      end
+      item
+        Name = 'BillsName'
+        DataType = ftWideString
+        Size = 255
+      end
+      item
+        Name = 'BillsUnits'
+        DataType = ftWideString
+        Size = 20
+      end
+      item
+        Name = 'BillsPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'FilterDrawingCode'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'BillsCurDealQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsCurDealTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsCurQcQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsCurQcTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsCurGatherQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsCurGatherTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsEndDealQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsEndDealTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsEndQcQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsEndQcTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsEndGatherQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsEndGatherTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsOrgQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsOrgTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsMisQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsMisTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsOthQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsOthTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsQuantity'
+        DataType = ftFloat
+      end
+      item
+        Name = 'BillsTotalPrice'
+        DataType = ftFloat
+      end
+      item
+        Name = 'FenBuName'
+        DataType = ftWideString
+        Size = 50
+      end
+      item
+        Name = 'DanWeiName'
+        DataType = ftWideString
+      end>
+    IndexDefs = <>
     Params = <>
+    StoreDefs = True
     Left = 64
     Top = 32
     Data = {
-      930300009619E0BD01000000180000001C000000000003000000930304436F64
+      9A0400009619E0BD0100000018000000260000000000030000009A0404436F64
       6501004A00000001000557494454480200020064000F43657274696669636174
       65436F646501004A00000001000557494454480200020064000742474C436F64
       6504004B00000002000753554254595045020049000500546578740005574944
@@ -20,7 +191,7 @@ object rmWeiWuZjjlGatherData: TrmWeiWuZjjlGatherData
       0106456E6450656702004A000000010005574944544802000200FE0108464246
       584E616D6502004A000000010005574944544802000200FE0108556E69744E61
       6D6502004A000000010005574944544802000200FE010B44726177696E67436F
-      646501004A00000001000557494454480200020064000B466F726D756C614D65
+      646502004A000000010005574944544802000200FE010B466F726D756C614D65
       6D6F04004B000000020007535542545950450200490005005465787400055749
       4454480200020077EC0852656C6146696C6504004B0000000200075355425459
       504502004900050054657874000557494454480200020077EC0942696C6C7343
@@ -39,7 +210,15 @@ object rmWeiWuZjjlGatherData: TrmWeiWuZjjlGatherData
       6C6C73456E6451635175616E7469747908000400000000001442696C6C73456E
       645163546F74616C507269636508000400000000001642696C6C73456E644761
       746865725175616E7469747908000400000000001842696C6C73456E64476174
-      686572546F74616C507269636508000400000000000000}
+      686572546F74616C507269636508000400000000001042696C6C734F72675175
+      616E7469747908000400000000001242696C6C734F7267546F74616C50726963
+      6508000400000000001042696C6C734D69735175616E74697479080004000000
+      00001242696C6C734D6973546F74616C50726963650800040000000000104269
+      6C6C734F74685175616E7469747908000400000000001242696C6C734F746854
+      6F74616C507269636508000400000000000D42696C6C735175616E7469747908
+      000400000000000F42696C6C73546F74616C5072696365080004000000000009
+      46656E42754E616D6501004A00000001000557494454480200020064000A4461
+      6E5765694E616D6501004A00000001000557494454480200020001000000}
     object cdsZjjlCode: TWideStringField
       FieldName = 'Code'
       Size = 50
@@ -74,8 +253,9 @@ object rmWeiWuZjjlGatherData: TrmWeiWuZjjlGatherData
       Size = 255
     end
     object cdsZjjlDrawingCode: TWideStringField
+      DisplayWidth = 255
       FieldName = 'DrawingCode'
-      Size = 50
+      Size = 255
     end
     object cdsZjjlFormulaMemo: TMemoField
       FieldName = 'FormulaMemo'
@@ -141,5 +321,37 @@ object rmWeiWuZjjlGatherData: TrmWeiWuZjjlGatherData
     object cdsZjjlBillsEndGatherTotalPrice: TFloatField
       FieldName = 'BillsEndGatherTotalPrice'
     end
+    object cdsZjjlBillsOrgQuantity: TFloatField
+      FieldName = 'BillsOrgQuantity'
+    end
+    object cdsZjjlBillsOrgTotalPrice: TFloatField
+      FieldName = 'BillsOrgTotalPrice'
+    end
+    object cdsZjjlBillsMisQuantity: TFloatField
+      FieldName = 'BillsMisQuantity'
+    end
+    object cdsZjjlBillsMisTotalPrice: TFloatField
+      FieldName = 'BillsMisTotalPrice'
+    end
+    object cdsZjjlBillsOthQuantity: TFloatField
+      FieldName = 'BillsOthQuantity'
+    end
+    object cdsZjjlBillsOthTotalPrice: TFloatField
+      FieldName = 'BillsOthTotalPrice'
+    end
+    object cdsZjjlBillsQuantity: TFloatField
+      FieldName = 'BillsQuantity'
+    end
+    object cdsZjjlBillsTotalPrice: TFloatField
+      FieldName = 'BillsTotalPrice'
+    end
+    object cdsZjjlFenBuName: TWideStringField
+      FieldName = 'FenBuName'
+      Size = 50
+    end
+    object cdsZjjlDanWeiName: TWideStringField
+      FieldName = 'DanWeiName'
+      Size = 0
+    end
   end
 end

+ 151 - 24
DataModules/ReportMemoryDm/rmWeiWuZjjlGatherDm.pas

@@ -3,7 +3,7 @@ unit rmWeiWuZjjlGatherDm;
 interface
 
 uses
-  SysUtils, Classes, ProjectData, DB, sdDB, DBClient;
+  SysUtils, Classes, ProjectData, DB, sdDB, DBClient, sdIDTree, BillsTree;
 
 type
   TZjjl = class
@@ -39,11 +39,23 @@ type
     FBillsEndGatherQuantity: Double;
     FBillsEndGatherTotalPrice: Double;
 
+    FBillsOrgQuantity: Double;
+    FBillsOrgTotalPrice: Double;
+    FBillsMisQuantity: Double;
+    FBillsMisTotalPrice: Double;
+    FBillsOthQuantity: Double;
+    FBillsOthTotalPrice: Double;
+    FBillsQuantity: Double;
+    FBillsTotalPrice: Double;
+
+    FFenBuName: string;
+    FDanWeiName: string;
+
     function MergeStr(AStr1, AStr2: string): string;
   public
-    constructor Create(ARec, ABillsRec, AStageRec: TsdDataRecord);
+    constructor Create(ARec, AStageRec: TsdDataRecord; ANode: TBillsIDTreeNode);
 
-    procedure Merge(ARec, ABillsRec, AStageRec: TsdDataRecord);
+    procedure Merge(ARec, AStageRec: TsdDataRecord; ANode: TBillsIDTreeNode);
   end;
 
   TrmWeiWuZjjlGatherData = class(TDataModule)
@@ -62,7 +74,7 @@ type
     cdsZjjlBillsCode: TStringField;
     cdsZjjlBillsName: TWideStringField;
     cdsZjjlBillsUnits: TWideStringField;
-    cdsZjjlBillsPrice: TFloatField; 
+    cdsZjjlBillsPrice: TFloatField;
     cdsZjjlFilterDrawingCode: TWideStringField;
     cdsZjjlBillsCurDealQuantity: TFloatField;
     cdsZjjlBillsCurDealTotalPrice: TFloatField;
@@ -76,9 +88,19 @@ type
     cdsZjjlBillsEndQcTotalPrice: TFloatField;
     cdsZjjlBillsEndGatherQuantity: TFloatField;
     cdsZjjlBillsEndGatherTotalPrice: TFloatField;
+    cdsZjjlBillsOrgQuantity: TFloatField;
+    cdsZjjlBillsOrgTotalPrice: TFloatField;
+    cdsZjjlBillsMisQuantity: TFloatField;
+    cdsZjjlBillsMisTotalPrice: TFloatField;
+    cdsZjjlBillsOthQuantity: TFloatField;
+    cdsZjjlBillsOthTotalPrice: TFloatField;
+    cdsZjjlBillsQuantity: TFloatField;
+    cdsZjjlBillsTotalPrice: TFloatField;
+    cdsZjjlFenBuName: TWideStringField;
+    cdsZjjlDanWeiName: TWideStringField;
   private
     FZjjlList: TList;
-    function FindZjjl(ARec, ABillsRec: TsdDataRecord): TZjjl;
+    function FindZjjl(ARec: TsdDataRecord; ANode: TBillsIDTreeNode): TZjjl;
 
     procedure GatherZjjl(AProjectData: TProjectData);
     procedure WriteData;
@@ -89,7 +111,7 @@ type
 implementation
 
 uses
-  ZhAPI, PhaseData, UtilMethods;
+  ZhAPI, PhaseData, UtilMethods, BillsMeasureDm;
 
 {$R *.dfm}
 
@@ -110,9 +132,75 @@ begin
   end;
 end;
 
+function GetLeafXmj(ANode: TBillsIDTreeNode): TBillsIDTreeNode;
+begin
+  Result := ANode;
+  while Assigned(Result) and (Result.Rec.B_Code.AsString <> '') do
+    Result := TBillsIDTreeNode(Result.Parent);
+end;
+
+function GetLeafXmjDrawingCode(ANode: TBillsIDTreeNode): String;
+var
+  vLeafXmj: TsdIDTreeNode;
+begin
+  Result := '';
+  vLeafXmj := GetLeafXmj(ANode);
+  if Assigned(vLeafXmj) then
+    Result := vLeafXmj.Rec.ValueByName('DrawingCode').AsString;
+end;
+
 { TZjjl }
 
-constructor TZjjl.Create(ARec, ABillsRec, AStageRec: TsdDataRecord);
+constructor TZjjl.Create(ARec, AStageRec: TsdDataRecord; ANode: TBillsIDTreeNode);
+
+  // 取树结构的第ALevel层节点的名称(level从0开始)
+  function GetNameByLevel(ANode: TBillsIDTreeNode; ALevel: Integer): string;
+  begin
+    Result := '';
+    if not Assigned(ANode) then Exit;
+    if ANode.Level = ALevel then
+      Result := ANode.Rec.Name.AsString
+    else if ANode.Level > ALevel then
+      Result := GetNameByLevel(TBillsIDTreeNode(ANode.Parent), ALevel);
+  end;
+
+  function GetNameDanWei(ANode: TBillsIDTreeNode): string;
+  begin
+    // 取树结构的第二层节点的名称
+    Result := GetNameByLevel(ANode, 1);
+  end;
+
+  // ANode为计量单元节点,APegNode为桩号节点
+  function GetNameFenBu(ANode, APegNode: TBillsIDTreeNode): string;
+  var
+    vCurNode: TBillsIDTreeNode;
+  begin
+    // 如果计量单元节点的名称为桩号(转化为判断计量单元节点与桩号节点为同一个)
+    if not Assigned(APegNode) or (ANode.ID = APegNode.ID) then
+      // 取树结构的第三层节点的名称
+      Result := GetNameByLevel(ANode, 2)
+    // 否则,取桩号节点的子节点的名称
+    else
+    begin
+      vCurNode := ANode;
+      while vCurNode.Level > APegNode.Level + 1 do
+        vCurNode := TBillsIDTreeNode(vCurNode.Parent);
+      Result := vCurNode.Rec.Name.AsString;
+    end;
+  end;
+
+  function GetPegNode(ANode: TBillsIDTreeNode): TBillsIDTreeNode;
+  begin
+    Result := nil;
+    if not Assigned(ANode) then Exit;
+    if CheckPeg(ANode.Rec.Name.AsString) then
+      Result := ANode
+    else
+      Result := GetPegNode(TBillsIDTreeNode(ANode.Parent));
+  end;
+
+var
+  vLeafXmj, vPegNode: TBillsIDTreeNode;
 begin
   FCode := ARec.ValueByName('Code').AsString;
   FCertificateCode := ARec.ValueByName('CertificateCode').AsString;
@@ -126,11 +214,11 @@ begin
   FFormulaMemo := ARec.ValueByName('FormulaMemo').AsString;
   FRelaFile := ARec.ValueByName('RelaFile').AsString;
 
-  FBillsCode := ABillsRec.ValueByName('B_Code').AsString;
-  FBillsName := ABillsRec.ValueByName('Name').AsString;
-  FBillsUnits := ABillsRec.ValueByName('Units').AsString;
-  FBillsPrice := ABillsRec.ValueByName('Price').AsFloat;
-  FFilterDrawingCode := GetThirdPartString(ABillsRec.ValueByName('DrawingCode').AsString);
+  FBillsCode := ANode.Rec.ValueByName('B_Code').AsString;
+  FBillsName := ANode.Rec.ValueByName('Name').AsString;
+  FBillsUnits := ANode.Rec.ValueByName('Units').AsString;
+  FBillsPrice := ANode.Rec.ValueByName('Price').AsFloat;
+  FFilterDrawingCode := GetThirdPartString(GetLeafXmjDrawingCode(ANode));
 
   if Assigned(AStageRec) then
   begin
@@ -148,9 +236,23 @@ begin
     FBillsEndGatherQuantity := AStageRec.ValueByName('GatherQuantity').AsFloat;
     FBillsEndGatherTotalPrice := AStageRec.ValueByName('GatherTotalPrice').AsFloat;
   end;
+
+  FBillsOrgQuantity := ANode.Rec.OrgQuantity.AsFloat;
+  FBillsOrgTotalPrice := ANode.Rec.OrgTotalPrice.AsFloat;
+  FBillsMisQuantity := ANode.Rec.MisQuantity.AsFloat;
+  FBillsMisTotalPrice := ANode.Rec.MisTotalPrice.AsFloat;
+  FBillsOthQuantity := ANode.Rec.OthQuantity.AsFloat;
+  FBillsOthTotalPrice := ANode.Rec.OthTotalPrice.AsFloat;
+  FBillsQuantity := ANode.Rec.Quantity.AsFloat;
+  FBillsTotalPrice := ANode.Rec.TotalPrice.AsFloat;
+
+  vLeafXmj := GetLeafXmj(ANode);
+  vPegNode := GetPegNode(ANode);
+  FFenBuName := GetNameFenBu(vLeafXmj, vPegNode);
+  FDanWeiName := GetNameDanWei(vLeafXmj);
 end;
 
-procedure TZjjl.Merge(ARec, ABillsRec, AStageRec: TsdDataRecord);
+procedure TZjjl.Merge(ARec, AStageRec: TsdDataRecord; ANode: TBillsIDTreeNode);
 begin
   FCertificateCode := MergeStr(FCertificateCode, ARec.ValueByName('CertificateCode').AsString);
   FBGLCode := MergeRelaBGL(FBGLCode, ARec.ValueByName('BGLCode').AsString);
@@ -174,6 +276,15 @@ begin
     FBillsEndGatherQuantity := FBillsEndGatherQuantity + AStageRec.ValueByName('GatherQuantity').AsFloat;
     FBillsEndGatherTotalPrice := FBillsEndGatherTotalPrice + AStageRec.ValueByName('GatherTotalPrice').AsFloat;
   end;
+
+  FBillsOrgQuantity := FBillsOrgQuantity + ANode.Rec.OrgQuantity.AsFloat;
+  FBillsOrgTotalPrice := FBillsOrgTotalPrice + ANode.Rec.OrgTotalPrice.AsFloat;
+  FBillsMisQuantity := FBillsMisQuantity + ANode.Rec.MisQuantity.AsFloat;
+  FBillsMisTotalPrice := FBillsMisTotalPrice + ANode.Rec.MisTotalPrice.AsFloat;
+  FBillsOthQuantity := FBillsOthQuantity + ANode.Rec.OthQuantity.AsFloat;
+  FBillsOthTotalPrice := FBillsOthTotalPrice + ANode.Rec.OthTotalPrice.AsFloat;
+  FBillsQuantity := FBillsQuantity + ANode.Rec.Quantity.AsFloat;
+  FBillsTotalPrice := FBillsTotalPrice + ANode.Rec.TotalPrice.AsFloat;
 end;
 
 function TZjjl.MergeStr(AStr1, AStr2: string): string;
@@ -213,18 +324,18 @@ begin
   end;
 end;
 
-function TrmWeiWuZjjlGatherData.FindZjjl(ARec, ABillsRec: TsdDataRecord): TZjjl;
+function TrmWeiWuZjjlGatherData.FindZjjl(ARec: TsdDataRecord; ANode: TBillsIDTreeNode): TZjjl;
 var
   sCode, sName, sUnits, sDrawingCode: string;
   fPrice: Double;
   i: Integer;
   vZ: TZjjl;
 begin
-  sCode := ABillsRec.ValueByName('B_Code').AsString;
-  sName := ABillsRec.ValueByName('Name').AsString;
-  sUnits := ABillsRec.ValueByName('Units').AsString;
-  sDrawingCode := GetThirdPartString(ABillsRec.ValueByName('DrawingCode').AsString);
-  fPrice := ABillsRec.valueByName('Price').AsFloat;
+  sCode := ANode.Rec.ValueByName('B_Code').AsString;
+  sName := ANode.Rec.ValueByName('Name').AsString;
+  sUnits := ANode.Rec.ValueByName('Units').AsString;
+  sDrawingCode := GetThirdPartString(GetLeafXmjDrawingCode(ANode));
+  fPrice := ANode.Rec.valueByName('Price').AsFloat;
 
   Result := nil;
   for i := 0 to FZjjlList.Count - 1 do
@@ -243,24 +354,25 @@ end;
 procedure TrmWeiWuZjjlGatherData.GatherZjjl(AProjectData: TProjectData);
 var
   i: Integer;
+  vNode: TBillsIDTreeNode;
   Rec, BillsRec, StageRec: TsdDataRecord;
   vZ: TZjjl;
 begin
   for i := 0 to AProjectData.PhaseData.ZJJLData.sddZJJL.RecordCount - 1 do
   begin
     Rec := AProjectData.PhaseData.ZJJLData.sddZJJL.Records[I];
-    BillsRec := AProjectData.BillsData.sddBills.FindKey('idxID', Rec.ValueByName('BillsID').AsInteger);
+    vNode := TBillsIDTreeNode(AProjectData.BillsMeasureData.BillsMeasureTree.FindNode(Rec.ValueByName('BillsID').AsInteger));
     StageRec := AProjectData.PhaseData.StageData.StageRecord(Rec.ValueByName('BillsID').AsInteger);
-    if Assigned(Rec) and Assigned(BillsRec) then
+    if Assigned(Rec) and Assigned(vNode) then
     begin
-      vZ := FindZjjl(Rec, BillsRec);
+      vZ := FindZjjl(Rec, vNode);
       if not Assigned(vZ) then
       begin
-        vZ := TZjjl.Create(Rec, BillsRec, StageRec);
+        vZ := TZjjl.Create(Rec, StageRec, vNode);
         FZjjlList.Add(vZ);
       end
       else
-        vZ.Merge(Rec, BillsRec, StageRec);
+        vZ.Merge(Rec, StageRec, vNode);
     end;
   end;
 end;
@@ -286,6 +398,8 @@ begin
     cdsZjjlFBFXName.AsString := vZ.FFBFXName;
     cdsZjjlUnitName.AsString := vZ.FUnitName;
     cdsZjjlDrawingCode.AsString := vZ.FDrawingCode;
+    cdsZjjlFormulaMemo.AsString := vZ.FFormulaMemo;
+    cdsZjjlRelaFile.AsString := vZ.FRelaFile;
 
     cdsZjjlBillsCode.AsString := vZ.FBillsCode;
     cdsZjjlBillsName.AsString := vZ.FBillsName;
@@ -306,6 +420,19 @@ begin
     cdsZjjlBillsEndQcTotalPrice.AsFloat := vZ.FBillsEndQcTotalPrice;
     cdsZjjlBillsEndGatherQuantity.AsFloat := vZ.FBillsEndGatherQuantity;
     cdsZjjlBillsEndGatherTotalPrice.AsFloat := vZ.FBillsEndGatherTotalPrice;
+
+    cdsZjjlBillsOrgQuantity.AsFloat := vZ.FBillsOrgQuantity;
+    cdsZjjlBillsOrgTotalPrice.AsFloat := vZ.FBillsOrgTotalPrice;
+    cdsZjjlBillsMisQuantity.AsFloat := vZ.FBillsMisQuantity;
+    cdsZjjlBillsMisTotalPrice.AsFloat := vZ.FBillsMisTotalPrice;
+    cdsZjjlBillsOthQuantity.AsFloat := vZ.FBillsOthQuantity;
+    cdsZjjlBillsOthTotalPrice.AsFloat := vZ.FBillsOthTotalPrice;
+    cdsZjjlBillsQuantity.AsFloat := vZ.FBillsQuantity;
+    cdsZjjlBillsTotalPrice.AsFloat := vZ.FBillsTotalPrice;
+
+    cdsZjjlFenBuName.AsString := vZ.FFenBuName;
+    cdsZjjlDanWeiName.AsString := vZ.FDanWeiName;
+
     cdsZjjl.Post;
   end;
 end;

+ 5 - 5
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

+ 3 - 3
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

+ 1 - 1
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

+ 2 - 2
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

+ 4 - 2
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;
 

+ 22 - 18
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;

+ 281 - 263
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

+ 30 - 28
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;

+ 20 - 20
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;

+ 230 - 248
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;

+ 54 - 1
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
@@ -857,7 +909,8 @@ end;
 
 function GetTempFilePath: string;
 begin
-  Result := GetTempFileDir + '\';
+  //Result := GetTempFileDir + '\';
+  Result := GetAppTempPath;
 end;
 
 function GetTempName(ALength: Integer): string;