1. 总分包汇总，纠错数据

2. 总分包汇总，导出纠错数据
3. 总分包汇总，导出汇总结果

Forms/MainFrm.dfm

@@ -1012,10 +1012,6 @@ object MainForm: TMainForm
         item
           Item = dxbtnGatherSubTender
           Visible = True
-        end
-        item
-          Item = dxbtnCheckBills
-          Visible = True
         end>
     end
     object dxbtnTenderPartition: TdxBarButton
@@ -1152,24 +1148,31 @@ object MainForm: TMainForm
       Visible = ivAlways
       OnClick = dxbtnGatherSubTenderClick
     end
-    object dxbtnCheckBills: TdxBarButton
-      Caption = #26816#26597'0'#21495#21488#36134#28165#21333#32467#26500
-      Category = 0
-      Hint = #26816#26597'0'#21495#21488#36134#28165#21333#32467#26500
-      Visible = ivAlways
-    end
-    object dxBarButton1: TdxBarButton
+    object dxbtnExportTenderError: TdxBarButton
       Caption = #23548#20986#21333#26631#27573#38169#35823#20449#24687
       Category = 0
       Hint = #23548#20986#21333#26631#27573#38169#35823#20449#24687
       Visible = ivAlways
     end
-    object dxBarButton2: TdxBarButton
+    object dxbtnExportAllError: TdxBarButton
       Caption = #23548#20986#20840#37096#38169#35823#20449#24687
       Category = 0
       Hint = #23548#20986#20840#37096#38169#35823#20449#24687
       Visible = ivAlways
     end
+    object dxbtnExportStgResultExcel: TdxBarButton
+      Caption = #23548#20986#20998#21253#27719#24635#32467#26524
+      Category = 0
+      Hint = #23548#20986#20998#21253#27719#24635#32467#26524
+      Visible = ivAlways
+      ImageIndex = 13
+    end
+    object dxbtnExportStgResult: TdxBarButton
+      Caption = #23548#20986#20998#21253#27719#24635#32467#26524
+      Category = 0
+      Hint = #23548#20986#20998#21253#27719#24635#32467#26524
+      Visible = ivAlways
+    end
   end
   object Images: TImageList
     DrawingStyle = dsTransparent
@@ -3349,10 +3352,6 @@ object MainForm: TMainForm
       OnExecute = actnExportSumBaseFileExecute
       OnUpdate = actnUnlockInfoUpdate
     end
-    object actnCheckBills: TAction
-      Caption = #26816#26597'0'#21495#21488#36134#28165#21333#32467#26500
-      OnUpdate = actnCloseProjectUpdate
-    end
   end
   object dxpmTabSet: TdxBarPopupMenu
     BarManager = dxBarManager

Forms/MainFrm.pas

@@ -171,10 +171,10 @@ type
     dxbtnExportSumBaseFile: TdxBarButton;
     actnExportSumBaseFile: TAction;
     dxbtnGatherSubTender: TdxBarButton;
