计量方式调整。允许直接输入金额，且区分数量单价模式与金额计算模式。

DataModules/BillsCompileDm.pas

@@ -50,6 +50,8 @@ type
 
     function GatherChildren(ANode: TsdIDTreeNode; const AFieldName: string): Double;
     procedure UpdateParent(ABillsID: Integer; ADifferTotalPrice: Double; const AFieldName: string);
+    // 经济指标[与其他节点无关]
+    procedure CalculateDesignPrice(ANode: TBillsIDTreeNode);
     // 施工图原设计[增量]
     procedure CalculateOrg(ABillsID: Integer);
     // 设计错漏增减[增量]
@@ -143,15 +145,38 @@ end;
 procedure TBillsCompileData.sdvBillsCompileGetText(var Text: String;
   ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
   DisplayText: Boolean);
-var
-  fDgnPrice: Double;
-begin
-  if (Pos('Price', AColumn.FieldName) > 0) or
-     (Pos('Quantity', AColumn.FieldName) > 0) then
+
+  procedure GetEditText;
+  var
+    sFormula: string;
+  begin
+    if SameText('OrgQuantity', AColumn.FieldName) then
+      sFormula := ARecord.ValueByName('OrgFormula').AsString
+    else if SameText('MisQuantity', AColumn.FieldName) then
+      sFormula := ARecord.ValueByName('MisFormula').AsString
+    else if SameText('OthQuantity', AColumn.FieldName) then
+      sFormula := ARecord.ValueByName('OthFormula').AsString
+    else
+      sFormula := '';
+    if sFormula <> '' then
+      Text := sFormula;
+  end;
+
+  procedure GetDisplayText;
   begin
-    if Assigned(AValue) and (AValue.AsFloat = 0) then
-      Text := '';
+    if (Pos('Price', AColumn.FieldName) > 0) or
+       (Pos('Quantity', AColumn.FieldName) > 0) then
+    begin
+      if Assigned(AValue) and (AValue.AsFloat = 0) then
+        Text := '';
+    end;
   end;
+
+begin
+  if DisplayText then
+    GetDisplayText
+  else
+    GetEditText;
 end;
 
 procedure TBillsCompileData.ExpandNodeTo(ALevel: Integer);
@@ -190,11 +215,14 @@ procedure TBillsCompileData.sdvBillsCompileAfterValueChanged(
 var
   stnNode: TsdIDTreeNode;
 begin
-  if SameText(AValue.FieldName, 'OrgQuantity') then
+  if SameText(AValue.FieldName, 'OrgQuantity') or
+      SameText(AValue.FieldName, 'OrgTotalPrice') then
     CalculateOrg(AValue.Owner.ValueByName('ID').AsInteger)
-  else if SameText(AValue.FieldName, 'MisQuantity') then
+  else if SameText(AValue.FieldName, 'MisQuantity') or
+      SameText(AValue.FieldName, 'MisTotalPrice') then
     CalculateMis(AValue.Owner.ValueByName('ID').AsInteger)
-  else if SameText(AValue.FieldName, 'OthQuantity') then
+  else if SameText(AValue.FieldName, 'OthQuantity') or
+      SameText(AValue.FieldName, 'OthTotalPrice') then
     CalculateOth(AValue.Owner.ValueByName('ID').AsInteger)
   else if SameText(AValue.FieldName, 'Price') or
       SameText(AValue.FieldName, 'DgnQuantity1') then
@@ -282,6 +310,18 @@ begin
 
   if SameText(AValue.FieldName, 'ParentID') then
     FBeforeChangeParentID := AValue.AsInteger;
+  if SameText(AValue.FieldName, 'OrgQuantity') or
+      SameText(AValue.FieldName, 'MisQuantity') or
+      SameText(AValue.FieldName, 'OthQuantity') or
+      SameText(AValue.FieldName, 'OrgTotalPrice') or
+      SameText(AValue.FieldName, 'MisTotalPrice') or
+      SameText(AValue.FieldName, 'OthTotalPrice') or
+      SameText(AValue.FieldName, 'Price') then
+  begin
+    TBillsRecord(AValue.Owner).CacheOrgTP := AValue.Owner.ValueByName('OrgTotalPrice').AsFloat;
+    TBillsRecord(AValue.Owner).CacheMisTP := AValue.Owner.ValueByName('MisTotalPrice').AsFloat;
+    TBillsRecord(AValue.Owner).CacheOthTP := AValue.Owner.ValueByName('OthTotalPrice').AsFloat;
+  end;
 end;
 
 procedure TBillsCompileData.CalculateAll;
@@ -525,13 +565,23 @@ procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String;
     Allow := False;
   end;
 
-  procedure SetQuantity;
+  procedure SetQuantity(const APre: string);
   begin
-    // 0号台账改为三项合计后，不记录输入的功能，但允许公式计算
+    // 0号台账改为三项合计后，不记录输入的公式，但允许公式计算
     if CheckStringNull(Text) or CheckNumeric(Text) then
       Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
     else
+    begin
+      ARecord.ValueByName(APre + 'Formula').AsString := Text;
       Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
+    end;
+    ARecord.ValueByName('CalcType').AsInteger := 0;
+  end;
+
+  procedure SetTotalPrice;
+  begin
+    Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
+    ARecord.ValueByName('CalcType').AsInteger := 1;
   end;
 
   procedure SetDgnQuantity;
@@ -546,10 +596,16 @@ procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String;
 
   procedure DoCurChanged;
   begin
-    if SameText(AColumn.FieldName, 'OrgQuantity') or
-       SameText(AColumn.FieldName, 'MisQuantity') or
-       SameText(AColumn.FieldName, 'OthQuantity') then
-      SetQuantity
+    if SameText(AColumn.FieldName, 'OrgQuantity') then
+      SetQuantity('Org')
+    else if SameText(AColumn.FieldName, 'MisQuantity') then
+      SetQuantity('Mis')
+    else if SameText(AColumn.FieldName, 'OthQuantity') then
+      SetQuantity('Oth')
+    else if SameText(AColumn.FieldName, 'OrgTotalPrice') or
+        SameText(AColumn.FieldName, 'MisTotalPrice') or
+        SameText(AColumn.FieldName, 'OthTotalPrice') then
+      SetTotalPrice
     else if Pos('DgnQuantity', AColumn.FieldName) = 1 then
       SetDgnQuantity
     else if SameText(AColumn.FieldName, 'Price') then
@@ -576,28 +632,45 @@ procedure TBillsCompileData.sdvBillsCompileSetText(var Text: String;
 
   procedure CheckNodeWritable;
   var
-    vNode: TsdIDTreeNode;
+    vNode: TBillsIDTreeNode;
     iCreatePhase: Integer;
   begin
     if not Allow then Exit;
-    vNode := BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger);
+    vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ARecord.ValueByName('ID').AsInteger));
     iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
 
     if vNode.HasChildren then
     begin
       if Text = '' then
         Exit
