保存项目时，增加计算自检

DataModules/BillsMeasureDm.pas

@@ -4,7 +4,7 @@ interface
 
 uses
   BillsDm, BillsTree, FormulaCalc, sdIDTree, StageDm,
-  SysUtils, Classes, sdDB, DB;
+  SysUtils, Classes, sdDB, DB, CalcDecimal;
 
 type 
   TLocateZJJLEvent = procedure (ABillsID: Integer) of object;
@@ -48,6 +48,7 @@ type
 
     function GetStageData: TStageData;
     procedure SetOnRecChange(const Value: TRecChangeEvent);
+    function GetDecimal: TCalcDecimal;
   public
     constructor Create(AProjectData: TObject);
     destructor Destroy; override;
@@ -56,6 +57,7 @@ type
     procedure Close;
     procedure ReConnectTree;
 
+    function CheckNodeGatherCalc(ANode: TMeasureBillsIDTreeNode): Boolean;
     procedure CalculateAll;
 
     procedure ResetPhaseStageLink;
@@ -81,6 +83,7 @@ type
     property ProjectData: TObject read FProjectData;
     property BillsData: TBillsData read FBillsData;
     property BillsMeasureTree: TMeasureBillsIDTree read FBillsMeasureTree;
+    property Decimal: TCalcDecimal read GetDecimal;
 
     property StageData: TStageData read GetStageData;
     property ShowParentData: Boolean read FShowParentData write FShowParentData;
@@ -91,7 +94,7 @@ implementation
 
 uses
   ProjectData, PhaseData, Math, ZhAPI, BillsCommand, BGLSelectFrm,
-  BGLDm, UtilMethods, mDataRecord, ConstUnit, Variants;
+  BGLDm, UtilMethods, mDataRecord, ConstUnit, Variants, ConditionalDefines;
 
 {$R *.dfm}
 