-    dxbtnCheckBills: TdxBarButton;
-    actnCheckBills: TAction;
-    dxBarButton1: TdxBarButton;
-    dxBarButton2: TdxBarButton;
+    dxbtnExportTenderError: TdxBarButton;
+    dxbtnExportAllError: TdxBarButton;
+    dxbtnExportStgResultExcel: TdxBarButton;
+    dxbtnExportStgResult: TdxBarButton;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure jtsProjectsChange(Sender: TObject; NewTab: Integer;

SubTenderGather/stgExcelExport.pas

@@ -0,0 +1,276 @@
+unit stgExcelExport;
+
+interface
+
+uses
+  Classes, OExport, OExport_Vcl, OExport_VclForms, stgGatherDm, sdDB,
+  stgGatherCacheData, stgGatherUtils, sdIDTree, Graphics;
+
+type
+  TstgExcelExport = class
+  private
+    FTempFile: string;
+    FGatherData: TstgGatherData;
+    FOExport: TOExport;
+    FOExportor: TOCustomExporter;
+  protected
+    function AddHeadCell(ARow: TExportRow; const AHead: string; AWidth: Integer): TExportCellString;
+
+    function GetExportor(const AFileType: string): TOCustomExporter;
+
+    procedure SaveFile(const AFileName: string);
+
+    procedure BeforeExport;
+    procedure AfterExport;
+  public
+    constructor Create(AGatherData: TstgGatherData);
+
+    property GatherData: TstgGatherData read FGatherData;
+    property OExport: TOExport read FOExport;
+  end;
+
+  TstgErrorExcelExport = class(TstgExcelExport)
+  private
+    procedure InitSheet(ASheet: TExportWorkSheet);
+    procedure ExportSubTenderToSheet(ATenderID: Integer; ASheet: TExportWorkSheet);
+  public
+    procedure ExportSubTender(ARec: TsdDataRecord; const AFileName: string);
+    procedure ExportAll(const AFileName: string);
+  end;
+
+  TstgGatherExcelExport = class(TstgExcelExport)
+  private
+    procedure InitSheet(ASheet: TExportWorkSheet);
+    procedure ExportTreeNodeToSheet(ANode: TsdIDTreeNode; ASheet: TExportWorkSheet);
+    procedure ExportGatherToSheet(ASheet: TExportWorkSheet);
+  public
+    procedure ExportGather(const AFileName: string);
+  end;
+
+implementation
+
+uses SysUtils, UtilMethods, ZhAPI;
+
+{ TstgErrorExcelExport }
+
+procedure TstgErrorExcelExport.ExportAll(const AFileName: string);
+var
+  i: Integer;
+  vRec: TsdDataRecord;
+begin
+  BeforeExport;
+  try
+    GetExportor(ExtractFileExt(AFileName));
+    for i := 0 to FGatherData.sddSubTenders.RecordCount - 1 do
+    begin
+      vRec := FGatherData.sddSubTenders.Records[i];
+      ExportSubTenderToSheet(vRec.ValueByName('ID').AsInteger, FOExport.AddWorkSheet(vRec.ValueByName('Name').AsString));
+    end;
+    SaveFile(AFileName);
+  finally
+    AfterExport;
+  end;
+end;
+
+procedure TstgErrorExcelExport.ExportSubTender(ARec: TsdDataRecord;
+  const AFileName: string);
+begin
+  BeforeExport;
+  try
+    GetExportor(ExtractFileExt(AFileName));
+    ExportSubTenderToSheet(ARec.ValueByName('ID').AsInteger, FOExport.AddWorkSheet(ARec.ValueByName('Name').AsString));
+    SaveFile(AFileName);
+  finally
+    AfterExport;
+  end;
+end;
+
+procedure TstgErrorExcelExport.ExportSubTenderToSheet(ATenderID: Integer;
+  ASheet: TExportWorkSheet);
+
+  procedure ExportErrorRecord(ARec: TsdDataRecord);
+  var
+    vRow: TExportRow;
+    vCell: TExportCell;
+  begin
+    vRow := ASheet.AddRow;
+    vCell := vRow.AddCellString(ARec.ValueByName('RelaCode').AsString);
+    vCell := vRow.AddCellString(ARec.ValueByName('RelaSerialNo').AsString);
+    vCell.SetAlignment(cahCenter);
+    vCell := vRow.AddCellString(ARec.ValueByName('DetailCode').AsString);
+    vCell := vRow.AddCellString(ARec.ValueByName('DetailSerialNo').AsString);
+    vCell.SetAlignment(cahCenter);
+    vCell := vRow.AddCellString(GetErrorTypeText(ARec.ValueByName('ErrorType').AsInteger));
+  end;
+
+var
+  vIdx: TsdIndex;
+  i, iBegin, iEnd: Integer;
+  vRec: TsdDataRecord;
+begin
+  InitSheet(ASheet);
+  vIdx := GatherData.sddErrorDetail.FindIndex('idxTenderID');
+  iBegin := vIdx.FindKeyIndex(ATenderID);
+  iEnd := vIdx.FindKeyLastIndex(ATenderID);
+  if iBegin = -1 then Exit;
+  for i := iBegin to iEnd do
+    ExportErrorRecord(vIdx.Records[i]);
+end;
+
+procedure TstgErrorExcelExport.InitSheet(ASheet: TExportWorkSheet);
+var
+  vRow: TExportRow;
+  vCell: TExportCellString;
+begin
+  vRow := ASheet.AddRow;
+  vCell := AddHeadCell(vRow, '出错源', 120);
+  vCell.ColSpan := 2;
+  vCell := AddHeadCell(vRow, '可计量清单', 80);
+  vCell.ColSpan := 2;
+  vCell := AddHeadCell(vRow, '错误原因', 200);
+  vCell.RowSpan := 2;
+
+  vRow := ASheet.Rows.Items[vRow.RowIndex + 1];
+  vCell := AddHeadCell(vRow, '编号', 120);
+  vCell := AddHeadCell(vRow, '行号', 50);
+  vCell := AddHeadCell(vRow, '编号', 80);
+  vCell := AddHeadCell(vRow, '行号', 50);
+end;
+
+{ TstgExcelExport }
+
+function TstgExcelExport.AddHeadCell(ARow: TExportRow; const AHead: string;
+  AWidth: Integer): TExportCellString;
+begin
+  Result := ARow.AddCellString(AHead);
+  Result.SetAlignment(cahCenter);
+  Result.SetVAlignment(cavCenter);
+  Result.Font.Name := '黑体';
+  Result.Font.Size := 10;
+  Result.Width := AWidth;
+end;
+
+procedure TstgExcelExport.AfterExport;
+begin
+  FOExport.Free;
+  if Assigned(FOExportor) then
+    FOExportor.Free;
+  if FileExists(FTempFile) then
+    DeleteFile(FTempFile);
+end;
+
+procedure TstgExcelExport.BeforeExport;
+begin
+  FOExport := TOExport.Create;
+  FOExport.UseProgress := False;
+  FTempFile := GetTempFileName;
+end;
+
+constructor TstgExcelExport.Create(AGatherData: TstgGatherData);
+begin
+  FGatherData := AGatherData;
+end;
+
+function TstgExcelExport.GetExportor(
+  const AFileType: string): TOCustomExporter;
+begin
+  if SameText(AFileType, '.xls') then
+    FOExportor := TOCustomExporterXLS.Create
+  else //if SameText(AFileType, '.xlsx') then
+    FOExportor := TOCustomExporterXLSX.Create;
+end;
+
+procedure TstgExcelExport.SaveFile(const AFileName: string);
+begin
+  FOExport.SaveToFile(FTempFile, FOExportor);
+  if not FileExists(AFileName) or QuestMessage('存在同名文件，是否替换？') then
+    CopyFileOrFolder(FTempFile, AFileName);
+end;
+
+{ TstgGatherExcelExport }
+
+procedure TstgGatherExcelExport.ExportGather(const AFileName: string);
+begin
+  BeforeExport;
+  try
+    GetExportor(ExtractFileExt(AFileName));
+    ExportGatherToSheet(OExport.AddWorkSheet('分包数据汇总'));
+    SaveFile(AFileName);
+  finally
+    AfterExport;
+  end;
+end;
+
+procedure TstgGatherExcelExport.ExportGatherToSheet(
+  ASheet: TExportWorkSheet);
+var
+  vTree: TsdIDTree;
+begin
+  InitSheet(ASheet);
+  vTree := TsdIDTree.Create;
+  try
+    vTree.KeyFieldName := 'ID';
+    vTree.ParentFieldName := 'ParentID';
+    vTree.NextSiblingFieldName := 'NextSiblingID';
+    vTree.DataView := GatherData.sdvGatherTree;
+    ExportTreeNodeToSheet(vTree.FirstNode, ASheet);
+  finally
+    vTree.Free;
+  end;
+end;
+
+procedure TstgGatherExcelExport.ExportTreeNodeToSheet(ANode: TsdIDTreeNode;
+  ASheet: TExportWorkSheet);
+
+  procedure AddCellString(ARow: TExportRow; const AStr: string; AColor: TColor);
+  var
+    vCell: TExportCellString;
+  begin
+    vCell := ARow.AddCellString(AStr);
+    vCell.Font.Color := AColor;
+  end;
+
+  procedure AddCellNumber(ARow: TExportRow; const ANum: Double; AColor: TColor);
+  var
+    vCell: TExportCellNumber;
+  begin
+    vCell := ARow.AddCellNumber(ANum);
+    vCell.Font.Color := AColor;
+    vCell.EmptyIfZero := True;
+  end;
+
+var
+  vColor: TColor;
+  vRow: TExportRow;
+  vCell: TExportCellNumber;
+begin
+  if not Assigned(ANode) then Exit;
+  if ANode.Rec.ValueByName('IsSubTender').AsBoolean then
+    vColor := $00D5D5D5
+  else
+    vColor := clWindowText;
+  vRow := ASheet.AddRow;
+  AddCellString(vRow, ANode.Rec.ValueByName('Code').AsString, vColor);
+  AddCellString(vRow, ANode.Rec.ValueByName('B_Code').AsString, vColor);
+  AddCellString(vRow, ANode.Rec.ValueByName('Name').AsString, vColor);
+  AddCellString(vRow, ANode.Rec.ValueByName('Units').AsString, vColor);
+  AddCellNumber(vRow, ANode.Rec.ValueByName('DealQuantity').AsFloat, vColor);
+  AddCellNumber(vRow, ANode.Rec.ValueByName('QcQuantity').AsFloat, vColor);
+  ExportTreeNodeToSheet(ANode.FirstChild, ASheet);
+  ExportTreeNodeToSheet(ANode.NextSibling, ASheet);
+end;
+
+procedure TstgGatherExcelExport.InitSheet(ASheet: TExportWorkSheet);
+var
+  vRow: TExportRow;
+begin
+  vRow := ASheet.AddRow;
+  AddHeadCell(vRow, '项目节编号', 180);
+  AddHeadCell(vRow, '清单编号', 80);
+  AddHeadCell(vRow, '名称', 240);
+  AddHeadCell(vRow, '单位', 50);
+  AddHeadCell(vRow, '合同计量', 100);
+  AddHeadCell(vRow, '数量变更计量', 100);
+end;
+
+end.

SubTenderGather/stgGather.pas

@@ -139,6 +139,7 @@ begin
   Result.B_Code := ANode.Rec.B_Code.AsString;
   Result.Name := ANode.Rec.Name.AsString;
   Result.Units := ANode.Rec.Units.AsString;
+  Result.IsLeaf := not ANode.HasChildren;
 end;
 
 { TstgSubTenderFileGather }
@@ -165,14 +166,19 @@ begin
   FCurSubTenderID := ASubTenderID;
   vNode := ProjectManager.ProjectsTree.FindNode(ASubTenderID);
   if vNode.Rec.ValueByName('Type').AsInteger = 1 then
-  begin
-    FProjectData := TProjectData.Create;
+  begin;
+    FProjectData := OpenProjectManager.FindProjectData(ASubTenderID);
     try
-      FProjectData.OpenForSumUpGather(GetMyProjectsFilePath + vNode.Rec.ValueByName('FileName').AsString);
+      if not Assigned(FProjectData) then
+      begin
+        FProjectData := TProjectData.Create;
+        FProjectData.OpenForSumUpGather(GetMyProjectsFilePath + vNode.Rec.ValueByName('FileName').AsString);
+      end;
       FCacheData.AddSubTender(vNode.Rec);
       GatherSubTenderTreeNode(FProjectData.BillsMeasureData.BillsMeasureTree.FirstNode, nil);
     finally
-      FProjectData.Free;
+      if not Assigned(OpenProjectManager.FindProjectData(ASubTenderID)) then
+        FProjectData.Free;
     end;
   end;
 end;
@@ -203,7 +209,7 @@ begin
   if not Assigned(Result) then
   begin
     vNext := FCacheData.GatherTree.FindNextSibling(AParent, vNode.Rec.Code.AsString, vNode.Rec.B_Code.AsString);
-    if not Assigned(AParent) or (not (AParent.IsSumBase and AParent.IsLeafXmj)) or (not ANode.HasChildren) then
+    if not Assigned(AParent) or (not (AParent.IsSumBase and AParent.IsLeafXmj)) or (vNode.Rec.B_Code.AsString <> '') {or (not ANode.HasChildren)} then
     begin
       if ANode.ID < 100 then
         Result := FCacheData.GatherTree.AddSubTenderNode(AParent, vNext, ANode.ID)
@@ -213,6 +219,7 @@ begin
       Result.B_Code := Trim(vNode.Rec.B_Code.AsString);
       Result.Name := Trim(vNode.Rec.Name.AsString);
       Result.Units := Trim(vNode.Rec.Units.AsString);
+      Result.IsLeaf := not vNode.HasChildren;
     end
     else
       Result := AParent;
@@ -250,9 +257,9 @@ begin
   if HasXmjChildWithSameCodeChild(ANode) then
     NewError(ANode, iErrorXmjLess)
   else if HasLongRelaCodeChild(ANode) then
-    NewError(ANode, iErrorGclLess)
-  else if HasShortRelaCodeChild(ANode) then
     NewError(ANode, iErrorGclMore)
+  else if HasShortRelaCodeChild(ANode) then
+    NewError(ANode, iErrorGclLess)
   else if HasSameChildWithDiffLevel(ANode) then
     NewError(ANode, iErrorGclMore)
   else if HasSameCodeLevelChild(ANode) then
@@ -295,7 +302,7 @@ begin
   for i := 0 to vParent.Children.Count - 1 do
   begin
     vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
-    if Pos(ANode.B_Code + '-', vChild.B_Code) = 1 then
+    if (Pos(ANode.B_Code + '-', vChild.B_Code) = 1) and (vChild.IsSumBase) then
     begin
       Result := True;
       Break;
@@ -354,7 +361,7 @@ begin
   for i := 0 to vParent.Children.Count - 1 do
   begin
     vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
-    if Pos(vChild.B_Code + '-', ANode.B_Code) = 1 then
+    if (Pos(vChild.B_Code + '-', ANode.B_Code) = 1) and (vChild.IsSumBase) then
     begin
       Result := True;
       Break;
@@ -373,7 +380,7 @@ begin
   for i := 0 to vParent.Children.Count - 1 do
   begin
     vChild := TstgGatherTreeNode(vParent.Children.Items[i]);
-    if not vChild.IsGclBills and ANode.IsGclBills then
+    if not vChild.IsGclBills and ANode.IsGclBills and vChild.IsSumBase then
     begin
       Result := True;
       Break;

SubTenderGather/stgGatherCacheData.pas

@@ -8,19 +8,26 @@ uses
 const
   // 新增项目节
   iErrorXmjAdd = 1;
+  sErrorXmjAdd = '新增';
   // 存在同号项目节，但名称、单价不同
-  iErrorXmjDiff = 2;
+  iErrorXmjDiff = 2;    
+  sErrorXmjDiff = '存在同号不同名（单位）';
   // 项目节层次少于总包
   iErrorXmjLess = 3;
+  sErrorXmjLess = '父项项目节，层次少于总包';
 
   // 新增工程量清单
   iErrorGclAdd = 11;
+  sErrorGclAdd = '新增';
   // 存在同名工程量清单，但名称、单价不同
-  iErrorGclDiff = 12;
+  iErrorGclDiff = 12;   
+  sErrorGclDiff = '存在同号不同名（单位）';
   // 工程量清单层次多于总包
   iErrorGclMore = 13;
+  sErrorGclMore = '工程量清单，层次多于总包';
   // 工程量清单层次少于总包
   iErrorGclLess = 14;
+  sErrorGclLess = '工程量清单，层次少于总包';
 
 type
   TstgStageData = class
@@ -436,7 +443,8 @@ begin
   while Assigned(vNode) and not Assigned(Result) do
   begin
     if SameText(vNode.Code, Trim(AInfo.Rec.Code.AsString)) and SameText(vNode.B_Code, Trim(AInfo.Rec.B_Code.AsString))
-        and SameText(vNode.Name, Trim(AInfo.Rec.Name.AsString)) and SameText(vNode.Units, Trim(AInfo.Rec.Units.AsString)) then
+        and SameText(vNode.Name, Trim(AInfo.Rec.Name.AsString)) and SameText(vNode.Units, Trim(AInfo.Rec.Units.AsString))
+        and ((vNode.B_Code = '') or (vNode.IsLeaf = not AInfo.HasChildren)) then
       Result := vNode;
     vNode := TstgGatherTreeNode(vNode.NextSibling);
   end;
@@ -685,7 +693,7 @@ end;
 
 constructor TstgSubTenderDetailData.Create(ANode: TMeasureBillsIDTreeNode);
 begin
-  FSerialNo := ANode.MajorIndex;
+  FSerialNo := ANode.MajorIndex + 1;
   FDetailStage := TstgStageData.Create;
   if Assigned(ANode.StageRec) then
     FDetailStage.AssignedData(ANode.StageRec);

SubTenderGather/stgGatherDm.dfm

@@ -1,7 +1,7 @@
 object stgGatherData: TstgGatherData
   OldCreateOrder = False
-  Left = 192
-  Top = 123
+  Left = 37
+  Top = 195
   Height = 253
   Width = 482
   object smpGatherTree: TsdMemoryProvider
@@ -254,6 +254,9 @@ object stgGatherData: TstgGatherData
       72726F72547970650844617461547970650203084461746153697A6502040549
       734B6579080F4E65656450726F636573734E616D650809507265636973696F6E
       02000453697A6502000000}
