导入分包汇总数据，工程量清单模式

Forms/MainFrm.dfm

@@ -21,7 +21,7 @@ object MainForm: TMainForm
   object jtsProjects: TJimTabSet
     Left = 0
     Top = 49
-    Width = 734
+    Width = 742
     Height = 21
     Align = alTop
     BackgroundColor = clGradientInactiveCaption
@@ -45,8 +45,8 @@ object MainForm: TMainForm
   end
   object dxStatusBar: TdxStatusBar
     Left = 0
-    Top = 480
-    Width = 734
+    Top = 487
+    Width = 742
     Height = 20
     Panels = <
       item
@@ -78,12 +78,12 @@ object MainForm: TMainForm
     object dxStatusBarContainer2: TdxStatusBarContainerControl
       Left = 604
       Top = 2
-      Width = 128
+      Width = 136
       Height = 16
       object ProgressBar: TProgressBar
         Left = 0
         Top = 0
-        Width = 128
+        Width = 136
         Height = 16
         Align = alClient
         Max = 200
@@ -94,8 +94,8 @@ object MainForm: TMainForm
   object jpsMain: TJimPages
     Left = 0
     Top = 70
-    Width = 734
-    Height = 410
+    Width = 742
+    Height = 417
     ActivePage = jpsMainProjectsManager
     ActivePageIndex = 0
     Align = alClient
@@ -103,8 +103,8 @@ object MainForm: TMainForm
     object jpsMainProjectsManager: TJimPage
       Left = 0
       Top = 0
-      Width = 734
-      Height = 410
+      Width = 742
+      Height = 417
       TabName = 'ProjectsManager'
       Caption = 'ProjsMgr'
       object pnlUser: TPanel
@@ -201,8 +201,8 @@ object MainForm: TMainForm
     object jpsMainProjects: TJimPage
       Left = 0
       Top = 0
-      Width = 734
-      Height = 410
+      Width = 742
+      Height = 417
       TabName = 'Projects'
       Caption = 'Projects'
       object jpsProjects: TJimPages
@@ -220,7 +220,7 @@ object MainForm: TMainForm
     Font.Charset = DEFAULT_CHARSET
     Font.Color = clWindowText
     Font.Height = -12
-    Font.Name = #24494#36719#38597#40657
+    Font.Name = 'Microsoft YaHei UI'
     Font.Style = []
     Bars = <
       item
@@ -431,7 +431,7 @@ object MainForm: TMainForm
           Visible = True
         end
         item
-          Item = dxbtnImportSubTenderGather
+          Item = dxsiImportSubTenderGather
           Visible = True
         end
         item
@@ -1035,7 +1035,7 @@ object MainForm: TMainForm
           Visible = True
         end
         item
-          Item = dxbtnGatherSubTender
+          Item = dxsiGatherSub
           Visible = True
         end>
     end
@@ -1173,9 +1173,9 @@ object MainForm: TMainForm
       Hint = #23548#20986#24635#21253#22522#20934#25991#20214
     end
     object dxbtnGatherSubTender: TdxBarButton
-      Caption = #20998#21253#26631#27573#27719#24635
+      Caption = #20998#21253#26631#27573#27719#24635#65288#19977#32423#28165#21333' - '#38656#22522#20934#25991#20214#65289
       Category = 2
-      Hint = #20998#21253#26631#27573#27719#24635
+      Hint = #20998#21253#26631#27573#27719#24635#65288#19977#32423#28165#21333' - '#38656#22522#20934#25991#20214#65289
       Visible = ivAlways
       OnClick = dxbtnGatherSubTenderClick
     end
@@ -1207,6 +1207,7 @@ object MainForm: TMainForm
     object dxbtnImportSubTenderGather: TdxBarButton
       Action = actnImportSubTenderGather
       Category = 4
+      Hint = #23548#20837#20998#21253#27719#24635#25968#25454#65288#19977#32423#28165#21333' - '#22522#20110#22522#20934#25991#20214#65289
     end
     object dxbtnExportBillsJson: TdxBarButton
       Action = actnExportBillsJson