-      else if (SameText('Quantity', AColumn.FieldName)) or
-          (SameText('TotalPrice', AColumn.FieldName)) then
+      else if (Pos('Quantity', AColumn.FieldName) > 0) or
+          (Pos('TotalPrice', AColumn.FieldName) > 0) then
         SetTextErrorHint('该清单有子计算项，不能直接修改！')
       else if (Pos('Price', AColumn.FieldName) > 0) then
         SetTextErrorHint('仅最底层清单可输入单价！');
+      if not Allow then Exit;
     end
     else
-      if (Pos('TotalPrice', AColumn.FieldName) > 0) and
-          (vNode.Rec.ValueByName('Price').AsFloat <> 0) then
-        SetTextErrorHint('不可直接输入！如需直接输入金额，请先删除清单单价！');
-    if not Allow then Exit;
+    begin
+      if SameText('OrgTotalPrice', AColumn.FieldName) or
+          SameText('MisTotalPrice', AColumn.FieldName) or
+          SameText('OthTotalPrice', AColumn.FieldName) then
+      begin
+        if not vNode.TotalPriceEnable then
+          SetTextErrorHint('该清单不可直接输入金额，如需直接输入金额，请先清空所有数量、单价！');
+      end;
+      if not Allow then Exit;
+
+      if SameText('Price', AColumn.FieldName) or
+          SameText('OrgQuantity', AColumn.FieldName) or
+          SameText('MisQuantity', AColumn.FieldName) or
+          SameText('OthQuantity', AColumn.FieldName) then
+      begin
+        if not vNode.CountPriceEnable then
+          SetTextErrorHint('该清单不可输入数量单价，如需使用数量×单价计算，请先清空所有直接输入的金额！');
+      end;
+      if not Allow then Exit;
+    end;
 
     if SameText('Code', AColumn.FieldName) or
        SameText('B_Code', AColumn.FieldName) or
@@ -614,6 +687,8 @@ begin
   if AValue.AsString = Text then Exit;
 
   CheckLockedData;
+  if not Allow then Exit;
+
   CheckNodeWritable;
   if not Allow then Exit;
 
@@ -738,7 +813,6 @@ end;
 procedure TBillsCompileData.CalculateMis(ABillsID: Integer);
 var
   vNode: TBillsIDTreeNode;
-  fTotalPrice: Double;
   iChild: Integer;
 begin
   vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
@@ -753,11 +827,14 @@ begin
   begin
     with vNode.Rec do
     begin
-      fTotalPrice := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
-      if MisTotalPrice.AsFloat <> fTotalPrice then
+      // 数量单价模式则计算金额
+      if CalcType.AsInteger = 0 then
+        MisTotalPrice.AsFloat := TotalPriceRoundTo(MisQuantity.AsFloat * Price.AsFloat);
+
+      // 金额与修改前不一样，则向父项增量
+      if MisTotalPrice.AsFloat <> CacheMisTP then
       begin
