unit BillsDm; interface uses StandardBillsFme, ZhAPI, StandardLib, StageDm, BillsTree, mDataRecord, SysUtils, Classes, sdDB, sdProvider, ADODB, sdIDTree, Math; const DealIndex = 0; AddDealIndex = 1; AddQcIndex = 2; AddPcIndex = 3; AddGatherIndex = 4; type TRecChangeEvent = procedure (ARec: TsdDataRecord) of object; TBillsData = class(TDataModule) sdpBills: TsdADOProvider; sddBills: TsdDataSet; procedure sddBillsAfterAddRecord(ARecord: TsdDataRecord); procedure sddBillsBeforeDeleteRecord(ARecord: TsdDataRecord; var Allow: Boolean); procedure sddBillsBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); procedure sddBillsGetRecordClass(var ARecordClass: TsdRecordClass); private FProjectData: TObject; FCurPhaseIndex: Integer; FBeforeChangeTotalPrice: Double; FBeforeChangeParentID: Integer; //procedure RecursiveCalculate(ABillsID: Integer); function GetStageData: TStageData; function GetBuildLoadInterest(AIndex: Integer): Double; function GetFirstPart(AIndex: Integer): Double; function GetOtherFee(AIndex: Integer): Double; function GetOtherProjectFee(AIndex: Integer): Double; function GetRecyclingFee(AIndex: Integer): Double; function GetReservedFee(AIndex: Integer): Double; function GetSecondPart(AIndex: Integer): Double; function GetStageSettlement(AIndex: Integer): Double; function GetThirdPart(AIndex: Integer): Double; public constructor Create(AProjectData: TObject); destructor Destroy; override; procedure Open(AConnection: TADOConnection); procedure Close; procedure Save; procedure InitBills; // 计算 -- 均采用增量汇总方式计算父项 {procedure Calculate(ABillsID: Integer); procedure CalculateDeal(ABillsID: Integer); // 合同计量 procedure CalculateQuantityChange(ABillsID: Integer); // 数量变更计量 procedure CalculatePriceChange(ABillsID: Integer); // 单价变更计量} // 上报审核批复过程 -- 锁定数据 procedure LockedBaseData; // 解锁数据 procedure UnLockedBaseData; procedure DisableEvents; procedure EnableEvents; function GetMaxBillsID: Integer; function GetGatherTotalPrice(ABillsID, AIndex: Integer): Double; property ProjectData: TObject read FProjectData; property StageData: TStageData read GetStageData; {累计完成 可查数据} // AIndex表示不同类型,取值如下: // 0: 0号台账合同 1: 累计合同计量 2: 累计数量变更计量 3: 累计单价变更计量 4: 累计完成计量 // 第一部分 property FirstPart[AIndex: Integer]: Double read GetFirstPart; // 第二部分 property SecondPart[AIndex: Integer]: Double read GetSecondPart; // 第三部分 property ThirdPart[AIndex: Integer]: Double read GetThirdPart; // 预留费用 property ReservedFee[AIndex: Integer]: Double read GetReservedFee; // 其他费用项目 property OtherFee[AIndex: Integer]: Double read GetOtherFee; // 建设期贷款利息 property BuildLoadInterest[AIndex: Integer]: Double read GetBuildLoadInterest; // 回收金额 property RecyclingFee[AIndex: Integer]: Double read GetRecyclingFee; // 公路工程以外的工程费用 property OtherProjectFee[AIndex: Integer]: Double read GetOtherProjectFee; // 结算价 property Settlement[AIndex: Integer]: Double read GetStageSettlement; end; implementation uses Variants, UtilMethods, Globals, ProjectData, ExcelImport, BillsCommand, PhaseData, BillsCompileDm, ConditionalDefines, FormulaCalc; {$R *.dfm} { TBillsData } procedure TBillsData.Close; begin sddBills.Close; end; constructor TBillsData.Create(AProjectData: TObject); begin inherited Create(nil); FProjectData := AProjectData; end; destructor TBillsData.Destroy; begin inherited; end; procedure TBillsData.Open(AConnection: TADOConnection); begin sdpBills.Connection := AConnection; sddBills.Open; if not Assigned(sddBills.IndexList.FindByName('idxID')) then sddBills.AddIndex('idxID', 'ID'); sddBills.FieldByName('OrgQuantity').ValidChars := sddBills.FieldByName('Quantity').ValidChars + ArithmeticCharSet; sddBills.FieldByName('OrgTotalPrice').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars; sddBills.FieldByName('MisQuantity').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars; sddBills.FieldByName('MisTotalPrice').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars; sddBills.FieldByName('OthQuantity').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars; sddBills.FieldByName('OthTotalPrice').ValidChars := sddBills.FieldByName('OrgQuantity').ValidChars; end; procedure TBillsData.Save; procedure ResolveCode(ARec: TBillsRecord); var sgs: TStrings; i: Integer; sXiangCode, sMuCode, sJieCode, sXiMuCode: string; begin sgs := TStringList.Create; try sgs.Delimiter := '-'; sgs.DelimitedText := ARec.Code.AsString; case sgs.Count of 1: sXiangCode := ''; 2: sXiangCode := ChinessNum(StrToIntDef(sgs[1], 0)); 3: sMuCode := sgs[2]; 4: sJieCode := sgs[3]; else begin for i := 4 to sgs.Count - 1 do if sXiMuCode = '' then sXiMuCode := sgs[i] else sXiMuCode := sXiMuCode + '-' + sgs[i]; end; end; finally ARec.SetStrValue(ARec.XiangCode, sXiangCode); ARec.SetStrValue(ARec.MuCode, sMuCode); ARec.SetStrValue(ARec.JieCode, sJieCode); ARec.SetStrValue(ARec.XimuCode, sXiMuCode); sgs.Free; end; end; procedure SaveReportsRela; var iIndex: Integer; stnNode: TBillsIDTreeNode; iLeafXmjParentID: Integer; sIndexCode: string; begin sddBills.BeginUpdate; try with TProjectData(FProjectData).BillsCompileData do for iIndex := 0 to BillsCompileTree.Count - 1 do begin stnNode := TBillsIDTreeNode(BillsCompileTree.Items[iIndex]); // 分项清单排序 if (stnNode.Rec.SerialNo.AsString = '') or (stnNode.MajorIndex <> stnNode.Rec.SerialNo.AsInteger) then stnNode.Rec.SerialNo.AsInteger := stnNode.MajorIndex; // 叶子节点 stnNode.Rec.SetBoolValue(stnNode.Rec.IsLeaf, not stnNode.HasChildren); // 最底项目节父节点ID if (stnNode.Rec.B_Code.AsString <> '') then iLeafXmjParentID := GetLeafXmjParentID(stnNode.ID) else iLeafXmjParentID := -1; stnNode.Rec.SetIntValue(stnNode.Rec.LeafXmjParentID, iLeafXmjParentID); // 分解项目节编号为项、目、节、细目 if stnNode.Rec.Code.AsString <> '' then ResolveCode(stnNode.Rec); // 工程量清单排序Code if (stnNode.Rec.B_Code.AsString <> '') then begin sIndexCode := B_CodeToIndexCode(stnNode.Rec.B_Code.AsString); stnNode.Rec.SetStrValue(stnNode.Rec.IndexCode, sIndexCode); end; end; finally sddBills.EndUpdate; end; end; begin if TProjectData(FProjectData).BillsCompileData.Active then SaveReportsRela; // 保存 SerialNo, IsLeaf, LeafXmjParentID, 分解Code sddBills.Save; end; {procedure TBillsData.Calculate(ABillsID: Integer); var stnNode: TsdIDTreeNode; iChild: Integer; begin stnNode := FBillsTree.FindNode(ABillsID); if stnNode.HasChildren then begin for iChild := 0 to stnNode.ChildCount - 1 do Calculate(stnNode.ChildNodes[iChild].ID); end else begin CalculateOrg(ABillsID); CalculateDeal(ABillsID); CalculateQuantityChange(ABillsID); CalculatePriceChange(ABillsID); end; end; procedure TBillsData.CalculateDeal(ABillsID: Integer); var iIndex: Integer; fQuantity, fTotalPrice: Double; Rec: TsdDataRecord; begin fQuantity := 0; fTotalPrice := 0; with TProjectData(FProjectData) do for iIndex := 0 to PhaseCount - 1 do begin Rec := PhaseData[iIndex].PhaseRecord(ABillsID); if not Assigned(Rec) then Continue; fQuantity := fQuantity + Rec.ValueByName('DealQuantity').AsFloat; fTotalPrice := fTotalPrice + Rec.ValueByName('DealTotalPrice').AsFloat; end; with FBillsTree.FindNode(ABillsID).Rec do UpdateRecordDeal(ABillsID, fQuantity - ValueByName('AddDealQuantity').AsFloat, fTotalPrice - ValueByName('AddDealTotalPrice').AsFloat); end; procedure TBillsData.CalculatePriceChange(ABillsID: Integer); var iIndex: Integer; fQuantity, fTotalPrice: Double; Rec: TsdDataRecord; begin fQuantity := 0; fTotalPrice := 0; with TProjectData(FProjectData) do for iIndex := 0 to PhaseCount - 1 do begin Rec := PhaseData[iIndex].PhaseRecord(ABillsID); if not Assigned(Rec) then Continue; fQuantity := fQuantity + Rec.ValueByName('PcQuantity').AsFloat; fTotalPrice := fTotalPrice + Rec.ValueByName('PcTotalPrice').AsFloat; end; with FBillsTree.FindNode(ABillsID).Rec do UpdateRecordPc(ABillsID, fQuantity - ValueByName('AddPcQuantity').AsFloat, fTotalPrice - ValueByName('AddPcTotalPrice').AsFloat); end; procedure TBillsData.CalculateQuantityChange(ABillsID: Integer); var iIndex: Integer; fQuantity, fTotalPrice: Double; Rec: TsdDataRecord; begin fQuantity := 0; fTotalPrice := 0; with TProjectData(FProjectData) do for iIndex := 0 to PhaseCount - 1 do begin Rec := PhaseData[iIndex].PhaseRecord(ABillsID); if not Assigned(Rec) then Continue; fQuantity := fQuantity + Rec.ValueByName('QcQuantity').AsFloat; fTotalPrice := fTotalPrice + Rec.ValueByName('QcTotalPrice').AsFloat; end; with FBillsTree.FindNode(ABillsID).Rec do UpdateRecordQc(ABillsID, fQuantity - ValueByName('AddQcQuantity').AsFloat, fTotalPrice - ValueByName('AddQcTotalPrice').AsFloat); end; } { procedure TBillsData.RecursiveCalculate(ABillsID: Integer); procedure GatherChildValue(ANode: TsdIDTreeNode); var CacheRecord: TCacheRecord; iChild: Integer; begin CacheRecord := TCacheRecord.Create; try for iChild := 0 to ANode.ChildCount - 1 do with ANode.ChildNodes[iChild].Rec do begin CacheRecord.FTotalPrice := CacheRecord.FTotalPrice + ValueByName('TotalPrice').AsFloat; CacheRecord.FDealQuantity := CacheRecord.FDealQuantity + ValueByName('AddDealQuantity').AsFloat; CacheRecord.FDealTotalPrice := CacheRecord.FDealTotalPrice + ValueByName('AddDealTotalPrice').AsFloat; CacheRecord.FQcQuantity := CacheRecord.FQcQuantity + ValueByName('AddQcQuantity').AsFloat; CacheRecord.FQcTotalPrice := CacheRecord.FQcTotalPrice + ValueByName('AddQcTotalPrice').AsFloat; CacheRecord.FPcQuantity := CacheRecord.FPcQuantity + ValueByName('AddPcQuantity').AsFloat; CacheRecord.FPcTotalPrice := CacheRecord.FPcTotalPrice + ValueByName('AddPcTotalPrice').AsFloat; end; finally CacheRecord.SetBillsRecord(ANode); CacheRecord.Free; end; end; procedure CalculateLeafNode(ANode: TsdIDTreeNode; ACacheRecord: TCacheRecord); begin with ANode.Rec do begin if ValueByName('QtyFlag').AsInteger = 1 then ValueByName('Quantity').AsFloat := EvaluateExprs(ValueByName('QtyFormula').AsString); if ValueByName('QtyFlag').AsInteger < 2 then ACacheRecord.FTotalPrice := ValueByName('Quantity').AsFloat * ValueByName('Price').AsFloat else begin FFormulaCalc.SetRecordText(ValueByName('QtyFormula').AsString); ACacheRecord.FTotalPrice := FFormulaCalc.Value; end; end; end; procedure GatherPhaseValue(ANode: TsdIDTreeNode); var CacheRecord: TCacheRecord; iIndex: Integer; Rec: TsdDataRecord; begin CacheRecord := TCacheRecord.Create; try CalculateLeafNode(ANode, CacheRecord); {with TProjectData(FProjectData) do for iIndex := 0 to PhaseCount - 1 do begin PhaseData[iIndex].ReCalculate(ANode.ID); Rec := PhaseData[iIndex].PhaseRecord(ANode.ID); if not Assigned(Rec) then Continue; CacheRecord.FDealQuantity := CacheRecord.FDealQuantity + Rec.ValueByName('DealQuantity').AsFloat; CacheRecord.FDealTotalPrice := CacheRecord.FDealTotalPrice + Rec.ValueByName('DealTotalPrice').AsFloat; CacheRecord.FQcQuantity := CacheRecord.FQcQuantity + Rec.ValueByName('QcQuantity').AsFloat; CacheRecord.FQcTotalPrice := CacheRecord.FQcTotalPrice + Rec.ValueByName('QcTotalPrice').AsFloat; CacheRecord.FPcQuantity := CacheRecord.FPcQuantity + Rec.ValueByName('PcQuantity').AsFloat; CacheRecord.FPcTotalPrice := CacheRecord.FPcTotalPrice + Rec.ValueByName('PcTotalPrice').AsFloat; end;} { finally CacheRecord.SetBillsRecord(ANode); CacheRecord.Free; end; end; procedure CalculateCurNode(ANode: TsdIDTreeNode); begin if ANode.HasChildren then GatherChildValue(ANode) else GatherPhaseValue(ANode); end; procedure CalculateAllChildren(ANode: TsdIDTreeNode); var iChild: Integer; begin if ANode.HasChildren then for iChild := 0 to ANode.ChildCount - 1 do RecursiveCalculate(ANode.ChildNodes[iChild].ID); end; var stnNode: TsdIDTreeNode; begin stnNode := FBillsTree.FindNode(ABillsID); CalculateAllChildren(stnNode); CalculateCurNode(stnNode); end; } procedure TBillsData.InitBills; var Import: TBillsExcelImport; begin Import := TBillsExcelImport.Create(TProjectData(ProjectData)); try Import.ImportFile(GetTemplateBillsFileName); finally Import.Free; end; end; function TBillsData.GetStageData: TStageData; begin Result := TProjectData(FProjectData).PhaseData.StageData; end; procedure TBillsData.LockedBaseData; var iIndex: Integer; begin sddBills.BeginUpdate; for iIndex := 0 to sddBills.RecordCount - 1 do begin if not sddBills.Records[iIndex].ValueByName('LockedLevel').AsBoolean then sddBills.Records[iIndex].ValueByName('LockedLevel').AsBoolean := True; if not sddBills.Records[iIndex].ValueByName('LockedInfo').AsBoolean then sddBills.Records[iIndex].ValueByName('LockedInfo').AsBoolean := True; if sddBills.Records[iIndex].ValueByName('NewPrice').AsFloat <> 0 then sddBills.Records[iIndex].ValueByName('LockedNewPrice').AsBoolean := True; end; sddBills.EndUpdate; end; procedure TBillsData.sddBillsAfterAddRecord(ARecord: TsdDataRecord); begin ARecord.ValueByName('CreatePhaseID').AsInteger := TProjectData(FProjectData).PhaseIndex; end; function TBillsData.GetBuildLoadInterest(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(34, AIndex); end; function TBillsData.GetFirstPart(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(1, AIndex); end; function TBillsData.GetOtherFee(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(15, AIndex); end; function TBillsData.GetOtherProjectFee(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(9, AIndex); end; function TBillsData.GetRecyclingFee(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(16, AIndex); end; function TBillsData.GetReservedFee(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(7, AIndex); end; function TBillsData.GetSecondPart(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(2, AIndex); end; function TBillsData.GetStageSettlement(AIndex: Integer): Double; begin // 全国 // 第一部分+第二部分+第三部分+预备费+新增加费用项目(其他费用_广东)-回收金额 Result := FirstPart[AIndex] + SecondPart[AIndex] + ThirdPart[AIndex] + ReservedFee[AIndex] + OtherFee[AIndex] - RecyclingFee[AIndex]; // 广东 // 全国的基础上+建设期贷款利息+公路功能以外的项目 if _IsGuangDong then Result := Result + BuildLoadInterest[AIndex] + OtherProjectFee[AIndex]; end; function TBillsData.GetThirdPart(AIndex: Integer): Double; begin Result := GetGatherTotalPrice(3, AIndex); end; function TBillsData.GetGatherTotalPrice(ABillsID, AIndex: Integer): Double; var Rec: TsdDataRecord; begin Result := 0; Rec := sddBills.FindKey('idxID', ABillsID); if Assigned(Rec) then begin case AIndex of 0: Result := Rec.ValueByName('TotalPrice').AsFloat; 1: Result := Rec.ValueByName('AddDealTotalPrice').AsFloat; 2: Result := Rec.ValueByName('AddQcTotalPrice').AsFloat; 3: Result := Rec.ValueByName('AddPcTotalPrice').AsFloat; 4: Result := Rec.ValueByName('AddGatherTotalPrice').AsFloat; end; end; end; procedure TBillsData.DisableEvents; begin sddBills.BeforeValueChange := nil; sddBills.AfterValueChanged := nil; end; procedure TBillsData.EnableEvents; begin {sddBills.BeforeValueChange := sddBillsBeforeValueChange; sddBills.AfterValueChanged := sddBillsAfterValueChanged;} end; procedure TBillsData.UnLockedBaseData; var iIndex: Integer; begin for iIndex := 0 to sddBills.RecordCount - 1 do sddBills.Records[iIndex].ValueByName('LockedInfo').AsBoolean := False; end; procedure TBillsData.sddBillsBeforeDeleteRecord(ARecord: TsdDataRecord; var Allow: Boolean); begin with TProjectData(FProjectData) do begin if ProjProperties.PhaseCount > 0 then PhaseData.StageData.DeletePhaseRecord(ARecord.ValueByName('ID').AsInteger); end; end; procedure TBillsData.sddBillsBeforeValueChange(AValue: TsdValue; const NewValue: Variant; var Allow: Boolean); begin if (Pos('DgnQuantity', AValue.FieldName) > 0) and not (VarIsNull(NewValue) or (NewValue = 0)) then begin if AValue.Owner.ValueByName('B_Code').AsString <> '' then begin ErrorMessage('仅项目节可以输入设计数量!'); Allow := False; end; end; end; function TBillsData.GetMaxBillsID: Integer; var Rec: TsdDataRecord; i: Integer; begin Result := 100; for i := 0 to sddBills.RecordCount - 1 do begin Rec := sddBills.Records[i]; if Rec.ValueByName('ID').AsInteger > Result then Result := Rec.ValueByName('ID').AsInteger; end; end; procedure TBillsData.sddBillsGetRecordClass( var ARecordClass: TsdRecordClass); begin ARecordClass := TBillsRecord; end; end.