@@ -1230,6 +1231,53 @@ object MainForm: TMainForm
       Visible = ivAlways
       ImageIndex = 2
     end
+    object dxsiGatherSub: TdxBarSubItem
+      Caption = #20998#21253#39033#30446#27719#24635
+      Category = 2
+      Visible = ivAlways
+      ItemLinks = <
+        item
+          Item = dxbtnGatherSubTender
+          Visible = True
+        end
+        item
+          Item = dxbtnGatherSubTenderGcl
+          Visible = True
+        end>
+    end
+    object dxbtnGatherSubTenderGcl: TdxBarButton
+      Caption = #20998#21253#26631#27573#27719#24635#65288#24037#31243#37327#28165#21333#65289
+      Category = 2
+      Hint = #20998#21253#26631#27573#27719#24635#65288#24037#31243#37327#28165#21333#65289
+      Visible = ivAlways
+      OnClick = dxbtnGatherSubTenderGclClick
+    end
+    object dxsiImportSubTenderGather: TdxBarSubItem
+      Caption = #23548#20837#20998#21253#27719#24635#25968#25454
+      Category = 2
+      Visible = ivAlways
+      ItemLinks = <
+        item
+          Item = dxbtnImportSubTenderGather
+          Visible = True
+        end
+        item
+          Item = dxbtnImportSubTenderGatherGcl
+          Visible = True
+        end
+        item
+          Item = dxbtnImportSubTenderGatherExcel
+          Visible = True
+        end>
+    end
+    object dxbtnImportSubTenderGatherGcl: TdxBarButton
+      Action = actnImportSubTenderGatherGcl
+      Category = 2
+    end
+    object dxbtnImportSubTenderGatherExcel: TdxBarButton
+      Action = actnImportSubTenderGatherGclExcel
+      Category = 2
+    end
   end
   object Images: TImageList
     DrawingStyle = dsTransparent
@@ -3411,7 +3459,7 @@ object MainForm: TMainForm
     end
     object actnImportSubTenderGather: TAction
       Category = 'File'
-      Caption = #23548#20837#20998#21253#27719#24635#25968#25454
+      Caption = #23548#20837#20998#21253#27719#24635#25968#25454#65288#19977#32423#28165#21333' - '#22522#20110#22522#20934#25991#20214#65289
       OnExecute = actnImportSubTenderGatherExecute
       OnUpdate = actnImportSubTenderGatherUpdate
     end
@@ -3425,6 +3473,19 @@ object MainForm: TMainForm
       OnExecute = actnExportBillsPosExcelDataExecute
       OnUpdate = actnExportBillsJsonUpdate
     end
+    object actnImportSubTenderGatherGcl: TAction
+      Category = 'File'
+      Caption = #23548#20837#20998#21253#27719#24635#25968#25454#65288#24037#31243#37327#28165#21333#65289
+      OnExecute = actnImportSubTenderGatherGclExecute
+      OnUpdate = actnImportSubTenderGatherUpdate
+    end
+    object actnImportSubTenderGatherGclExcel: TAction
+      Category = 'File'
+      Caption = #23548#20837#20998#21253#27719#24635#25968#25454#65288#24037#31243#37327#28165#21333#65289
+      ImageIndex = 13
+      OnExecute = actnImportSubTenderGatherGclExcelExecute
+      OnUpdate = actnImportSubTenderGatherUpdate
+    end
   end
   object dxpmTabSet: TdxBarPopupMenu
     BarManager = dxBarManager

Forms/MainFrm.pas

@@ -184,6 +184,13 @@ type
     actnExportBillsPosExcelData: TAction;
     dxbtnDeleteRow: TdxBarButton;
     dxbtnInsertRow: TdxBarButton;