-        UpdateParent(vNode.ParentID, fTotalPrice - MisTotalPrice.AsFloat, 'MisTotalPrice');
-        MisTotalPrice.AsFloat := fTotalPrice;
+        UpdateParent(vNode.ParentID, MisTotalPrice.AsFloat - CacheMisTP, 'MisTotalPrice');
         Quantity.AsFloat := QuantityRoundTo(
             OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
         TotalPrice.AsFloat := TotalPriceRoundTo(
@@ -766,17 +843,12 @@ begin
     end;
   end;
 
-  if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
-    vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
-        vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
-  else
-    vNode.Rec.DgnPrice.AsFloat := 0;
+  CalculateDesignPrice(vNode);
 end;
 
 procedure TBillsCompileData.CalculateOrg(ABillsID: Integer);
 var
   vNode: TBillsIDTreeNode;
-  fTotalPrice: Double;
   iChild: Integer;
 begin
   vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
@@ -791,11 +863,14 @@ begin
   begin
     with vNode.Rec do
     begin
-      fTotalPrice := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
-      if OrgTotalPrice.AsFloat <> fTotalPrice then
+      // 数量单价模式则计算金额
+      if CalcType.AsInteger = 0 then
+        OrgTotalPrice.AsFloat := TotalPriceRoundTo(OrgQuantity.AsFloat * Price.AsFloat);
+
+      // 金额与修改前不一样，则向父项增量
+      if CacheOrgTP <> OrgTotalPrice.AsFloat then
       begin
-        UpdateParent(vNode.ParentID, fTotalPrice - OrgTotalPrice.AsFloat, 'OrgTotalPrice');
-        OrgTotalPrice.AsFloat := fTotalPrice;
+        UpdateParent(vNode.ParentID, OrgTotalPrice.AsFloat - CacheOrgTP, 'OrgTotalPrice');
         Quantity.AsFloat := QuantityRoundTo(
             OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
         TotalPrice.AsFloat := TotalPriceRoundTo(
@@ -804,17 +879,12 @@ begin
     end;
   end;
 
-  if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
-    vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
-        vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
-  else
-    vNode.Rec.DgnPrice.AsFloat := 0;
+  CalculateDesignPrice(vNode);
 end;
 
 procedure TBillsCompileData.CalculateOth(ABillsID: Integer);
 var
   vNode: TBillsIDTreeNode;
-  fTotalPrice: Double;
   iChild: Integer;
 begin
   vNode := TBillsIDTreeNode(BillsCompileTree.FindNode(ABillsID));
@@ -829,11 +899,14 @@ begin
   begin
     with vNode.Rec do
     begin
-      fTotalPrice := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
-      if OthTotalPrice.AsFloat <> fTotalPrice then
+      // 数量单价模式则计算金额
+      if CalcType.AsInteger = 0 then
+        OthTotalPrice.AsFloat := TotalPriceRoundTo(OthQuantity.AsFloat * Price.AsFloat);
+
+      // 金额与修改前不一样，则向父项增量
+      if OthTotalPrice.AsFloat <> CacheOthTP then
       begin
-        UpdateParent(vNode.ParentID, fTotalPrice - OthTotalPrice.AsFloat, 'OthTotalPrice');
-        OthTotalPrice.AsFloat := fTotalPrice;
+        UpdateParent(vNode.ParentID, OthTotalPrice.AsFloat - CacheOthTP, 'OthTotalPrice');
         Quantity.AsFloat := QuantityRoundTo(
             OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
         TotalPrice.AsFloat := TotalPriceRoundTo(
@@ -842,11 +915,7 @@ begin
     end;
   end;
 
-  if vNode.Rec.DgnQuantity1.AsFloat <> 0 then
-    vNode.Rec.DgnPrice.AsFloat := PriceRoundTo(
-        vNode.Rec.TotalPrice.AsFloat/vNode.Rec.DgnQuantity1.AsFloat)
-  else
-    vNode.Rec.DgnPrice.AsFloat := 0;
+  CalculateDesignPrice(vNode);
 end;
 
 function TBillsCompileData.GatherChildren(ANode: TsdIDTreeNode;
@@ -882,9 +951,8 @@ begin
     ValueByName(AFieldName).AsFloat := TotalPriceRoundTo(
         ValueByName(AFieldName).AsFloat + ADifferTotalPrice);
     TotalPrice.AsFloat := TotalPriceRoundTo(TotalPrice.AsFloat + ADifferTotalPrice);
-    if DgnQuantity1.AsFloat <> 0 then
-      DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
   end;
+  CalculateDesignPrice(vNode);
   UpdateParent(vNode.ParentID, ADifferTotalPrice, AFieldName);
 end;
 
@@ -918,18 +986,19 @@ begin
   with ANode.Rec do
   begin
     // 分项
-    OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
-    MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
-    OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
+    if CalcType.AsFloat = 0 then
+    begin
+      OrgTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OrgQuantity.AsFloat);
+      MisTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * MisQuantity.AsFloat);
+      OthTotalPrice.AsFloat := TotalPriceRoundTo(Price.AsFloat * OthQuantity.AsFloat);
+    end;
     // 汇总
     Quantity.AsFloat := QuantityRoundTo(
         OrgQuantity.AsFloat + MisQuantity.AsFloat + OthQuantity.AsFloat);
     TotalPrice.AsFloat := TotalPriceRoundTo(
         OrgTotalPrice.AsFloat + MisTotalPrice.AsFloat + OthTotalPrice.AsFloat);
-    // 经济指标
-    if DgnQuantity1.AsFloat <> 0 then
-      DgnPrice.AsFloat := PriceRoundTo(TotalPrice.AsFloat/DgnQuantity1.AsFloat);
   end;
+  CalculateDesignPrice(ANode);
 end;
 
 procedure TBillsCompileData.GatherNode(ANode: TBillsIDTreeNode);
@@ -953,9 +1022,7 @@ begin
   ANode.Rec.OthTotalPrice.AsFloat := TotalPriceRoundTo(fOth);
   ANode.Rec.TotalPrice.AsFloat := TotalPriceRoundTo(fOrg + fMis + fOth);
 
-  if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
-    ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
-        ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat);
+  CalculateDesignPrice(ANode);
 end;
 
 procedure TBillsCompileData.Calculate(ABillsID: Integer);
@@ -999,4 +1066,13 @@ begin
   UpdateParent(TBillsIDTreeNode(vNode.Parent), fOrg, fMis, fOth);
 end;
 
+procedure TBillsCompileData.CalculateDesignPrice(ANode: TBillsIDTreeNode);
+begin
+  if ANode.Rec.DgnQuantity1.AsFloat <> 0 then
+    ANode.Rec.DgnPrice.AsFloat := PriceRoundTo(
+        ANode.Rec.TotalPrice.AsFloat/ANode.Rec.DgnQuantity1.AsFloat)
+  else
+    ANode.Rec.DgnPrice.Clear;
+end;
+
 end.

DataModules/BillsDm.dfm

@@ -198,6 +198,17 @@ object BillsData: TBillsData
       02080549734B6579080F4E65656450726F636573734E616D65090001044E616D
       65060D4861734174746163686D656E74094669656C644E616D65060D48617341
       74746163686D656E740844617461547970650205084461746153697A65020105
-      49734B6579080F4E65656450726F636573734E616D65090000}
+      49734B6579080F4E65656450726F636573734E616D65090001044E616D650608
+      43616C6354797065094669656C644E616D65060843616C635479706508446174
+      61547970650203084461746153697A6502040549734B6579080F4E6565645072
+      6F636573734E616D65090001044E616D65060A4F7267466F726D756C61094669
+      656C644E616D65060A4F7267466F726D756C6108446174615479706502180844
+      61746153697A6503C8000549734B6579080F4E65656450726F636573734E616D
+      65090001044E616D65060A4D6973466F726D756C61094669656C644E616D6506
+      0A4D6973466F726D756C610844617461547970650218084461746153697A6503
+      C8000549734B6579080F4E65656450726F636573734E616D65090001044E616D
+      65060A4F7468466F726D756C61094669656C644E616D65060A4F7468466F726D
+      756C610844617461547970650218084461746153697A6503C8000549734B6579
+      080F4E65656450726F636573734E616D65090000}
   end
 end

DataModules/BillsMeasureDm.pas

@@ -282,10 +282,10 @@ procedure TBillsMeasureData.sdvBillsMeasureSetText(var Text: String;
 
   procedure CheckNodeWritable;
   var
-    vNode: TsdIDTreeNode;
+    vNode: TBillsIDTreeNode;
     iCreatePhase: Integer;
   begin
-    vNode := BillsMeasureTree.FindNode(GetBillsID);
+    vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GetBillsID));
     iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
 
     if SameText('B_Code', AColumn.FieldName) or
@@ -316,9 +316,21 @@ procedure TBillsMeasureData.sdvBillsMeasureSetText(var Text: String;
         DataSetErrorMessage(Allow, '仅最底层清单可输入单价！');
     end
     else
-      if (Pos('TotalPrice', AColumn.FieldName) > 0) and
-          (vNode.Rec.ValueByName('Price').AsFloat <> 0) then
-        DataSetErrorMessage(Allow, '不可直接输入！如需直接输入金额，请先删除清单单价！');
+    begin
+      // 目前仅允许本期合同计量，可直接输入金额
+      if SameText('CurDealTotalPrice', AColumn.FieldName) then
+      begin
+        if not vNode.TotalPriceEnable then
+          DataSetErrorMessage(Allow, '该清单不可直接输入金额，如需直接输入金额，请先清空所有数量、单价！');
+      end
+      else if SameText('CurDealQuantity', AColumn.FieldName) or
+          SameText('CurQcQuantity', AColumn.FieldName) or
+          SameText('CurPcQuantity', AColumn.FieldName) then
+      begin
+        if not vNode.CountPriceEnable then
+          DataSetErrorMessage(Allow, '该清单不可输入数量单价，如需使用数量×单价计算，请先清空所有直接输入的金额！');
+      end;
+    end;
     if not Allow then Exit;
     // 变更清单允许填写本期合同计量，按超计论
     {if vNode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
@@ -498,9 +510,22 @@ procedure TBillsMeasureData.sdvBillsMeasureNeedLookupRecord(
       else
         DataSetErrorMessage(Result, '该清单有子计算项，不能直接修改！');
     end
-    else if (Pos('TotalPrice', AColumn.FieldName) > 0) and
-        (ANode.Rec.ValueByName('Price').AsFloat <> 0) then
-      DataSetErrorMessage(Result, '不可直接输入！如需直接输入金额，请先删除清单单价！');
+    else
+    begin
+      // 目前仅允许本期合同计量，可直接输入金额
+      if SameText('CurDealTotalPrice', AColumn.FieldName) then
+      begin
+        if not ANode.TotalPriceEnable then
+          DataSetErrorMessage(Result, '该清单不可直接输入金额，如需直接输入金额，请先清空所有数量、单价！');
+      end
+      else if SameText('CurDealQuantity', AColumn.FieldName) or
+          SameText('CurQcQuantity', AColumn.FieldName) or
+          SameText('CurPcQuantity', AColumn.FieldName) then
+      begin
+        if not ANode.CountPriceEnable then
+          DataSetErrorMessage(Result, '该清单不可输入数量单价，如需使用数量×单价计算，请先清空所有直接输入的金额！');
+      end;
+    end;
 
     // 变更清单允许填写本期合同计量，按超计论
     {iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;

DataModules/StageDm.pas

@@ -39,9 +39,11 @@ type
 
     function GetTotalPrice(ABillsID, AType, AStageIndex: Integer): Double;
 
+    function GetCalcType(ABillsID: Integer): Integer;
     function GetBillsPrice(ABillsID: Integer): Double;
     function GetBillsNewPrice(ABillsID: Integer): Double;
     function GetBillsPriceDiffer(ABillsID: Integer): Double;
+
     function GetMainBillsTree: TBillsIDTree;
     function GetBuildLoadInterest(AType, AIndex: Integer): Double;
     function GetFirstPart(AType, AIndex: Integer): Double;
@@ -164,7 +166,7 @@ var
   fQtyDiffer, fTPDiffer: Double;
 begin
   Rec := sddStage.FindKey('idxBID', ABillsID);
-  if Rec.ValueByName('DealFlag').AsInteger < 2 then
+  if GetCalcType(ABillsID) = 0 then
     Rec.ValueByName('DealTotalPrice').AsFloat :=
         TotalPriceRoundTo(Rec.ValueByName('DealQuantity').AsFloat * GetBillsPrice(ABillsID));
 
@@ -177,10 +179,12 @@ begin
       Rec.ValueByName('EndDealTotalPrice').AsFloat + fTPDiffer);
 
   UpdateParentRecord(ABillsID, fTPDiffer, 'DealTotalPrice');
+
   UpdateComplete(ABillsID, fQtyDiffer, fTPDiffer);
   if TPhaseData(FPhaseData).IsLastStage then
     with TProjectData(TPhaseData(FPhaseData).ProjectData).BillsMeasureData do
       UpdateRecordDeal(ABillsID, fQtyDiffer, fTPDiffer);
+
   TPhaseData(FPhaseData).PhasePayData.CalculateAll;
 end;
 
@@ -190,7 +194,7 @@ var
   fQtyDiffer, fTPDiffer: Double;
 begin
   Rec := sddStage.FindKey('idxBID', ABillsID);
-  if Rec.ValueByName('PcFlag').AsInteger < 2 then
+  if GetCalcType(ABillsID) < 2 then
     Rec.ValueByName('PcTotalPrice').AsFloat :=
         TotalPriceRoundTo(Rec.ValueByName('PcQuantity').AsFloat * GetBillsPriceDiffer(ABillsID));
 
@@ -216,7 +220,7 @@ var
   fQtyDiffer, fTPDiffer: Double;
 begin
   Rec := sddStage.FindKey('idxBID', ABillsID);
-  if Rec.ValueByName('QcFlag').AsInteger < 2 then
+  if GetCalcType(ABillsID) = 0 then
     Rec.ValueByName('QcTotalPrice').AsFloat :=
         TotalPriceRoundTo(Rec.ValueByName('QcQuantity').AsFloat * GetBillsPrice(ABillsID));
 
@@ -350,7 +354,7 @@ begin
   iBillsID := AValue.Owner.ValueByName('BillsID').AsInteger;
   stnNode := MainBillsTree.FindNode(iBillsID);
   if not Assigned(stnNode) or stnNode.HasChildren then Exit;
-  
+
   if (AValue.FieldName = 'DealQuantity') or
      (AValue.FieldName = 'DealFormula') or
      (AValue.FieldName = 'DealTotalPrice') then
@@ -655,22 +659,19 @@ end;
 procedure TStageData.CalculateLeaf(ANode: TBillsIDTreeNode);
 
   procedure CalculateMeasure(ARec: TsdDataRecord; const AType: string);
-  var
-    fPrice: Double;
   begin
-    if ARec.ValueByName(AType + 'Flag').AsInteger = 1 then
-      ARec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(
-          EvaluateExprs(ARec.ValueByName(AType + 'Formula').AsString));
-    if ARec.ValueByName(AType + 'Flag').AsInteger < 2 then
+    if GetCalcType(ANode.ID) = 0 then
     begin
-      fPrice := GetBillsPrice(ARec.ValueByName('BillsID').AsInteger);
+      if ARec.ValueByName(AType + 'Formula').AsString <> '' then
+        ARec.ValueByName(AType + 'Quantity').AsFloat :=
+            EvaluateExprs(ARec.ValueByName(AType + 'Formula').AsString);
       ARec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
-        ARec.ValueByName(AType + 'Quantity').AsFloat * fPrice);
+          ARec.ValueByName(AType + 'Quantity').AsFloat * GetBillsPrice(ANode.ID));
     end;
     ARec.ValueByName('End' + AType + 'Quantity').AsFloat := QuantityRoundTo(
-      ARec.ValueByName('Pre' + AType + 'Quantity').AsFloat + ARec.ValueByName(AType + 'Quantity').AsFloat);
+        ARec.ValueByName('Pre' + AType + 'Quantity').AsFloat + ARec.ValueByName(AType + 'Quantity').AsFloat);
     ARec.ValueByName('End' + AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(
-      ARec.ValueByName('Pre' + AType + 'TotalPrice').AsFloat + ARec.ValueByName(AType + 'TotalPrice').AsFloat);
+        ARec.ValueByName('Pre' + AType + 'TotalPrice').AsFloat + ARec.ValueByName(AType + 'TotalPrice').AsFloat);
   end;
 
 var
@@ -745,4 +746,9 @@ begin
   end;
 end;
 
+function TStageData.GetCalcType(ABillsID: Integer): Integer;
+begin
+  Result := MainBillsTree.FindNode(ABillsID).Rec.ValueByName('CalcType').AsInteger;
+end;
+
 end.

Frames/BGLFme.dfm

@@ -88,6 +88,8 @@ object BGLFrame: TBGLFrame
       DefaultFixedRowHeight = 25
       Selection.AlphaBlend = False
       Selection.TransparentColor = False
+      FrozenCol = 0
+      FrozenRow = 0
       OnMouseDown = zgBGBillsMouseDown
       Align = alClient
     end
@@ -123,6 +125,8 @@ object BGLFrame: TBGLFrame
         DefaultFixedRowHeight = 25
         Selection.AlphaBlend = False
         Selection.TransparentColor = False
+        FrozenCol = 0
+        FrozenRow = 0
         OnCopy = zgBGLCopy
         OnPaste = zgBGLPaste
         OnMouseDown = zgBGLMouseDown

Frames/BillsCompileFme.dfm

@@ -372,7 +372,7 @@ object BillsCompileFrame: TBillsCompileFrame
         Font.Style = []
         FieldName = 'OrgTotalPrice'
         Width = 60
-        ReadOnly = True
+        ReadOnly = False
       end
       item
         Title.Caption = '|'#35774#35745#38169#28431#22686#20943'|'#25968#37327
@@ -409,7 +409,7 @@ object BillsCompileFrame: TBillsCompileFrame
         Font.Style = []
         FieldName = 'MisTotalPrice'
         Width = 60
-        ReadOnly = True
+        ReadOnly = False
       end
       item
         Title.Caption = '|'#20854#20182#38169#28431#22686#20943'|'#25968#37327
@@ -445,7 +445,7 @@ object BillsCompileFrame: TBillsCompileFrame
         Font.Style = []
         FieldName = 'OthTotalPrice'
         Width = 60
-        ReadOnly = True
+        ReadOnly = False
       end
       item
         Title.Caption = '|'#23567#35745'|'#25968#37327

Frames/BillsCompileFme.pas

@@ -84,7 +84,7 @@ type
     procedure ResetBaseDataReadOnly(AReadOnly: Boolean);
     procedure ResetAllowInsert(AAllow: Boolean);
 
-    function CheckExprsColumn(ACol: Integer): Boolean;
+    function CheckExprsColumn: Boolean;
     procedure SetShowDesignQuantity(const Value: Boolean);
     procedure SetShowAlias(const Value: Boolean);
   public
@@ -223,7 +223,7 @@ begin
     dxpmBillsCompile.PopupFromCursorPos
   else
   begin
-    if zgBillsCompile.CurCell.Col >= stdBillsCompile.VisibleCol('Quantity') then
+    if CheckExprsColumn then
       laEdtExprs.Text := zgBillsCompile.CurCell.EditText
     else
       laEdtExprs.Text := '';
@@ -272,14 +272,18 @@ end;
 procedure TBillsCompileFrame.laEdtExprsExit(Sender: TObject);
 begin
   if not TLabeledEdit(Sender).ReadOnly then
-    if CheckExprsColumn(zgBillsCompile.CurCol) then
+    if CheckExprsColumn then
       zgBillsCompile.CurCell.Text := laEdtExprs.Text;
 end;
 
-function TBillsCompileFrame.CheckExprsColumn(ACol: Integer): Boolean;
+function TBillsCompileFrame.CheckExprsColumn: Boolean;
+var
+  iCol: Integer;
 begin
-  Result := (ACol = stdBillsCompile.VisibleCol('Quantity')) or
-      (ACol = stdBillsCompile.VisibleCol('TotalPrice'));
+  iCol := zgBillsCompile.CurCol-zgBillsCompile.FixedColCount;
+  Result := (iCol = stdBillsCompile.VisibleCol('OrgQuantity'))
+         or (iCol = stdBillsCompile.VisibleCol('MisQuantity'))
+         or (iCol = stdBillsCompile.VisibleCol('OthQuantity'));
 end;
 
 procedure TBillsCompileFrame.laEdtExprsKeyDown(Sender: TObject;
@@ -289,7 +293,7 @@ begin
   begin
     zgBillsCompile.SetFocus;
     if not TLabeledEdit(Sender).ReadOnly then
-      if CheckExprsColumn(zgBillsCompile.CurCol) then
+      if CheckExprsColumn then
         zgBillsCompile.CurCell.Text := laEdtExprs.Text;
   end;
 end;

Frames/BillsMeasureFme.pas

@@ -59,7 +59,7 @@ type
     FOnAfterSetBookmark: TBookmarkRefreshEvent;
     FShowAlias: Boolean;
 
-    function CheckExprsColumn(ACol: Integer): Boolean;
+    function CheckExprsColumn: Boolean;
 
     procedure SetColumnVisible(const AColumn: string; AVisible: Boolean);
     procedure SetAddFieldVisiblie(AValue: Boolean);
@@ -128,16 +128,20 @@ end;
 
 procedure TBillsMeasureFrame.zgBillsMeasureMouseDown(Sender: TObject;
   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+var
+  vCol: TsdGridColumn;
+  vViewCol: TsdViewColumn;
 begin
   if Button = mbRight then
     dxpmBills.PopupFromCursorPos
   else
   begin
-    if zgBillsMeasure.CurCell.Col >= stdBillsMeasure.VisibleCol('Quantity') then
+    if CheckExprsColumn then
       laEdtExprs.Text := zgBillsMeasure.CurCell.EditText
     else
       laEdtExprs.Text := '';
-    laEdtExprs.ReadOnly := stdBillsMeasure.Columns.Items[zgBillsMeasure.CurCol].ReadOnly;
+    stdBillsMeasure.FindColumn(zgBillsMeasure.CurCol, vCol);
+    laEdtExprs.ReadOnly := vCol.ReadOnly;
   end;
 end;
 
@@ -161,7 +165,7 @@ begin
   begin
     zgBillsMeasure.SetFocus;
     if not TLabeledEdit(Sender).ReadOnly then
-      if CheckExprsColumn(zgBillsMeasure.CurCol) then
+      if CheckExprsColumn then
         zgBillsMeasure.CurCell.Text := laEdtExprs.Text;
   end;
 end;
@@ -169,7 +173,7 @@ end;
 procedure TBillsMeasureFrame.laEdtExprsExit(Sender: TObject);
 begin
   if not TLabeledEdit(Sender).ReadOnly then
-    if CheckExprsColumn(zgBillsMeasure.CurCol) then
+    if CheckExprsColumn then
       zgBillsMeasure.CurCell.Text := laEdtExprs.Text;
 end;
 
@@ -264,14 +268,17 @@ begin
   end;
 end;
 
-function TBillsMeasureFrame.CheckExprsColumn(ACol: Integer): Boolean;
+function TBillsMeasureFrame.CheckExprsColumn: Boolean;
+var
+  iCol: Integer;
 begin
-  Result := (ACol = stdBillsMeasure.VisibleCol('CurDealQuantity')) or
-      (ACol = stdBillsMeasure.VisibleCol('CurDealTotalPrice')) or
-      (ACol = stdBillsMeasure.VisibleCol('CurQcQuantity')) or
-      (ACol = stdBillsMeasure.VisibleCol('CurQcTotalPrice')) or
-      (ACol = stdBillsMeasure.VisibleCol('CurPcQuantity')) or
-      (ACol = stdBillsMeasure.VisibleCol('CurPcTotalPrice'));
+  iCol := zgBillsMeasure.CurCol - zgBillsMeasure.FixedColCount;
+  Result := (iCol = stdBillsMeasure.VisibleCol('CurDealQuantity'))
+         or (iCol = stdBillsMeasure.VisibleCol('CurDealTotalPrice'))
+         or (iCol = stdBillsMeasure.VisibleCol('CurQcQuantity'))
+         or (iCol = stdBillsMeasure.VisibleCol('CurQcTotalPrice'))
+         or (iCol = stdBillsMeasure.VisibleCol('CurPcQuantity'))
+         or (iCol = stdBillsMeasure.VisibleCol('CurPcTotalPrice'));
 end;
 
 procedure TBillsMeasureFrame.zgBillsMeasureCellButtonClick(Sender: TObject;
@@ -598,6 +605,7 @@ end;
 procedure TBillsMeasureFrame.ResetPhaseDataReadOnly(AReadOnly: Boolean);
 begin
   stdBillsMeasure.Column('CurDealQuantity').ReadOnly := AReadOnly;
+  stdBillsMeasure.Column('CurDealTotalPrice').ReadOnly := AReadOnly;
   stdBillsMeasure.Column('CurQcQuantity').ReadOnly := AReadOnly;
   stdBillsMeasure.Column('CurPcQuantity').ReadOnly := AReadOnly;
 end;

Units/BillsTree.pas

@@ -18,6 +18,10 @@ type
     FGatherQuantity: Double;
 
     FStageRec: TStageRecord;
+
+    function HasCountPrice: Boolean;
+    function HasTotalPrice: Boolean;
+
     function GetRec: TBillsRecord;
   public
     function CanUpLevel: Boolean; override;
@@ -31,6 +35,9 @@ type
     function HasMeasure: Boolean;
     function HasLedger: Boolean;
 
+    function CountPriceEnable: Boolean;
+    function TotalPriceEnable: Boolean;
+
     property Rec: TBillsRecord read GetRec;
 
     property DealQuantity: Double read FDealQuantity write FDealQuantity;
@@ -159,6 +166,11 @@ begin
             and (not Rec.ValueByName('LockedLevel').AsBoolean);
 end;
 
+function TBillsIDTreeNode.CountPriceEnable: Boolean;
+begin
+  Result := HasCountPrice or (not HasTotalPrice);
+end;
+
 function TBillsIDTreeNode.DownLevel: Boolean;
 begin
   Result := inherited DownLevel;
@@ -176,6 +188,19 @@ begin
   Result := TBillsRecord(TsdIDTreeNode(Self).Rec);
 end;
 
+function TBillsIDTreeNode.HasCountPrice: Boolean;
+begin
+  Result := False;
+  if not Assigned(Rec) then Exit;
+  Result := (Rec.Price.AsFloat <> 0)
+         or (Rec.OrgQuantity.AsFloat <> 0)
+         or (Rec.MisQuantity.AsFloat <> 0)
+         or (Rec.OthQuantity.AsFloat <> 0)
+         or (Rec.AddDealQuantity.AsFloat <> 0)
+         or (Rec.AddQcQuantity.AsFloat <> 0)
+         or (Rec.AddPcQuantity.AsFloat <> 0);
+end;
+
 function TBillsIDTreeNode.HasLedger: Boolean;
 begin
   Result := False;
@@ -196,6 +221,23 @@ begin
             or (Rec.AddPcTotalPrice.AsFloat <> 0);
 end;
 
+function TBillsIDTreeNode.HasTotalPrice: Boolean;
+begin
+  Result := False;
+  if not Assigned(Rec) then Exit;
+  Result := (Rec.OrgTotalPrice.AsFloat <> 0)
+         or (Rec.MisTotalPrice.AsFloat <> 0)
+         or (Rec.OthTotalPrice.AsFloat <> 0)
+         or (Rec.AddDealTotalPrice.AsFloat <> 0)
+         or (Rec.AddQcTotalPrice.AsFloat <> 0)
+         or (Rec.AddPcTotalPrice.AsFloat <> 0);
+end;
+
+function TBillsIDTreeNode.TotalPriceEnable: Boolean;
+begin
+  Result := not HasCountPrice;
+end;
+
 function TBillsIDTreeNode.UpLevel: Boolean;
 begin
   Result := inherited UpLevel;

Units/DataBaseTables.pas

@@ -103,7 +103,7 @@ const
 
   {清单数据 -- 台账编辑界面}
   SBills = 'Bills';
-  tdBills: array [0..76] of TScFieldDef =(
+  tdBills: array [0..80] of TScFieldDef =(
     (FieldName: 'ID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: True; ForceUpdate: False),
     (FieldName: 'ParentID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
     (FieldName: 'NextSiblingID'; FieldType: ftInteger; Size: 0; NotNull: True; PrimaryKey: False; ForceUpdate: False),
@@ -138,18 +138,27 @@ const
     (FieldName: 'OrgQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 施工图原设计 -- 金额
     (FieldName: 'OrgTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 施工图原设计 -- 公式
+    (FieldName: 'OrgFormula'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 设计错漏增减 -- 数量
     (FieldName: 'MisQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 设计错漏增减 -- 金额
     (FieldName: 'MisTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 施工图原设计 -- 公式
+    (FieldName: 'MisFormula'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 其他原因增减 -- 数量
     (FieldName: 'OthQuantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 其他原因增减 -- 金额
     (FieldName: 'OthTotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 施工图原设计 -- 公式
+    (FieldName: 'OthFormula'; FieldType: ftString; Size: 200; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 合同 - 数量
     (FieldName: 'Quantity'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 合同 - 金额
     (FieldName: 'TotalPrice'; FieldType: ftDouble; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
+    // 计算 - 标志
+    // 0: 数量单价模式/无  1: 金额模式/无  主要作用于计算（数量、单价、金额可否输入不以此为依据）
+    (FieldName: 'CalcType'; FieldType: ftInteger; Size: 0; NotNull: False; PrimaryKey: False; ForceUpdate: False),
     // 合同 - 计算标识
     // 0: 无任何公式计算; 1: 数量列有计算式; 2: 金额列有计算式;
     // 2015-6-12 作废

Units/mDataRecord.pas

@@ -39,6 +39,8 @@ type
     FOthTotalPrice: TsdValue;
     FQuantity: TsdValue;
     FTotalPrice: TsdValue;
+    // 计算模式标记
+    FCalcType: TsdValue;
     // 累计
     FAddDealQuantity: TsdValue;
     FAddDealTotalPrice: TsdValue;
@@ -86,6 +88,10 @@ type
     FAddPayTotalPrice: TsdValue;
 
     FAddCompleteRate: TsdValue;
+
+    FCacheMisTP: Double;
+    FCacheOrgTP: Double;
+    FCacheOthTP: Double;
   protected
     procedure DoAfterAddFields; override;
   public
@@ -119,6 +125,7 @@ type
     property OthTotalPrice: TsdValue read FOthTotalPrice;
     property Quantity: TsdValue read FQuantity;
     property TotalPrice: TsdValue read FTotalPrice;
+    property CalcType: TsdValue read FCalcType;
 
     property AddDealQuantity: TsdValue read FAddDealQuantity;
     property AddDealTotalPrice: TsdValue read FAddDealTotalPrice;
@@ -166,6 +173,11 @@ type
     property AddPayTotalPrice: TsdValue read FAddPayTotalPrice;
 
     property AddCompleteRate: TsdValue read FAddCompleteRate;
+
+    // Cache Data 用于增量计算，记录原始值
+    property CacheOrgTP: Double read FCacheOrgTP write FCacheOrgTP;
+    property CacheMisTP: Double read FCacheMisTP write FCacheMisTP;
+    property CacheOthTP: Double read FCacheOthTP write FCacheOthTP;
   end;
 
   TStageRecord = class(TsdDataRecord)
@@ -222,6 +234,8 @@ type
 
     FHasBookMark: TsdValue;
     FMarkMemo: TsdValue;
+
+    FCacheDealTP: Double;
   protected
     procedure DoAfterAddFields; override;
   public
@@ -277,6 +291,8 @@ type
 
     property HasBookMark: TsdValue read FHasBookMark;
     property MarkMemo: TsdValue read FMarkMemo;
+
+    property CacheDealTP: Double read FCacheDealTP write FCacheDealTP;
   end;
 
 implementation
@@ -316,6 +332,7 @@ begin
   FOthTotalPrice := ValueByName('OthTotalPrice');
   FQuantity := ValueByName('Quantity');
   FTotalPrice := ValueByName('TotalPrice');
+  FCalcType := ValueByName('CalcType');
 
   FAddDealQuantity := ValueByName('AddDealQuantity');
   FAddDealTotalPrice := ValueByName('AddDealTotalPrice');