BillsMeasureDm.pas 30 KB

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