+    dxsiGatherSub: TdxBarSubItem;
+    dxbtnGatherSubTenderGcl: TdxBarButton;
+    dxsiImportSubTenderGather: TdxBarSubItem;
+    dxbtnImportSubTenderGatherGcl: TdxBarButton;
+    actnImportSubTenderGatherGcl: TAction;
+    actnImportSubTenderGatherGclExcel: TAction;
+    dxbtnImportSubTenderGatherExcel: TdxBarButton;
     procedure FormCreate(Sender: TObject);
     procedure FormDestroy(Sender: TObject);
     procedure jtsProjectsChange(Sender: TObject; NewTab: Integer;
@@ -236,6 +243,9 @@ type
     procedure actnExportBillsJsonExecute(Sender: TObject);
     procedure actnExportBillsJsonUpdate(Sender: TObject);
     procedure actnExportBillsPosExcelDataExecute(Sender: TObject);
+    procedure dxbtnGatherSubTenderGclClick(Sender: TObject);
+    procedure actnImportSubTenderGatherGclExecute(Sender: TObject);
+    procedure actnImportSubTenderGatherGclExcelExecute(Sender: TObject);
   private
     FProjectManagerFrame: TProjectManagerFrame;
     FProjectFrames: TList;
@@ -274,7 +284,7 @@ uses
   FindUserFrm, ImportExcelHintFrm, ConfigDoc, ExportExcel,
   ProjectCommands, BillsCompileDm, tpMainFrm,
   DealBillsExcelImport, ExcelImport_Bills, DetailExcelImport,
-  stgGatherControl, stgSelectFileFrm;
+  stgGatherControl, stgSelectFileFrm, stgGclGatherControl, stgGclSelectFileFrm;
 
 {$R *.dfm}
 {$R MeasureIcons.RES}
@@ -991,4 +1001,44 @@ begin
   end;
 end;
 
+procedure TMainForm.dxbtnGatherSubTenderGclClick(Sender: TObject);
+var
+  gc: TstgGclGatherControl;
+begin
+  gc := TstgGclGatherControl.Create;
+  Screen.Cursor := crHourGlass;
+  try
+    if SelectFileForSubTenderGclGather(gc) then
+      gc.Gather;
+  finally
+    gc.Free;
+    Screen.Cursor := crDefault;
+  end;
+end;
+
+procedure TMainForm.actnImportSubTenderGatherGclExecute(Sender: TObject);
+var
+  sFileName: string;
+begin
+  if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
+    WarningMessage('未开始计量，请在开始计量后再导入分包汇总数据。')
+  else if CurProjectFrame.ProjectData.StageDataReadOnly then
+    WarningMessage('当前正在查看数据非最新数据，请切换至最新一期再导入分包汇总数据。')
+  else if QuestMessage('导入将清空标段本期所有计量数据（合同计量），确定继续？') and SelectFile(sFileName, '.sgfg') then
+    CurProjectFrame.ProjectData.ImportSubTenderGatherGcl(sFileName);
+end;
+
+procedure TMainForm.actnImportSubTenderGatherGclExcelExecute(
+  Sender: TObject);
+var
+  sFileName: string;
+begin
+  if CurProjectFrame.ProjectData.ProjProperties.PhaseCount = 0 then
+    WarningMessage('未开始计量，请在开始计量后再导入分包汇总数据。')
+  else if CurProjectFrame.ProjectData.StageDataReadOnly then
+    WarningMessage('当前正在查看数据非最新数据，请切换至最新一期再导入分包汇总数据。')
+  else if QuestMessage('导入将清空标段本期所有计量数据（合同计量），确定继续？') and SelectExcelFile(sFileName) then
+    CurProjectFrame.ProjectData.ImportSubTenderGatherGclExcel(sFileName);
+end;
+
 end.

SubTenderGatherGcl/stgGclSubGatherFile.pas

@@ -4,7 +4,8 @@ unit stgGclSubGatherFile;
 interface
 
 uses
-  stgGclSubGatherFileDm, ADODB, sdDB, stgGclGatherDm, SysUtils, StageDm, mDataRecord;
+  stgGclSubGatherFileDm, ADODB, sdDB, stgGclGatherDm, SysUtils, ProjectData,
+  StageDm, mDataRecord, BillsTree, DetailExcelImport, OExport;
 
 type
   TstgGclSubGatherFileHelper = class
@@ -35,16 +36,38 @@ type
   TstgGclSubGatherFileImportor = class(TstgGclSubGatherFileHelper)
   private
     procedure ClearOldData(AStageData: TStageData);
-    procedure ImportGatherData(AStageData: TStageData);
+    procedure ImportGatherData(AProjectData: TProjectData);
   public
-    procedure ImportGatherDataTo(AStageData: TStageData; const AFileName: string);
+    procedure ImportGatherDataTo(AProjectData: TProjectData; const AFileName: string);
+  end;
+
+  TstgGclSubGatherFileExcelImportor = class(TDetailExcelImport)
+  private      
+    FCurRow: Integer;
+
+    FB_CodeCol: Integer;
+    FNameCol: Integer;
+    FUnitsCol: Integer;
+    FPriceCol: Integer;
+    FDealQuantityCol: Integer;
+
+    procedure ClearOldData(AStageData: TStageData);
+
+    function LoadColumnsFromHead(ASheet: TExportWorkSheet): Boolean;
+    procedure LoadGatherData(ASheet: TExportWorkSheet);
+  protected
+    procedure BeginImport; override;
+    procedure EndImport; override;
+
+    procedure Import; override;
   end;
 
 implementation
 
 
 uses
-  UtilMethods, ZhAPI, Connections, stgGclTables, ScAutoUpdateUnit, Math;
+  UtilMethods, ZhAPI, Connections, stgGclTables, ScAutoUpdateUnit, Math,
+  BillsMeasureDm;
 
 { TstgGclSubGatherFileExportor }
 
@@ -170,35 +193,191 @@ begin
 end;
 
 procedure TstgGclSubGatherFileImportor.ImportGatherData(
-  AStageData: TStageData);
+  AProjectData: TProjectData);
+
+  function FindBillsNode(ARec: TsdDataRecord): TBillsIDTreeNode;
+  var
+    i: Integer;
+    vNode: TBillsIDTreeNode;
+  begin
+    Result := nil;
+    for i := 0 to AProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
+    begin
+      vNode := TBillsIDTreeNode(AProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
+      if (vNode.HasChildren) then Continue;
+      if (vNode.Rec.B_Code.AsString = ARec.ValueByName('B_Code').AsString) and
+         (vNode.Rec.Name.AsString = ARec.ValueByName('Name').AsString) and
+         (vNode.Rec.Units.AsString = ARec.ValueByName('Units').AsString) and
+         (CommonRoundTo(vNode.Rec.Price.AsFloat - ARec.ValueByName('Price').AsFloat, -6) = 0) then
+      begin
+        Result := vNode;
+        Break;
+      end;
+    end;
+  end;
+
 var
   i: Integer;
+  vNode: TBillsIDTreeNode;
   vOrgRec: TsdDataRecord;
   vStageRec: TStageRecord;
 begin
   for i := 0 to GatherData.sddBills.RecordCount - 1 do
   begin
     vOrgRec := GatherData.sddBills.Records[i];
-    if vOrgRec.ValueByName('IsSumBase').AsBoolean and vOrgRec.ValueByName('IsLeaf').AsBoolean then
+    vNode := FindBillsNode(vOrgRec);
+    if Assigned(vNode) then
     begin
-      vStageRec := AStageData.StageRecordWithAdd(vOrgRec.ValueByName('ID').AsInteger);
+      vStageRec := AProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
       vStageRec.DealQuantity.AsFloat := vOrgRec.ValueByName('DealQuantity').AsFloat;
     end;
   end;
 end;
 
 procedure TstgGclSubGatherFileImportor.ImportGatherDataTo(
-  AStageData: TStageData; const AFileName: string);
+  AProjectData: TProjectData; const AFileName: string);
 begin
   Open(AFileName);