@@ -431,7 +434,7 @@ procedure TBillsMeasureData.sdvBillsMeasureSetText(var Text: String;
 var
   vNode: TBillsIDTreeNode;
 begin
-  if not Assigned(AValue) then Exit;
+  {if not Assigned(AValue) then Exit;
   // 修改后数据与原数据相同则不提交
   if not CheckValidData then
     Allow := False;
@@ -447,7 +450,7 @@ begin
 
   Text := Trim(Text);
   if Pos('=', Text) = 1 then
-    Text := Copy(Text, 2, Length(Text) - 1);
+    Text := Copy(Text, 2, Length(Text) - 1);  }
 
   DoCurChanged(vNode);
 end;
@@ -1172,4 +1175,43 @@ begin
   end;
 end;
 
+function TBillsMeasureData.CheckNodeGatherCalc(
+  ANode: TMeasureBillsIDTreeNode): Boolean;
+var
+  fLeafSumDeal, fLeafSumQc, fLeafSumGather: Double;
+  i, iCount: Integer;
+  vChild: TMeasureBillsIDTreeNode;
+begin
+  if Assigned(ANode.StageRec) then
+  begin
+    fLeafSumDeal := 0;
+    fLeafSumQc := 0;
+    fLeafSumGather := 0;
+    iCount := ANode.PosterityCount;
+    i := 0;
+    vChild := TMeasureBillsIDTreeNode(ANode.NextNode);
+    while i < iCount do
+    begin
+      if not vChild.HasChildren and Assigned(vChild.StageRec) then
+      begin
+        fLeafSumDeal := fLeafSumDeal + vChild.StageRec.DealTotalPrice.AsFloat;
+        fLeafSumQc := fLeafSumQc + vChild.StageRec.QcTotalPrice.AsFloat;
+        fLeafSumGather := fLeafSumGather + vChild.StageRec.GatherTotalPrice.AsFloat;
+      end;
+      vChild := TMeasureBillsIDTreeNode(vChild.NextNode);
+      Inc(i);
+    end;
+    Result := Decimal.TotalPrice.CheckSameNum(fLeafSumDeal, ANode.StageRec.DealTotalPrice.AsFloat) and
+              Decimal.TotalPrice.CheckSameNum(fLeafSumQc, ANode.StageRec.QcTotalPrice.AsFloat) and
+              Decimal.TotalPrice.CheckSameNum(fLeafSumGather, ANode.StageRec.GatherTotalPrice.AsFloat);
+  end
+  else
+    Result := True;
+end;
+
+function TBillsMeasureData.GetDecimal: TCalcDecimal;
+begin
+  Result := TProjectData(FProjectData).ProjProperties.DecimalManager.Common;
+end;
+
 end.

Units/CalcDecimal.pas

@@ -23,6 +23,7 @@ type
 
     function RoundTo(AValue: Double): Double;
     function StrRoundTo(const AValue: string): string;
+    function CheckSameNum(AValue1, AValue2: Double): Boolean;
 
     procedure ClearLinkViewCols;
     procedure AddLinkViewCol(ACol: TObject);
@@ -78,7 +79,7 @@ type
 implementation
 
 uses
-  ProjectData, UtilMethods, SysUtils;
+  ProjectData, UtilMethods, SysUtils, Math;
 
 { TDecimal }
 
@@ -87,6 +88,11 @@ begin
   FLinkViewCols.Add(ACol);
 end;
 
+function TDecimal.CheckSameNum(AValue1, AValue2: Double): Boolean;
+begin
+  Result := Abs(RoundTo(AValue1 - AValue2)) < CompareValue;
+end;
+
 procedure TDecimal.ClearLinkViewCols;
 begin
   FLinkViewCols.Clear;

Units/ProjectData.pas

@@ -88,6 +88,7 @@ type
     procedure CloseAllData;
     procedure OpenAllData;
 
+    procedure CheckCalcBeforeSave;
     procedure InnerSave;
 
     procedure LoadCheckersData;
@@ -268,7 +269,8 @@ implementation
 uses UtilMethods, Globals, ProjectCommands, sdIDTree, StageDm,
   ZJJLDm, PHPWebDm, XMLDoc, XMLIntf, ConstUnit, PasswordInputFrm,
   mProgressProFrm, mDataRecord, ConditionalDefines, DbTreeImport,
-  StrUtils, sdProvider, CalcDecimal, Math, CslJson, OrderCheckerFme;
+  StrUtils, sdProvider, CalcDecimal, Math, CslJson, OrderCheckerFme,
+  Forms, ProgressHintFrm, BillsTree, Controls;
 
 { TProjectData }
 
@@ -2124,6 +2126,8 @@ begin
   try
     AppendProjectLog('Save Main Data');
 
+    CheckCalcBeforeSave;
+
     UpdateSysProgress(5, '正在保存数据');
     SaveLastestPhaseMainData;
     UpdateSysProgress(10, '正在保存数据');
@@ -2210,4 +2214,37 @@ begin
   end
 end;
 
+procedure TProjectData.CheckCalcBeforeSave;
+
+  function NeedReCalc: Boolean;
+  var
+    vTopNode: TsdIDTreeNode;
+  begin
+    Result := False;
+    vTopNode := BillsMeasureData.BillsMeasureTree.FirstNode;
+    while not Result and Assigned(vTopNode) do
+    begin
+      if not BillsMeasureData.CheckNodeGatherCalc(TMeasureBillsIDTreeNode(vTopNode)) then
+        Result := True;
+      vTopNode := vTopNode.NextSibling;
+    end;
+  end;
+
+var
+  i: Integer;
+  fLeafSum, fTopParent: Double;
+begin
+  if PhaseData.Active and (not StageDataReadOnly) and NeedReCalc then
+  begin
+    Screen.Cursor := crHourGlass;
+    try
+      ShowProgressHint('检查到有需要计算的清单，请稍候...');
+      CalculateAll;
+      CloseProgressHint;
+    finally
+      Screen.Cursor := crDefault;
+    end;
+  end;
+end;
+
 end.