BillsMeasureDm.pas 29 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874
  1. unit BillsMeasureDm;
  2. interface
  3. uses
  4. BillsDm, BillsTree, FormulaCalc, sdIDTree, StageDm,
  5. SysUtils, Classes, sdDB;
  6. type
  7. TBillsMeasureData = class(TDataModule)
  8. sdvBillsMeasure: TsdDataView;
  9. procedure sdvBillsMeasureAfterOpen(Sender: TObject);
  10. procedure sdvBillsMeasureAfterAddRecord(ARecord: TsdDataRecord);
  11. procedure sdvBillsMeasureGetText(var Text: String;
  12. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  13. DisplayText: Boolean);
  14. procedure sdvBillsMeasureSetText(var Text: String;
  15. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  16. var Allow: Boolean);
  17. procedure sdvBillsMeasureNeedLookupRecord(ARecord: TsdDataRecord;
  18. AColumn: TsdViewColumn; ANewText: String);
  19. procedure sdvBillsMeasureAfterClose(Sender: TObject);
  20. procedure sdvBillsMeasureAfterValueChanged(AValue: TsdValue);
  21. procedure sdvBillsMeasureCurrentChanged(ARecord: TsdDataRecord);
  22. private
  23. FProjectData: TObject;
  24. FBillsData: TBillsData;
  25. FBillsMeasureTree: TBillsIDTree;
  26. FFormulaCalc: TFormulaCalc;
  27. FShowParentData: Boolean;
  28. FOnRecChange: TRecChangeEvent;
  29. function OnGetCardinalNum(const ACardinalNum: string): Double;
  30. procedure CalcAddCompleteRate(ANode: TsdIDTreeNode);
  31. procedure CalcAddDgnPrice(ANode: TsdIDTreeNode);
  32. procedure UpdateRecordGather(ANode: TsdIDTreeNode; AQuantity, ATotalPrice: Double);
  33. function SelectAndUpdateBGL(ABillsID: Integer; ARec: TsdDataRecord;
  34. ANewValue: Double; const AType: string): Boolean;
  35. function GetStageData: TStageData;
  36. procedure SetOnRecChange(const Value: TRecChangeEvent);
  37. public
  38. constructor Create(AProjectData: TObject);
  39. destructor Destroy; override;
  40. procedure Open;
  41. procedure Close;
  42. procedure ReConnectTree;
  43. procedure CalculateAll;
  44. procedure ResetPhaseStageLink;
  45. procedure ResetTreeNodeStageRec;
  46. procedure ExpandNodeTo(ALevel: Integer);
  47. procedure ExpandXmjNode;
  48. procedure ExpandCurPhase;
  49. function GatherRelaBGL(ANode: TsdIDTreeNode): string;
  50. // 计算 修改各期原报审核数据时,需对累计数据做增量
  51. procedure UpdateRecordDeal(ABillsID: Integer; AQuantity, ATotalPrice: Double);
  52. procedure UpdateRecordQc(ABillsID: Integer; AQuantity, ATotalPrice: Double);
  53. procedure UpdateRecordPc(ABillsID: Integer; AQuantity, ATotalPrice: Double);
  54. procedure UpdateBGLInfo(ABillsID: Integer; ARec: TsdDataRecord; const AType: string);
  55. property ProjectData: TObject read FProjectData;
  56. property BillsData: TBillsData read FBillsData;
  57. property BillsMeasureTree: TBillsIDTree read FBillsMeasureTree;
  58. property StageData: TStageData read GetStageData;
  59. property ShowParentData: Boolean read FShowParentData write FShowParentData;
  60. property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
  61. end;
  62. implementation
  63. uses
  64. ProjectData, PhaseData, Math, ZhAPI, BillsCommand, BGLSelectFrm,
  65. BGLDm, UtilMethods, mDataRecord;
  66. {$R *.dfm}
  67. { TBillsMeasureData }
  68. constructor TBillsMeasureData.Create(AProjectData: TObject);
  69. begin
  70. inherited Create(nil);
  71. FProjectData := AProjectData;
  72. FBillsData := TProjectData(FProjectData).BillsData;
  73. FBillsMeasureTree := TBillsIDTree.Create;
  74. FBillsMeasureTree.KeyFieldName := 'ID';
  75. FBillsMeasureTree.ParentFieldName := 'ParentID';
  76. FBillsMeasureTree.NextSiblingFieldName := 'NextSiblingID';
  77. FBillsMeasureTree.AutoCreateKeyID := True;
  78. FBillsMeasureTree.AutoExpand := True;
  79. FBillsMeasureTree.DataView := sdvBillsMeasure;
  80. FBillsMeasureTree.SeedID := Max(FBillsMeasureTree.SeedID, 100);
  81. FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True);
  82. FFormulaCalc := TFormulaCalc.Create(FBillsMeasureTree);
  83. FFormulaCalc.OnGetValue := OnGetCardinalNum;
  84. end;
  85. destructor TBillsMeasureData.Destroy;
  86. begin
  87. FFormulaCalc.Free;
  88. FBillsMeasureTree.Free;
  89. inherited;
  90. end;
  91. procedure TBillsMeasureData.Open;
  92. begin
  93. sdvBillsMeasure.DataSet := TProjectData(FProjectData).BillsData.sddBills;
  94. sdvBillsMeasure.Open;
  95. end;
  96. procedure TBillsMeasureData.ReConnectTree;
  97. begin
  98. FBillsMeasureTree.DataView := nil;
  99. FBillsMeasureTree.DataView := sdvBillsMeasure;
  100. FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True);
  101. end;
  102. procedure TBillsMeasureData.ResetPhaseStageLink;
  103. begin
  104. with TProjectData(FProjectData).PhaseData do
  105. begin
  106. sdvBillsMeasure.Columns.FindColumn('CurDealQuantity').LookupDataSet := StageData.sddStage;
  107. sdvBillsMeasure.Columns.FindColumn('CurDealTotalPrice').LookupDataSet := StageData.sddStage;
  108. sdvBillsMeasure.Columns.FindColumn('CurQcQuantity').LookupDataSet := StageData.sddStage;
  109. sdvBillsMeasure.Columns.FindColumn('CurQcTotalPrice').LookupDataSet := StageData.sddStage;
  110. sdvBillsMeasure.Columns.FindColumn('CurQcBGLCode').LookupDataSet := StageData.sddStage;
  111. sdvBillsMeasure.Columns.FindColumn('CurPcQuantity').LookupDataSet := StageData.sddStage;
  112. sdvBillsMeasure.Columns.FindColumn('CurPcTotalPrice').LookupDataSet := StageData.sddStage;
  113. sdvBillsMeasure.Columns.FindColumn('CurPcBGLCode').LookupDataSet := StageData.sddStage;
  114. sdvBillsMeasure.Columns.FindColumn('CurGatherQuantity').LookupDataSet := StageData.sddStage;
  115. sdvBillsMeasure.Columns.FindColumn('CurGatherTotalPrice').LookupDataSet := StageData.sddStage;
  116. sdvBillsMeasure.Columns.FindColumn('EndDealQuantity').LookupDataSet := StageData.sddStage;
  117. sdvBillsMeasure.Columns.FindColumn('EndDealTotalPrice').LookupDataSet := StageData.sddStage;
  118. sdvBillsMeasure.Columns.FindColumn('EndQcQuantity').LookupDataSet := StageData.sddStage;
  119. sdvBillsMeasure.Columns.FindColumn('EndQcTotalPrice').LookupDataSet := StageData.sddStage;
  120. sdvBillsMeasure.Columns.FindColumn('EndPcQuantity').LookupDataSet := StageData.sddStage;
  121. sdvBillsMeasure.Columns.FindColumn('EndPcTotalPrice').LookupDataSet := StageData.sddStage;
  122. sdvBillsMeasure.Columns.FindColumn('EndGatherQuantity').LookupDataSet := StageData.sddStage;
  123. sdvBillsMeasure.Columns.FindColumn('EndGatherTotalPrice').LookupDataSet := StageData.sddStage;
  124. end;
  125. end;
  126. procedure TBillsMeasureData.sdvBillsMeasureAfterOpen(Sender: TObject);
  127. begin
  128. FBillsMeasureTree.Active := True;
  129. end;
  130. procedure TBillsMeasureData.sdvBillsMeasureAfterAddRecord(
  131. ARecord: TsdDataRecord);
  132. begin
  133. ARecord.ValueByName('IsMeasureAdd').AsBoolean := True;
  134. end;
  135. procedure TBillsMeasureData.sdvBillsMeasureGetText(var Text: String;
  136. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  137. DisplayText: Boolean);
  138. function GetQuantityValueOrFormula(const AQtyType: string): string;
  139. begin
  140. with AValue.Owner do
  141. begin
  142. if ValueByName(AQtyType + 'Flag').AsInteger = 1 then
  143. Result := ValueByName(AQtyType + 'Formula').AsString
  144. else
  145. Result := Text;
  146. end;
  147. end;
  148. function GetTotalPriceValueOrFormula(const AQtyType: string): string;
  149. begin
  150. with AValue.Owner do
  151. begin
  152. if ValueByName(AQtyType + 'Flag').AsInteger = 2 then
  153. begin
  154. FFormulaCalc.SetRecordText(ValueByName(AQtyType + 'Formula').AsString);
  155. Result := FFormulaCalc.DisplayText;
  156. end
  157. else
  158. Result := Text;
  159. end;
  160. end;
  161. procedure GetDisplayText(var AText: string; AValue: TsdValue;
  162. AColumn: TsdViewColumn);
  163. var
  164. stnNode: TsdIDTreeNode;
  165. begin
  166. if (Pos('TotalPrice', AColumn.FieldName) > 0) or
  167. (Pos('Quantity', AColumn.FieldName) > 0) or
  168. (Pos('Price', AColumn.FieldName) > 0) then
  169. begin
  170. if AValue.AsFloat = 0 then
  171. Text := '';
  172. end;
  173. if SameText('Quantity', AColumn.FieldName) or
  174. SameText('Price', AColumn.FieldName) or
  175. SameText('NewPrice', AColumn.FieldName) or
  176. SameText('AddGatherQuantity', AColumn.FieldName) then
  177. begin
  178. stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
  179. if stnNode.HasChildren then
  180. Text := '';
  181. end;
  182. // 所有本期数据,当节点为父节点时,不显示值(实际上需要计算其中的金额值,但又不能显示)
  183. // 有病。每天都在变。
  184. if not ShowParentData and (Pos('Cur', AColumn.FieldName) > 0) and (Pos('Gather', AColumn.FieldName) = 0) then
  185. begin
  186. stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger);
  187. if stnNode.HasChildren then
  188. Text := '';
  189. end;
  190. end;
  191. procedure GetEditText(var AText: string; AValue: TsdValue;
  192. AColumn: TsdViewColumn);
  193. begin
  194. if SameText(AColumn.FieldName, 'Quantity') then
  195. Text := GetQuantityValueOrFormula('Qty')
  196. else if SameText(AColumn.FieldName, 'CurDealQuantity') then
  197. Text := GetQuantityValueOrFormula('Deal')
  198. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  199. Text := GetQuantityValueOrFormula('Qc')
  200. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  201. Text := GetQuantityValueOrFormula('Pc')
  202. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  203. Text := GetTotalPriceValueOrFormula('Deal')
  204. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  205. Text := GetTotalPriceValueOrFormula('Qc')
  206. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  207. Text := GetTotalPriceValueOrFormula('Pc');
  208. end;
  209. var
  210. fPercent: Double;
  211. begin
  212. if not Assigned(AValue) then Exit;
  213. if DisplayText then
  214. GetDisplayText(Text, AValue, AColumn)
  215. else
  216. GetEditText(Text, AValue, AColumn);
  217. end;
  218. procedure TBillsMeasureData.sdvBillsMeasureSetText(var Text: String;
  219. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  220. var Allow: Boolean);
  221. function GetBillsID: Integer;
  222. begin
  223. if Pos('Cur', AColumn.FieldName) = 1 then
  224. Result := AValue.Owner.ValueByName('BillsID').AsInteger
  225. else
  226. Result := ARecord.ValueByName('ID').AsInteger;
  227. end;
  228. procedure CheckLockedData;
  229. begin
  230. if SameText(AColumn.FieldName, 'Code') or
  231. SameText(AColumn.FieldName, 'B_Code') or
  232. SameText(AColumn.FieldName, 'Name') or
  233. SameText(AColumn.FieldName, 'Units') or
  234. SameText(AColumn.FieldName, 'Price') then
  235. if ARecord.ValueByName('LockedInfo').AsBoolean then
  236. DataSetErrorMessage(Allow, '清单信息已被锁定,不允许修改编号、名称、单位、清单单价!');
  237. if not Allow then Exit;
  238. if SameText(AColumn.FieldName, 'NewPrice') then
  239. if ARecord.ValueByName('LockedNewPrice').AsBoolean then
  240. DataSetErrorMessage(Allow, '变更单价已被锁定,不允许修改!');
  241. end;
  242. procedure CheckNodeWritable;
  243. var
  244. vNode: TsdIDTreeNode;
  245. iCreatePhase: Integer;
  246. begin
  247. vNode := BillsMeasureTree.FindNode(GetBillsID);
  248. iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
  249. if SameText('Price', AColumn.FieldName) then
  250. if vNode.Rec.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
  251. DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单单价!');
  252. if SameText('NewPrice', AColumn.FieldName) then
  253. if vNode.Rec.ValueByName('AddPcTotalPrice').AsFloat <> 0 then
  254. DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单变更单价!');
  255. if not Allow then Exit;
  256. if vNode.HasChildren then
  257. begin
  258. if Text = '' then
  259. Exit
  260. else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or
  261. (Pos('TotalPrice', AColumn.FieldName) > 0) then
  262. DataSetErrorMessage(Allow, '该清单有子计算项,不能直接修改!')
  263. else if (Pos('Price', AColumn.FieldName) > 0) then
  264. DataSetErrorMessage(Allow, '仅最底层清单可输入单价!');
  265. end
  266. else
  267. if (Pos('TotalPrice', AColumn.FieldName) > 0) and
  268. (vNode.Rec.ValueByName('Price').AsFloat <> 0) then
  269. DataSetErrorMessage(Allow, '不可直接输入!如需直接输入金额,请先删除清单单价!');
  270. if not Allow then Exit;
  271. // 变更清单允许填写本期合同计量,按超计论
  272. {if vNode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
  273. (SameText('CurDealQuantity', AColumn.FieldName) or
  274. SameText('CurDealTotalPrice', AColumn.FieldName)) then
  275. DataSetErrorMessage(Allow, Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));}
  276. end;
  277. procedure SetQuantity(const AField: string);
  278. begin
  279. // 变更应选择变更令
  280. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  281. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  282. if not Allow then Exit;
  283. if CheckStringNull(Text) or CheckNumeric(Text) then
  284. begin
  285. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 0;
  286. AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
  287. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  288. end
  289. else
  290. begin
  291. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 1;
  292. AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
  293. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  294. end;
  295. end;
  296. procedure SetTotalPrice(const AField: string);
  297. begin
  298. // 变更应选择变更令
  299. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  300. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  301. if not Allow then Exit;
  302. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 2;
  303. AValue.Owner.ValueByName(AField + 'Quantity').AsString := '';
  304. if CheckStringNull(Text) or CheckNumeric(Text) then
  305. begin
  306. AValue.Owner.ValueByName('Formula').AsString := '';
  307. Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
  308. end
  309. else
  310. begin
  311. AValue.Owner.ValueByName('Formula').AsString := Text;
  312. Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
  313. end;
  314. end;
  315. procedure DoCurChanged;
  316. begin
  317. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  318. SetQuantity('Deal')
  319. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  320. SetQuantity('Qc')
  321. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  322. SetQuantity('Pc')
  323. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  324. SetTotalPrice('Deal')
  325. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  326. SetTotalPrice('Qc')
  327. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  328. SetTotalPrice('Pc')
  329. else if (Pos('DgnQuantity', AColumn.FieldName) > 0) or
  330. SameText(AColumn.FieldName, 'Quantity') then
  331. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
  332. else if SameText(AColumn.FieldName, 'NewPrice') or
  333. SameText(AColumn.FieldName, 'Price') then
  334. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  335. end;
  336. begin
  337. if not Assigned(AValue) then Exit;
  338. CheckLockedData;
  339. if not Allow then Exit;
  340. CheckNodeWritable;
  341. if not Allow then Exit;
  342. Text := Trim(Text);
  343. if Pos('=', Text) = 1 then
  344. Text := Copy(Text, 2, Length(Text) - 1);
  345. DoCurChanged;
  346. end;
  347. procedure TBillsMeasureData.sdvBillsMeasureNeedLookupRecord(
  348. ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);
  349. function CheckNeedAddPhaseRecord(ANode: TBillsIDTreeNode): Boolean;
  350. begin
  351. Result := SameText(AColumn.FieldName, 'CurDealQuantity') or
  352. SameText(AColumn.FieldName, 'CurQcQuantity') or
  353. SameText(AColumn.FieldName, 'CurPcQuantity') or
  354. SameText(AColumn.FieldName, 'CurDealTotalPrice') or
  355. SameText(AColumn.FieldName, 'CurQcTotalPrice') or
  356. SameText(AColumn.FieldName, 'CurPcTotalPrice');
  357. Result := Result and not ANode.HasChildren;
  358. Result := Result and not Assigned(ANode.StageRec);
  359. end;
  360. function HasCardinalNum(AFormula: string): Boolean;
  361. var
  362. iCharIndex: Integer;
  363. begin
  364. Result := False;
  365. iCharIndex := 1;
  366. while ((iCharIndex <= Length(AFormula)) and not Result) do
  367. begin
  368. if AFormula[iCharIndex] in ['A'..'D', 'a'..'d'] then
  369. Result := True;
  370. Inc(iCharIndex);
  371. end;
  372. end;
  373. procedure SetQuantityRec(APhaseRec: TsdDataRecord; const AType: string);
  374. var
  375. bAllow: Boolean;
  376. begin
  377. bAllow := True;
  378. // 变更应选择变更令
  379. if SameText(AType , 'Qc') or SameText(AType , 'Pc') then
  380. bAllow := SelectAndUpdateBGL(ARecord.ValueByName('ID').AsInteger,
  381. APhaseRec, StrToFloatDef(ANewText, 0), AType);
  382. if bAllow then
  383. begin
  384. if CheckNumeric(ANewText) then
  385. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(StrToFloatDef(ANewText, 0))
  386. else
  387. begin
  388. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 1;
  389. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(EvaluateExprs(ANewText));
  390. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  391. end;
  392. end;
  393. end;
  394. procedure SetTotalPriceRec(APhaseRec: TsdDataRecord; const AType: string);
  395. begin
  396. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 2;
  397. if CheckNumeric(ANewText) then
  398. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(StrToFloatDef(ANewText, 0))
  399. else
  400. begin
  401. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(EvaluateExprs(ANewText));
  402. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  403. end;
  404. end;
  405. procedure SetNewRecValue(APhaseRec: TsdDataRecord);
  406. begin
  407. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  408. SetQuantityRec(APhaseRec, 'Deal')
  409. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  410. SetQuantityRec(APhaseRec, 'Qc')
  411. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  412. SetQuantityRec(APhaseRec, 'Pc')
  413. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  414. SetTotalPriceRec(APhaseRec, 'Deal')
  415. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  416. SetTotalPriceRec(APhaseRec, 'Qc')
  417. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  418. SetTotalPriceRec(APhaseRec, 'Pc');
  419. end;
  420. function CheckNodeWritable(ANode: TBillsIDTreeNode): Boolean;
  421. var
  422. iCreatePhase: Integer;
  423. begin
  424. Result := True;
  425. if ANode.HasChildren then
  426. begin
  427. if ANewText = '' then
  428. Result := False
  429. else
  430. DataSetErrorMessage(Result, '该清单有子计算项,不能直接修改!');
  431. end
  432. else if (Pos('TotalPrice', AColumn.FieldName) > 0) and
  433. (ANode.Rec.ValueByName('Price').AsFloat <> 0) then
  434. DataSetErrorMessage(Result, '不可直接输入!如需直接输入金额,请先删除清单单价!');
  435. // 变更清单允许填写本期合同计量,按超计论
  436. {iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;
  437. if ANode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
  438. (SameText('CurDealQuantity', AColumn.FieldName) or
  439. SameText('CurDealTotalPrice', AColumn.FieldName)) then
  440. begin
  441. ErrorMessage(Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));
  442. Exit;
  443. end; }
  444. end;
  445. var
  446. NewRec: TStageRecord;
  447. vNode: TBillsIDTreeNode;
  448. begin
  449. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  450. if not CheckNodeWritable(vNode) then
  451. Exit;
  452. if CheckNeedAddPhaseRecord(vNode) then
  453. begin
  454. if Pos('Quantity', AColumn.FieldName) > 0 then
  455. if HasCardinalNum(ANewText) then
  456. raise Exception.Create('数量列公式不可输入参数');
  457. NewRec := StageData.AddStageRecord(ARecord.ValueByName('ID').AsInteger);
  458. SetNewRecValue(NewRec);
  459. vNode.StageRec := NewRec;
  460. end;
  461. end;
  462. procedure TBillsMeasureData.sdvBillsMeasureAfterClose(Sender: TObject);
  463. begin
  464. FBillsMeasureTree.Active := False;
  465. end;
  466. function TBillsMeasureData.OnGetCardinalNum(
  467. const ACardinalNum: string): Double;
  468. {
  469. function GetTotalPrice(ABillsID: Integer): Double;
  470. var
  471. stnNode: TsdIDTreeNode;
  472. begin
  473. stnNode := FBillsTree.FindNode(ABillsID);
  474. if Assigned(stnNode) then
  475. Result := stnNode.Rec.ValueByName('TotalPrice').AsFloat;
  476. end;
  477. function GetPhaseTotalPrice(ABillsID: Integer; const AType: string): Double;
  478. var
  479. Rec: TsdDataRecord;
  480. begin
  481. Rec := CurPhaseData.PhaseRecord(ABillsID);
  482. if Assigned(Rec) then
  483. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  484. end;
  485. }
  486. function GetTotalPrice(ANode: TsdIDTreeNode): Double;
  487. var
  488. iChild: Integer;
  489. begin
  490. Result := 0;
  491. if not Assigned(ANode) then Exit;
  492. if ANode.HasChildren then
  493. for iChild := 0 to ANode.ChildCount - 1 do
  494. Result := Result + GetTotalPrice(ANode.ChildNodes[iChild])
  495. else
  496. Result := ANode.Rec.ValueByName('TotalPrice').AsFloat;
  497. end;
  498. function GetPhaseTotalPrice(ANode: TsdIDTreeNode; const AType: string): Double;
  499. var
  500. iChild: Integer;
  501. Rec: TsdDataRecord;
  502. begin
  503. Result := 0;
  504. if not Assigned(ANode) then Exit;
  505. if ANode.HasChildren then
  506. for iChild := 0 to ANode.ChildCount - 1 do
  507. Result := Result + GetPhaseTotalPrice(ANode.ChildNodes[iChild], AType)
  508. else
  509. begin
  510. Rec := StageData.StageRecord(ANode.ID);
  511. if Assigned(Rec) then
  512. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  513. end;
  514. end;
  515. var
  516. iNodeID: Integer;
  517. begin
  518. Result := 0;
  519. iNodeID := StrToIntDef(Copy(ACardinalNum, 2, Length(ACardinalNum) - 1), -1);
  520. case ACardinalNum[1] of
  521. 'A','a': Result := GetTotalPrice(BillsMeasureTree.FindNode(iNodeID));
  522. 'B','b': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Deal');
  523. 'C','c': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Qc');
  524. 'D','d': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Pc');
  525. {'A','a': Result := GetTotalPrice(iNodeID);
  526. 'B','b': Result := GetPhaseTotalPrice(iNodeID, 'Deal');
  527. 'C','c': Result := GetPhaseTotalPrice(iNodeID, 'Qc');
  528. 'D','d': Result := GetPhaseTotalPrice(iNodeID, 'Pc');}
  529. end;
  530. end;
  531. function TBillsMeasureData.GetStageData: TStageData;
  532. begin
  533. Result := TProjectData(FProjectData).PhaseData.StageData;
  534. end;
  535. procedure TBillsMeasureData.ExpandNodeTo(ALevel: Integer);
  536. begin
  537. BillsMeasureTree.ExpandLevel := ALevel;
  538. end;
  539. procedure TBillsMeasureData.ExpandXmjNode;
  540. var
  541. iIndex: Integer;
  542. stnNode: TsdIDTreeNode;
  543. begin
  544. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  545. begin
  546. stnNode := BillsMeasureTree.Items[iIndex];
  547. if (stnNode.ParentID <> -1) then
  548. stnNode.Parent.Expanded := stnNode.Rec.ValueByName('B_Code').AsString = '';
  549. end;
  550. end;
  551. procedure TBillsMeasureData.CalculateAll;
  552. var
  553. Cacl: TBillsCalculate;
  554. begin
  555. Cacl := TBillsCalculate.Create(Self);
  556. try
  557. Cacl.Execute;
  558. finally
  559. Cacl.Free;
  560. end;
  561. end;
  562. procedure TBillsMeasureData.UpdateRecordDeal(ABillsID: Integer; AQuantity,
  563. ATotalPrice: Double);
  564. var
  565. stnNode: TsdIDTreeNode;
  566. begin
  567. stnNode := BillsMeasureTree.FindNode(ABillsID);
  568. if not Assigned(stnNode) then Exit;
  569. with stnNode.Rec do
  570. begin
  571. if not stnNode.HasChildren then
  572. ValueByName('AddDealQuantity').AsFloat := QuantityRoundTo(
  573. ValueByName('AddDealQuantity').AsFloat + AQuantity);
  574. ValueByName('AddDealTotalPrice').AsFloat := TotalPriceRoundTo(
  575. ValueByName('AddDealTotalPrice').AsFloat + ATotalPrice);
  576. end;
  577. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  578. UpdateRecordDeal(stnNode.ParentID, AQuantity, ATotalPrice);
  579. end;
  580. procedure TBillsMeasureData.UpdateRecordPc(ABillsID: Integer; AQuantity,
  581. ATotalPrice: Double);
  582. var
  583. stnNode: TsdIDTreeNode;
  584. begin
  585. stnNode := BillsMeasureTree.FindNode(ABillsID);
  586. if not Assigned(stnNode) then Exit;
  587. with stnNode.Rec do
  588. begin
  589. if not stnNode.HasChildren then
  590. ValueByName('AddPcQuantity').AsFloat := QuantityRoundTo(
  591. ValueByName('AddPcQuantity').AsFloat + AQuantity);
  592. ValueByName('AddPcTotalPrice').AsFloat := TotalPriceRoundTo(
  593. ValueByName('AddPcTotalPrice').AsFloat + ATotalPrice);
  594. end;
  595. UpdateRecordGather(stnNode, 0, ATotalPrice);
  596. UpdateRecordPc(stnNode.ParentID, AQuantity, ATotalPrice);
  597. end;
  598. procedure TBillsMeasureData.UpdateRecordQc(ABillsID: Integer; AQuantity,
  599. ATotalPrice: Double);
  600. var
  601. stnNode: TsdIDTreeNode;
  602. begin
  603. stnNode := BillsMeasureTree.FindNode(ABillsID);
  604. if not Assigned(stnNode) then Exit;
  605. with stnNode.Rec do
  606. begin
  607. if not stnNode.HasChildren then
  608. ValueByName('AddQcQuantity').AsFloat := QuantityRoundTo(
  609. ValueByName('AddQcQuantity').AsFloat + AQuantity);
  610. ValueByName('AddQcTotalPrice').AsFloat := TotalPriceRoundTo(
  611. ValueByName('AddQcTotalPrice').AsFloat + ATotalPrice);
  612. end;
  613. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  614. UpdateRecordQc(stnNode.ParentID, AQuantity, ATotalPrice);
  615. end;
  616. procedure TBillsMeasureData.UpdateRecordGather(ANode: TsdIDTreeNode;
  617. AQuantity, ATotalPrice: Double);
  618. begin
  619. with ANode.Rec do
  620. begin
  621. if not ANode.HasChildren then
  622. ValueByName('AddGatherQuantity').AsFloat := QuantityRoundTo(
  623. ValueByName('AddGatherQuantity').AsFloat + AQuantity);
  624. ValueByName('AddGatherTotalPrice').AsFloat := TotalPriceRoundTo(
  625. ValueByName('AddGatherTotalPrice').AsFloat + ATotalPrice);
  626. end;
  627. CalcAddDgnPrice(ANode);
  628. CalcAddCompleteRate(ANode);
  629. end;
  630. function TBillsMeasureData.GatherRelaBGL(ANode: TsdIDTreeNode): string;
  631. var
  632. iChild: Integer;
  633. Rec: TsdDataRecord;
  634. begin
  635. Result := '';
  636. if not Assigned(ANode) then Exit;
  637. if ANode.HasChildren then
  638. begin
  639. for iChild := 0 to ANode.ChildCount - 1 do
  640. Result := MergeRelaBGL(Result, GatherRelaBGL(ANode.ChildNodes[iChild]));
  641. end
  642. else
  643. begin
  644. with TProjectData(FProjectData).PhaseData.StageData do
  645. Rec := StageRecord(ANode.ID);
  646. if Assigned(Rec) then
  647. Result := MergeRelaBGL(Rec.ValueByName('QcBGLCode').AsString, Rec.ValueByName('PcBGLCode').AsString);
  648. end;
  649. end;
  650. procedure TBillsMeasureData.sdvBillsMeasureAfterValueChanged(
  651. AValue: TsdValue);
  652. var
  653. stnNode: TsdIDTreeNode;
  654. begin
  655. if TProjectData(FProjectData).PhaseData.Active then
  656. begin
  657. if AValue.FieldName = 'Price' then
  658. StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
  659. if AValue.FieldName = 'NewPrice' then
  660. StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
  661. end;
  662. if Pos('DgnQuantity1', AValue.FieldName) > 0 then
  663. begin
  664. stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
  665. CalcAddDgnPrice(stnNode);
  666. end;
  667. end;
  668. procedure TBillsMeasureData.ExpandCurPhase;
  669. var
  670. iIndex: Integer;
  671. stnNode: TsdIDTreeNode;
  672. StageRec: TsdDataRecord;
  673. begin
  674. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  675. begin
  676. stnNode := BillsMeasureTree.Items[iIndex];
  677. StageRec := TBillsIDTreeNode(stnNode).StageRec;
  678. if (stnNode.ParentID <> -1) then
  679. if Assigned(StageRec) then
  680. stnNode.Expanded := StageRec.ValueByName('GatherTotalPrice').AsFloat <> 0
  681. else
  682. stnNode.Expanded := False;
  683. end;
  684. end;
  685. procedure TBillsMeasureData.UpdateBGLInfo(ABillsID: Integer;
  686. ARec: TsdDataRecord; const AType: string);
  687. var
  688. stnNode: TsdIDTreeNode;
  689. begin
  690. stnNode := BillsMeasureTree.FindNode(ABillsID);
  691. if not Assigned(stnNode) then Exit;
  692. stnNode.Rec.ValueByName('Add' + AType + 'BGLCode').AsString :=
  693. ARec.ValueByName('End' + AType + 'BGLCode').AsString;
  694. stnNode.Rec.ValueByName('Add' + AType + 'BGLNum').AsString :=
  695. ARec.ValueByName('End' + AType + 'BGLNum').AsString;
  696. end;
  697. function TBillsMeasureData.SelectAndUpdateBGL(ABillsID: Integer;
  698. ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean;
  699. var
  700. AOrgBGL, ANewBGL: TBGLSelectInfo;
  701. ACurNode: TsdIDTreeNode;
  702. procedure UpdateBGL;
  703. begin
  704. ARec.ValueByName(AType + 'BGLCode').AsString := ANewBGL.MergedCode;
  705. ARec.ValueByName(AType + 'BGLNum').AsString := ANewBGL.MergedNum;
  706. TProjectData(ProjectData).BGLData.ApplyBGL(AOrgBGL, ANewBGL);
  707. end;
  708. begin
  709. Result := True;
  710. ACurNode := BillsMeasureTree.FindNode(ABillsID);
  711. AOrgBGL := TBGLSelectInfo.Create(ACurNode.Rec,
  712. ARec.ValueByName(AType + 'Quantity').AsFloat, True);
  713. AOrgBGL.MergedCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  714. AOrgBGL.MergedNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  715. ANewBGL := TBGLSelectInfo.Create(ACurNode.Rec, ANewValue, False);
  716. try
  717. if ANewBGL.TotalNum <> 0 then
  718. begin
  719. Result := SelectBGL(AOrgBGL, ANewBGL, ProjectData);
  720. if Result then
  721. UpdateBGL;
  722. end
  723. else
  724. UpdateBGL;
  725. StageData.UpdateBGLInfo(ARec, AType);
  726. UpdateBGLInfo(ABillsID, ARec, AType);
  727. finally
  728. AOrgBGL.Free;
  729. ANewBGL.Free;
  730. end;
  731. end;
  732. procedure TBillsMeasureData.Close;
  733. begin
  734. sdvBillsMeasure.Close;
  735. end;
  736. procedure TBillsMeasureData.CalcAddCompleteRate(ANode: TsdIDTreeNode);
  737. var
  738. fDividend, fDivisor: Double;
  739. begin
  740. with ANode.Rec do
  741. begin
  742. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  743. fDivisor := ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  744. + ValueByName('AddPcTotalPrice').AsFloat;
  745. if fDivisor <> 0 then
  746. ValueByName('AddCompleteRate').AsFloat := AdvRoundTo(fDividend/fDivisor*100);
  747. end;
  748. end;
  749. procedure TBillsMeasureData.CalcAddDgnPrice(ANode: TsdIDTreeNode);
  750. var
  751. fDividend, fDivisor: Double;
  752. begin
  753. with ANode.Rec do
  754. begin
  755. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  756. fDivisor := ValueByName('DealDgnQuantity1').AsFloat + ValueByName('CDgnQuantity1').AsFloat;
  757. if fDivisor <> 0 then
  758. ValueByName('AddDgnPrice').AsFloat := AdvRoundTo(fDividend/fDivisor);
  759. end;
  760. end;
  761. procedure TBillsMeasureData.SetOnRecChange(const Value: TRecChangeEvent);
  762. begin
  763. FOnRecChange := Value;
  764. end;
  765. procedure TBillsMeasureData.sdvBillsMeasureCurrentChanged(
  766. ARecord: TsdDataRecord);
  767. begin
  768. if Assigned(FOnRecChange) then
  769. FOnRecChange(ARecord);
  770. end;
  771. procedure TBillsMeasureData.ResetTreeNodeStageRec;
  772. var
  773. i: Integer;
  774. vNode: TBillsIDTreeNode;
  775. begin
  776. for i := 0 to BillsMeasureTree.Count - 1 do
  777. begin
  778. vNode := TBillsIDTreeNode(BillsMeasureTree.Items[i]);
  779. vNode.StageRec := StageData.StageRecord(vNode.ID);
  780. end;
  781. end;
  782. end.