-  AStageData.sddStage.BeginUpdate;
-  AStageData.BeforeBatchOperation;
+  AProjectData.PhaseData.StageData.sddStage.BeginUpdate;
+  AProjectData.PhaseData.StageData.BeforeBatchOperation;
   try
-    ClearOldData(AStageData);
-    ImportGatherData(AStageData);
+    ClearOldData(AProjectData.PhaseData.StageData);
+    ImportGatherData(AProjectData);
   finally
-    AStageData.AfterBatchOperation;
-    AStageData.sddStage.EndUpdate;
+    AProjectData.PhaseData.StageData.AfterBatchOperation;
+    AProjectData.PhaseData.StageData.sddStage.EndUpdate;
+  end;
+end;
+
+{ TstgGclSubGatherFileExcelImportor }
+
+procedure TstgGclSubGatherFileExcelImportor.BeginImport;
+begin
+  inherited;
+  ProjectData.PhaseData.StageData.sddStage.BeginUpdate;
+  ProjectData.PhaseData.StageData.BeforeBatchOperation;
+end;
+
+procedure TstgGclSubGatherFileExcelImportor.ClearOldData(
+  AStageData: TStageData);
+var
+  i: Integer;
+  vRec: TStageRecord;
+begin
+  for i := 0 to AStageData.sddStage.RecordCount - 1 do
+  begin
+    vRec := TStageRecord(AStageData.sddStage.Records[i]);
+    vRec.DealQuantity.AsFloat := 0;
+    vRec.DealTotalPrice.AsFloat := 0;
+    vRec.DealFlag.AsInteger := 0;
+    vRec.DealFormula.AsString := '';
+    vRec.EndDealQuantity.AsFloat := vRec.PreDealQuantity.AsFloat;
+    vRec.EndDealTotalPrice.AsFloat := vRec.PreDealTotalPrice.AsFloat;
+  end;
+end;
+
+procedure TstgGclSubGatherFileExcelImportor.EndImport;
+begin
+  ProjectData.PhaseData.StageData.AfterBatchOperation;
+  ProjectData.PhaseData.StageData.sddStage.EndUpdate;
+  inherited;
+end;
+
+procedure TstgGclSubGatherFileExcelImportor.Import;
+begin
+  ClearOldData(ProjectData.PhaseData.StageData);
+
+  FCurRow := 0;
+  if LoadColumnsFromHead(OExport.OpenWorkSheet) then
+    LoadGatherData(OExport.OpenWorkSheet)
+  else
+    ErrorMessage('导入的Excel格式有误！');
+  inherited;
+end;
+
+function TstgGclSubGatherFileExcelImportor.LoadColumnsFromHead(
+  ASheet: TExportWorkSheet): Boolean;
+var        
+  vRow: TExportRow;
+  iCol: Integer;
+  sColName: String;
+begin
+  FB_CodeCol := -1;
+  FNameCol := -1;
+  FUnitsCol := -1;
+  FPriceCol := -1;
+  FDealQuantityCol := -1;
+
+  vRow := ASheet.Rows[FCurRow];
+  for iCol := 0 to vRow.Cells.Count - 1 do
+  begin
+    sColName := GetCellTrimStr(vRow, iCol);
+
+   if (sColName = '清单编号') then
+      FB_CodeCol := iCol
+    else if sColName = '名称' then
+      FNameCol := iCol
+    else if sColName = '单位' then
+      FUnitsCol := iCol
+    else if sColName = '单价' then
+      FPriceCol := iCol
+    else if (sColName = '合同计量') then
+      FDealQuantityCol := iCol;
+  end;
+  Result := (FB_CodeCol <> -1) and (FNameCol <> -1) and (FUnitsCol <> -1) and
+    (FPriceCol <> -1) and (FDealQuantityCol <> -1);
+  Inc(FCurRow);
+end;
+
+procedure TstgGclSubGatherFileExcelImportor.LoadGatherData(
+  ASheet: TExportWorkSheet);
+
+  function FindBillsNode(const AB_Code, AName, AUnits: string; APrice: Double): TBillsIDTreeNode;
+  var
+    i: Integer;
+    vNode: TBillsIDTreeNode;
+  begin
+    Result := nil;
+    for i := 0 to ProjectData.BillsMeasureData.BillsMeasureTree.Count - 1 do
+    begin
+      vNode := TBillsIDTreeNode(ProjectData.BillsMeasureData.BillsMeasureTree.Items[i]);
+      if (vNode.HasChildren) then Continue;
+      if (vNode.Rec.B_Code.AsString = AB_Code) and
+         (vNode.Rec.Name.AsString = AName) and
+         (vNode.Rec.Units.AsString = AUnits) and
+         (CommonRoundTo(vNode.Rec.Price.AsFloat - APrice, -6) = 0) then
+      begin
+        Result := vNode;
+        Break;
+      end;
+    end;
+  end;
+
+var
+  vRow: TExportRow;
+  sB_Code, sName, sUnits: string;
+  fPrice: Double;  
+  vNode: TBillsIDTreeNode;
+  vStageRec: TStageRecord;
+begin
+  while FCurRow < ASheet.Rows.Count do
+  begin
+    vRow := ASheet.Rows[FCurRow]; 
+    Inc(FCurRow);
+    
+    sB_Code := Trim(GetCellStr(vRow, FB_CodeCol));
+    sName := Trim(GetCellStr(vRow, FNameCol));
+    sUnits := Trim(GetCellStr(vRow, FUnitsCol));
+    fPrice := StrToFloatDef(GetCellStr(vRow, FPriceCol), 0);
+
+    if (sB_Code = '') then Continue;
+
+    vNode := FindBillsNode(sB_Code, sName, sUnits, fPrice);
+    if Assigned(vNode) then
+    begin
+      vStageRec := ProjectData.PhaseData.StageData.StageRecordWithAdd(vNode.ID);
+      vStageRec.DealQuantity.AsFloat := StrToFloatDef(GetCellStr(vRow, FDealQuantityCol), 0);
+    end;
   end;
 end;
 