+    IndexListData = {
+      01044E616D65060B69647854656E64657249440A4669656C644E616D65730608
+      54656E64657249440000}
   end
   object sdvErrorDetail: TsdDataView
     Active = False

SubTenderGather/stgGatherDm.pas

@@ -3,7 +3,7 @@ unit stgGatherDm;
 interface
 
 uses
-  SysUtils, Classes, stgGatherCacheData, sdDB, sdProvider;
+  SysUtils, Classes, stgGatherCacheData, sdDB, sdProvider, stgGatherUtils;
 
 type
   TstgGatherData = class(TDataModule)
@@ -251,19 +251,6 @@ procedure TstgGatherData.sdvErrorDetailGetText(var Text: String;
     Result := VarToStrDef(sddSubTenders.Lookup('ID', ATenderID, 'Name'), '');
   end;
 
-  function GetErrorTypeText(AErrorType: Integer): string;
-  begin
-    case AErrorType of
-      iErrorXmjAdd: Result := '新增';
-      iErrorXmjDiff: Result := '存在同号不同名（单位）';
-      iErrorXmjLess: Result := '父项项目节，层次少于总包';
-      iErrorGclAdd: Result := '新增';
-      iErrorGclDiff: Result := '存在同号不同名（单位）';
-      iErrorGclMore: Result := '工程量清单，层次多于总包';
-      iErrorGclLess: Result := '工程量清单，层次少于总包';
-    end;
-  end;
-
 begin
   if DisplayText then
   begin

SubTenderGather/stgGatherUtils.pas

@@ -0,0 +1,25 @@
+unit stgGatherUtils;
+
+interface
+
+uses
+  stgGatherCacheData;
+
+  function GetErrorTypeText(AErrorType: Integer): string;
+
+implementation
+
+function GetErrorTypeText(AErrorType: Integer): string;
+begin
+  case AErrorType of
+    iErrorXmjAdd: Result := sErrorXmjAdd;
+    iErrorXmjDiff: Result := sErrorXmjDiff;
+    iErrorXmjLess: Result := sErrorXmjLess;
+    iErrorGclAdd: Result := sErrorGclAdd;
+    iErrorGclDiff: Result := sErrorGclDiff;
+    iErrorGclMore: Result := sErrorGclMore;
+    iErrorGclLess: Result := sErrorGclLess;
+  end;
+end;
+
+end.

SubTenderGather/stgResultExportDm.dfm

@@ -0,0 +1,84 @@
+object stgResultExportData: TstgResultExportData
+  OldCreateOrder = False
+  Left = 27
+  Top = 244
+  Height = 202
+  Width = 270
+  object sdpBills: TsdADOProvider
+    Connection = acResult
+    TableName = 'Bills'
+    Left = 114
+    Top = 32
+  end
+  object sddBills: TsdDataSet
+    Active = False
+    Provider = sdpBills
+    Left = 114
+    Top = 96
+    FieldListData = {
+      0101044E616D6506024944094669656C644E616D650602494408446174615479
+      70650203084461746153697A6502040549734B6579080F4E65656450726F6365
+      73734E616D650909507265636973696F6E02000453697A6502000001044E616D
+      650608506172656E744944094669656C644E616D650608506172656E74494408
+      44617461547970650203084461746153697A6502040549734B6579080F4E6565
+      6450726F636573734E616D650909507265636973696F6E02000453697A650200
+      0001044E616D65060D4E6578745369626C696E674944094669656C644E616D65
+      060D4E6578745369626C696E6749440844617461547970650203084461746153
+      697A6502040549734B6579080F4E65656450726F636573734E616D6509095072
+      65636973696F6E02000453697A6502000001044E616D650604436F6465094669
+      656C644E616D650604436F64650844617461547970650218084461746153697A
+      6502320549734B6579080F4E65656450726F636573734E616D65090950726563
+      6973696F6E02000453697A6502000001044E616D650606425F436F6465094669
+      656C644E616D650606425F436F64650844617461547970650218084461746153
+      697A6502320549734B6579080F4E65656450726F636573734E616D6509095072
+      65636973696F6E02000453697A6502000001044E616D6506044E616D65094669
+      656C644E616D6506044E616D650844617461547970650218084461746153697A
+      6503C8000549734B6579080F4E65656450726F636573734E616D650909507265
+      636973696F6E02000453697A6502000001044E616D650605556E697473094669
+      656C644E616D650605556E697473084461746154797065021808446174615369
+      7A6502140549734B6579080F4E65656450726F636573734E616D650909507265
+      636973696F6E02000453697A6502000000}
+  end
+  object sdpStage: TsdADOProvider
+    Connection = acResult
+    TableName = 'Stage'
+    Left = 195
+    Top = 32
+  end
+  object sddStage: TsdDataSet
+    Active = False
+    Provider = sdpStage
+    Left = 195
+    Top = 96
+    FieldListData = {
+      0101044E616D65060742696C6C734944094669656C644E616D65060742696C6C
+      7349440844617461547970650203084461746153697A6502040549734B657908
+      0F4E65656450726F636573734E616D650909507265636973696F6E0200045369
+      7A6502000001044E616D65060C4465616C5175616E74697479094669656C644E
+      616D65060C4465616C5175616E74697479084461746154797065020608446174
+      6153697A6502080549734B6579080F4E65656450726F636573734E616D650909
+      507265636973696F6E02000453697A6502000001044E616D65060E4465616C54
+      6F74616C5072696365094669656C644E616D65060E4465616C546F74616C5072
+      6963650844617461547970650206084461746153697A6502080549734B657908
+      0F4E65656450726F636573734E616D650909507265636973696F6E0200045369
+      7A6502000001044E616D65060A51635175616E74697479094669656C644E616D
+      65060A51635175616E746974790844617461547970650206084461746153697A
+      6502080549734B6579080F4E65656450726F636573734E616D65090950726563
+      6973696F6E02000453697A6502000001044E616D65060C5163546F74616C5072
+      696365094669656C644E616D65060C5163546F74616C50726963650844617461
+      547970650206084461746153697A6502080549734B6579080F4E65656450726F
+      636573734E616D650909507265636973696F6E02000453697A6502000001044E
+      616D650609516342474C436F6465094669656C644E616D650609516342474C43
+      6F64650844617461547970650218084461746153697A6503FF000549734B6579
+      080F4E65656450726F636573734E616D650909507265636973696F6E02000453
+      697A6502000001044E616D650608516342474C4E756D094669656C644E616D65
+      0608516342474C4E756D0844617461547970650218084461746153697A6503FF
+      000549734B6579080F4E65656450726F636573734E616D650909507265636973
+      696F6E02000453697A6502000000}
+  end
+  object acResult: TADOConnection
+    LoginPrompt = False
+    Left = 40
+    Top = 32
+  end
+end

SubTenderGather/stgResultExportDm.pas

@@ -0,0 +1,125 @@
+unit stgResultExportDm;
+
+interface
+
+uses
+  SysUtils, Classes, sdDB, sdProvider, stgGatherDm, ADODB, DB;
+
+type
+  TstgResultExportData = class(TDataModule)
+    sdpBills: TsdADOProvider;
+    sddBills: TsdDataSet;
+    sdpStage: TsdADOProvider;
+    sddStage: TsdDataSet;
+    acResult: TADOConnection;
+  private
+    FTempFile: string;
+    procedure LoadMemortyRecord(ARec: TsdDataRecord);
+
+    procedure BeforeExport;
+    procedure AfterExport;
+  public
+    procedure SaveTo(const AFileName: string);
+
+    procedure LoadMemoryGatherData(AGatherData: TstgGatherData);
+    procedure ExportGatherDataTo(AGatherData:TstgGatherData; const AFileName: string);
+  end;
+
+implementation
+
+uses
+  UtilMethods, ZhAPI, Connections, stgTables, ScAutoUpdateUnit;
+
+{$R *.dfm}
+
+{ TstgResultExportData }
+
+procedure TstgResultExportData.AfterExport;
+begin
+  if FileExists(FTempFile) then
+    DeleteFile(FTempFile);
+end;
+
+procedure TstgResultExportData.BeforeExport;
+
+  procedure UpdateDataTables;
+  var
+    Updater: TScUpdater;
+  begin
+    Updater := TScUpdater.Create;
+    try
+      Updater.ForceUpdate := True;
+      Updater.Open('', acResult, '', '');
+      Updater.AddTableDef(sStgBills, @tdStgBills, Length(tdStgBills), False, False);
+      Updater.AddTableDef(sStgStage, @tdStgStage, Length(tdStgStage), False, False);
+      Updater.ExcuteUpdate;
+    finally
+      Updater.Free;
+    end;
+  end;
+
+begin
+  FTempFile := GetTempFileName;
+  CopyFileOrFolder(GetEmptyDataBaseFileName, FTempFile);
+  acResult.ConnectionString := Format(SAdoConnectStr, [FTempFile]);
+  acResult.Open;
+  UpdateDataTables;
+  sddBills.Open;
+  sddStage.Open;
+end;
+
+procedure TstgResultExportData.ExportGatherDataTo(
+  AGatherData: TstgGatherData; const AFileName: string);
+begin
+  BeforeExport;
+  try
+    LoadMemoryGatherData(AGatherData);
+    SaveTo(AFileName);
+  finally
+    AfterExport;
+  end;
+end;
+
+procedure TstgResultExportData.LoadMemortyRecord(ARec: TsdDataRecord);
+var
+  vBills, vStage: TsdDataRecord;
+begin
+  vBills := sddBills.Add;
+  vBills.ValueByName('ID').AsInteger := ARec.ValueByName('ID').AsInteger;
+  vBills.ValueByName('ParentID').AsInteger := ARec.ValueByName('ParentID').AsInteger;
+  vBills.ValueByName('NextSiblingID').AsInteger := ARec.ValueByName('NextSiblingID').AsInteger;
+  vBills.ValueByName('Code').AsString := ARec.ValueByName('Code').AsString;
+  vBills.ValueByName('B_Code').AsString := ARec.ValueByName('B_Code').AsString;
+  vBills.ValueByName('Name').AsString := ARec.ValueByName('Name').AsString;
+  vBills.ValueByName('Units').AsString := ARec.ValueByName('Units').AsString;
+  vStage := sddStage.Add;
+  vStage.ValueByName('BillsID').AsInteger := ARec.ValueByName('ID').AsInteger;
+  vStage.ValueByName('DealQuantity').AsFloat := ARec.ValueByName('DealQuantity').AsFloat;
+  vStage.ValueByName('DealTotalPrice').AsFloat := ARec.ValueByName('DealTotalPrice').AsFloat;
+  vStage.ValueByName('QcQuantity').AsFloat := ARec.ValueByName('QcQuantity').AsFloat;
+  vStage.ValueByName('QcTotalPrice').AsFloat := ARec.ValueByName('QcTotalPrice').AsFloat;
+  vStage.ValueByName('QcBGLCode').AsString := ARec.ValueByName('QcBGLCode').AsString;
+  vStage.ValueByName('QcBGLNum').AsString := ARec.ValueByName('QcBGLNum').AsString;
+end;
+
+procedure TstgResultExportData.LoadMemoryGatherData(
+  AGatherData: TstgGatherData);
+var
+  i: Integer;
+  vRec: TsdDataRecord;
+begin
+  for i := 0 to AGatherData.sddGatherTree.RecordCount - 1 do
+  begin
+    vRec := AGatherData.sddGatherTree.Records[i];
+    LoadMemortyRecord(vRec);
+  end;
+end;
+
+procedure TstgResultExportData.SaveTo(const AFileName: string);
+begin
+  sddBills.Save;
+  sddStage.Save;
+  CopyFileOrFolder(FTempFile, AFileName);
+end;
+
+end.

SubTenderGather/stgResultFrm.dfm

@@ -60,6 +60,7 @@ object stgResultForm: TstgResultForm
           FrozenCol = 0
           FrozenRow = 0
           OnCellGetColor = zgGatherTreeCellGetColor
+          OnMouseDown = zgGatherTreeMouseDown
           Align = alClient
         end
       end
@@ -132,6 +133,7 @@ object stgResultForm: TstgResultForm
             Selection.TransparentColor = False
             FrozenCol = 0
             FrozenRow = 0
+            OnMouseDown = zgErrorInfoMouseDown
             Align = alClient
           end
         end
@@ -598,29 +600,63 @@ object stgResultForm: TstgResultForm
     Grid = zgErrorDetail
     ExtendRowCount = 0
     Options = []
-    Left = 156
+    Left = 160
     Top = 195
   end
   object dxpmError: TdxBarPopupMenu
     BarManager = MainForm.dxBarManager
     ItemLinks = <
       item
-        Item = MainForm.dxBarButton1
+        Item = MainForm.dxbtnExportTenderError
         Visible = True
       end
       item
-        Item = MainForm.dxBarButton2
+        Item = MainForm.dxbtnExportAllError
         Visible = True
       end>
     UseOwnFont = False
+    OnPopup = dxpmErrorPopup
     Left = 104
     Top = 235
   end
-  object dxBarPopupMenu2: TdxBarPopupMenu
+  object dxpmGatherTree: TdxBarPopupMenu
     BarManager = MainForm.dxBarManager
-    ItemLinks = <>
+    ItemLinks = <
+      item
+        Item = MainForm.dxbtnExportStgResult
+        Visible = True
+      end
+      item
+        Item = MainForm.dxbtnExportStgResultExcel
+        Visible = True
+      end>
     UseOwnFont = False
+    OnPopup = dxpmGatherTreePopup
     Left = 104
     Top = 148
   end
+  object alStgResult: TActionList
+    Images = MainForm.Images
+    Left = 256
+    Top = 110
+    object actnExportAllError: TAction
+      Caption = #23548#20986#20840#37096#38169#35823#20449#24687
+      ImageIndex = 13
+      OnExecute = actnExportAllErrorExecute
+    end
+    object actnExportTenderError: TAction
+      Caption = #23548#20986#21333#26631#27573#38169#35823#20449#24687
+      ImageIndex = 13
+      OnExecute = actnExportTenderErrorExecute
+    end
+    object actnExportStgResultExcel: TAction
+      Caption = #23548#20986#20998#21253#27719#24635#32467#26524
+      ImageIndex = 13
+      OnExecute = actnExportStgResultExcelExecute
+    end
+    object actnExportStgResult: TAction
+      Caption = #23548#20986#20998#21253#27719#24635#32467#26524
+      OnExecute = actnExportStgResultExecute
+    end
+  end
 end

SubTenderGather/stgResultFrm.pas

@@ -3,10 +3,10 @@ unit stgResultFrm;
 interface
 
 uses
-  stgGatherDm, sdIDTree,
+  stgGatherDm, sdIDTree, UtilMethods, stgExcelExport, stgResultExportDm,
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, JimTabs, JimPages, sdGridDBA, sdGridTreeDBA, ZJGrid, ExtCtrls,
-  StdCtrls, dxBar;
+  StdCtrls, dxBar, ActnList;
 
 type
   TstgResultForm = class(TForm)
@@ -32,18 +32,43 @@ type
     zgErrorDetail: TZJGrid;
     sdErrorDetail: TsdGridDBA;
     dxpmError: TdxBarPopupMenu;
-    dxBarPopupMenu2: TdxBarPopupMenu;
+    dxpmGatherTree: TdxBarPopupMenu;
+    alStgResult: TActionList;
+    actnExportAllError: TAction;
+    actnExportTenderError: TAction;
+    actnExportStgResultExcel: TAction;
+    actnExportStgResult: TAction;
     procedure jtsGatherDataChange(Sender: TObject; NewTab: Integer;
       var AllowChange: Boolean);
     procedure zgGatherTreeCellGetColor(Sender: TObject; ACoord: TPoint;
       var AColor: TColor);
+    procedure zgErrorInfoMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure zgGatherTreeMouseDown(Sender: TObject; Button: TMouseButton;
+      Shift: TShiftState; X, Y: Integer);
+    procedure dxpmErrorPopup(Sender: TObject);
+    procedure actnExportAllErrorExecute(Sender: TObject);
+    procedure actnExportTenderErrorExecute(Sender: TObject);
+    procedure dxpmGatherTreePopup(Sender: TObject);
+    procedure actnExportStgResultExcelExecute(Sender: TObject);
+    procedure actnExportStgResultExecute(Sender: TObject);
   private
+    FGatherData: TstgGatherData;
+    FExcelExportor: TstgErrorExcelExport;
+    function GetExcelExportor: TstgErrorExcelExport;
   public
+    destructor Destroy; override;
+
     procedure SetGatherData(AGatherData: TstgGatherData);
+
+    property ExcelExportor: TstgErrorExcelExport read GetExcelExportor; 
   end;
 
 implementation
 
+uses
+  MainFrm;
+
 {$R *.dfm}
 
 procedure TstgResultForm.jtsGatherDataChange(Sender: TObject;
@@ -54,6 +79,7 @@ end;
 
 procedure TstgResultForm.SetGatherData(AGatherData: TstgGatherData);
 begin
+  FGatherData := AGatherData;
   saGatherTree.DataView := AGatherData.sdvGatherTree;
   sdBillsDetail.DataView := AGatherData.sdvBillsDetail;
   sdErrorInfo.DataView := AGatherData.sdvSubTenders;
@@ -70,4 +96,95 @@ begin
     AColor := $00D5D5D5;
 end;
 
+procedure TstgResultForm.zgErrorInfoMouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  if Button = mbRight then
+    dxpmError.PopupFromCursorPos;
+end;
+
+procedure TstgResultForm.zgGatherTreeMouseDown(Sender: TObject;
+  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+begin
+  if Button = mbRight then
+    dxpmGatherTree.PopupFromCursorPos;
+end;
+
+procedure TstgResultForm.dxpmErrorPopup(Sender: TObject);
+begin
+  SetDxBtnAction(actnExportAllError, MainForm.dxbtnExportAllError);
+  SetDxBtnAction(actnExportTenderError, MainForm.dxbtnExportTenderError);
+end;
+
+procedure TstgResultForm.actnExportAllErrorExecute(Sender: TObject);
+var
+  sFileName: string;
+begin
+  if SaveExcelFile(sFileName) then
+    ExcelExportor.ExportAll(sFileName);
+end;
+
+procedure TstgResultForm.actnExportTenderErrorExecute(Sender: TObject);
+var
+  sFileName: string;
+begin
+  if SaveExcelFile(sFileName) then
+    ExcelExportor.ExportSubTender(sdErrorInfo.DataView.Current, sFileName);
+end;
+
+function TstgResultForm.GetExcelExportor: TstgErrorExcelExport;
+begin
+  if Assigned(FGatherData) then
+  begin
+    if not Assigned(FExcelExportor) then
+      FExcelExportor := TstgErrorExcelExport.Create(FGatherData);
+    Result := FExcelExportor;
+  end
+  else
+    ErrorMessage('当前无汇总数据，无法导出');
+end;
+
+destructor TstgResultForm.Destroy;
+begin
+  if Assigned(FExcelExportor) then
+    FExcelExportor.Free;
+  inherited;
+end;
+
+procedure TstgResultForm.dxpmGatherTreePopup(Sender: TObject);
+begin
+  SetDxBtnAction(actnExportStgResult, MainForm.dxbtnExportStgResult);
+  SetDxBtnAction(actnExportStgResultExcel, MainForm.dxbtnExportStgResultExcel);
+end;
+
+procedure TstgResultForm.actnExportStgResultExcelExecute(Sender: TObject);
+var
+  vExportor: TstgGatherExcelExport;
+  sFileName: string;
+begin
+  vExportor := TstgGatherExcelExport.Create(FGatherData);
+  try
+    if SaveExcelFile(sFileName) then
+      vExportor.ExportGather(sFileName);
+  finally
+    vExportor.Free;
+  end;
+end;
+
+procedure TstgResultForm.actnExportStgResultExecute(Sender: TObject);
+var
+  sFileName: string;
+  vExportor: TstgResultExportData;
+begin
+  if SaveFile(sFileName, '.sgf') then
+  begin
+    vExportor := TstgResultExportData.Create(nil);
+    try
+      vExportor.ExportGatherDataTo(FGatherData, sFileName);
+    finally
+      vExportor.Free;
+    end;
+  end;
+end;
+
 end.

SubTenderGather/stgSelectFileFrm.dfm

@@ -200,6 +200,7 @@ object stgSelectFileForm: TstgSelectFileForm
       Height = 25
       Anchors = [akTop, akRight]
       Caption = #21462#28040
+      ModalResult = 2
       TabOrder = 1
     end
   end

SubTenderGather/stgTables.pas

@@ -0,0 +1,33 @@
+unit stgTables;
+
+interface
+
+uses
+  DataBaseTables;
+
+const
+  sStgBills = 'Bills';
+  tdStgBills : array [0..6] of TScFieldDef = (
+    (FieldName: 'ID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    (FieldName: 'ParentID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'NextSiblingID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'Code'; FieldType: ftString; Size: 50; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'B_Code'; FieldType: ftString; Size: 50; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'Name'; FieldType: ftString; Size: 200; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'Units'; FieldType: ftString; Size: 50; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+  );
+
+  sStgStage = 'Stage';
+  tdStgStage: array [0..6] of TScFieldDef = (
+    (FieldName: 'BillsID'; FieldType: ftInteger; Size: 0; Precision: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
+    (FieldName: 'DealQuantity'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'DealTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'QcQuantity'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'QcTotalPrice'; FieldType: ftDouble; Size: 0; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'QcBGLCode'; FieldType: ftString; Size: 255; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    (FieldName: 'QcBGLNum'; FieldType: ftString; Size: 255; Precision: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False)
+  );
+
+implementation
+
+end.