Units/ProjectData.pas

@@ -209,6 +209,8 @@ type
     procedure ImportCloudTenderFile(const AFileName: string);
     procedure ImportDmfFile(const AFileName: string);
     procedure ImportSubTenderGather(const AFileName: string);
+    procedure ImportSubTenderGatherGcl(const AFileName: string);
+    procedure ImportSubTenderGatherGclExcel(const AFileName: string);
 
     function CheckPassword: Boolean;
 
@@ -285,7 +287,8 @@ uses
   ZJJLDm, PHPWebDm, XMLDoc, XMLIntf, ConstUnit, PasswordInputFrm,
   mProgressProFrm, mDataRecord, ConditionalDefines, DbTreeImport,
   StrUtils, sdProvider, CalcDecimal, Math, CslJson, OrderCheckerFme,
-  stgSubGatherFile, Forms, ProgressHintFrm, BillsTree, Controls;
+  stgSubGatherFile, Forms, ProgressHintFrm, BillsTree, Controls,
+  stgGclSubGatherFile;
 
 { TProjectData }
 
@@ -2356,4 +2359,37 @@ begin
     FDealPayFinalData.LoadLastestDealPayData;
 end;
 
+procedure TProjectData.ImportSubTenderGatherGclExcel(
+  const AFileName: string);
+var
+  vImportor: TstgGclSubGatherFileExcelImportor;
+begin
+  if PhaseData.StageDataReadOnly then Exit;
+
+  vImportor := TstgGclSubGatherFileExcelImportor.Create(Self);
+  try
+    vImportor.ImportFile(AFileName);
+    BillsMeasureData.ResetTreeNodeStageRec;
+  finally
+    CalculateAll;
+    vImportor.Free;
+  end;
+end;
+
+procedure TProjectData.ImportSubTenderGatherGcl(const AFileName: string);
+var
+  vImportor: TstgGclSubGatherFileImportor;
+begin
+  if PhaseData.StageDataReadOnly then Exit;
+
+  vImportor := TstgGclSubGatherFileImportor.Create;
+  try
+    vImportor.ImportGatherDataTo(Self, AFileName);
+    BillsMeasureData.ResetTreeNodeStageRec;
+  finally
+    CalculateAll;
+    vImportor.Free;
+  end;
+end;
+
 end.