BillsMeasureDm.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908
  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: TBillsIDTreeNode;
  245. iCreatePhase: Integer;
  246. begin
  247. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GetBillsID));
  248. iCreatePhase := vNode.Rec.ValueByName('CreatePhaseID').AsInteger;
  249. if SameText('B_Code', AColumn.FieldName) or
  250. SameText('Name', AColumn.FieldName) or
  251. SameText('Units', AColumn.FieldName) then
  252. if vNode.Rec.ValueByName('AddQcQuantity').AsFloat <> 0 then
  253. DataSetErrorMessage(Allow, '该清单已进行过变更,不可修改清单编号、名称、单位!');
  254. if not Allow then Exit;
  255. if SameText('Price', AColumn.FieldName) then
  256. if vNode.Rec.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
  257. DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单单价!');
  258. if not Allow then Exit;
  259. if SameText('NewPrice', AColumn.FieldName) then
  260. if vNode.Rec.ValueByName('AddPcTotalPrice').AsFloat <> 0 then
  261. DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单变更单价!');
  262. if not Allow then Exit;
  263. if vNode.HasChildren then
  264. begin
  265. if Text = '' then
  266. Exit
  267. else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or
  268. (Pos('TotalPrice', AColumn.FieldName) > 0) then
  269. DataSetErrorMessage(Allow, '该清单有子计算项,不能直接修改!')
  270. else if (Pos('Price', AColumn.FieldName) > 0) then
  271. DataSetErrorMessage(Allow, '仅最底层清单可输入单价!');
  272. end
  273. else
  274. begin
  275. // 目前仅允许本期合同计量,可直接输入金额
  276. if SameText('CurDealTotalPrice', AColumn.FieldName) then
  277. begin
  278. if not vNode.TotalPriceEnable then
  279. DataSetErrorMessage(Allow, '该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  280. end
  281. else if SameText('CurDealQuantity', AColumn.FieldName) or
  282. SameText('CurQcQuantity', AColumn.FieldName) or
  283. SameText('CurPcQuantity', AColumn.FieldName) then
  284. begin
  285. if not vNode.CountPriceEnable then
  286. DataSetErrorMessage(Allow, '该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  287. end;
  288. end;
  289. if not Allow then Exit;
  290. // 变更清单允许填写本期合同计量,按超计论
  291. {if vNode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
  292. (SameText('CurDealQuantity', AColumn.FieldName) or
  293. SameText('CurDealTotalPrice', AColumn.FieldName)) then
  294. DataSetErrorMessage(Allow, Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));}
  295. end;
  296. procedure SetQuantity(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. if CheckStringNull(Text) or CheckNumeric(Text) then
  303. begin
  304. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 0;
  305. AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
  306. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  307. end
  308. else
  309. begin
  310. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 1;
  311. AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
  312. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  313. end;
  314. end;
  315. procedure SetTotalPrice(const AField: string);
  316. begin
  317. // 变更应选择变更令
  318. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  319. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  320. if not Allow then Exit;
  321. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 2;
  322. AValue.Owner.ValueByName(AField + 'Quantity').AsString := '';
  323. if CheckStringNull(Text) or CheckNumeric(Text) then
  324. begin
  325. AValue.Owner.ValueByName('Formula').AsString := '';
  326. Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
  327. end
  328. else
  329. begin
  330. AValue.Owner.ValueByName('Formula').AsString := Text;
  331. Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
  332. end;
  333. end;
  334. procedure DoCurChanged;
  335. begin
  336. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  337. SetQuantity('Deal')
  338. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  339. SetQuantity('Qc')
  340. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  341. SetQuantity('Pc')
  342. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  343. SetTotalPrice('Deal')
  344. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  345. SetTotalPrice('Qc')
  346. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  347. SetTotalPrice('Pc')
  348. else if (Pos('DgnQuantity', AColumn.FieldName) > 0) or
  349. SameText(AColumn.FieldName, 'Quantity') then
  350. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
  351. else if SameText(AColumn.FieldName, 'NewPrice') or
  352. SameText(AColumn.FieldName, 'Price') then
  353. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)));
  354. end;
  355. begin
  356. if not Assigned(AValue) then Exit;
  357. CheckLockedData;
  358. if not Allow then Exit;
  359. CheckNodeWritable;
  360. if not Allow then Exit;
  361. Text := Trim(Text);
  362. if Pos('=', Text) = 1 then
  363. Text := Copy(Text, 2, Length(Text) - 1);
  364. DoCurChanged;
  365. end;
  366. procedure TBillsMeasureData.sdvBillsMeasureNeedLookupRecord(
  367. ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);
  368. function CheckNeedAddPhaseRecord(ANode: TBillsIDTreeNode): Boolean;
  369. begin
  370. Result := SameText(AColumn.FieldName, 'CurDealQuantity') or
  371. SameText(AColumn.FieldName, 'CurQcQuantity') or
  372. SameText(AColumn.FieldName, 'CurPcQuantity') or
  373. SameText(AColumn.FieldName, 'CurDealTotalPrice') or
  374. SameText(AColumn.FieldName, 'CurQcTotalPrice') or
  375. SameText(AColumn.FieldName, 'CurPcTotalPrice');
  376. Result := Result and not ANode.HasChildren;
  377. Result := Result and not Assigned(ANode.StageRec);
  378. end;
  379. function HasCardinalNum(AFormula: string): Boolean;
  380. var
  381. iCharIndex: Integer;
  382. begin
  383. Result := False;
  384. iCharIndex := 1;
  385. while ((iCharIndex <= Length(AFormula)) and not Result) do
  386. begin
  387. if AFormula[iCharIndex] in ['A'..'D', 'a'..'d'] then
  388. Result := True;
  389. Inc(iCharIndex);
  390. end;
  391. end;
  392. procedure SetQuantityRec(APhaseRec: TsdDataRecord; const AType: string);
  393. var
  394. bAllow: Boolean;
  395. begin
  396. bAllow := True;
  397. // 变更应选择变更令
  398. if SameText(AType , 'Qc') or SameText(AType , 'Pc') then
  399. bAllow := SelectAndUpdateBGL(ARecord.ValueByName('ID').AsInteger,
  400. APhaseRec, StrToFloatDef(ANewText, 0), AType);
  401. if bAllow then
  402. begin
  403. if CheckNumeric(ANewText) then
  404. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(StrToFloatDef(ANewText, 0))
  405. else
  406. begin
  407. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 1;
  408. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(EvaluateExprs(ANewText));
  409. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  410. end;
  411. end;
  412. end;
  413. procedure SetTotalPriceRec(APhaseRec: TsdDataRecord; const AType: string);
  414. begin
  415. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 2;
  416. if CheckNumeric(ANewText) then
  417. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(StrToFloatDef(ANewText, 0))
  418. else
  419. begin
  420. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(EvaluateExprs(ANewText));
  421. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  422. end;
  423. end;
  424. procedure SetNewRecValue(APhaseRec: TsdDataRecord);
  425. begin
  426. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  427. SetQuantityRec(APhaseRec, 'Deal')
  428. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  429. SetQuantityRec(APhaseRec, 'Qc')
  430. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  431. SetQuantityRec(APhaseRec, 'Pc')
  432. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  433. SetTotalPriceRec(APhaseRec, 'Deal')
  434. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  435. SetTotalPriceRec(APhaseRec, 'Qc')
  436. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  437. SetTotalPriceRec(APhaseRec, 'Pc');
  438. end;
  439. function CheckNodeWritable(ANode: TBillsIDTreeNode): Boolean;
  440. var
  441. iCreatePhase: Integer;
  442. begin
  443. Result := True;
  444. if ANode.HasChildren then
  445. begin
  446. if ANewText = '' then
  447. Result := False
  448. else
  449. DataSetErrorMessage(Result, '该清单有子计算项,不能直接修改!');
  450. end
  451. else
  452. begin
  453. // 目前仅允许本期合同计量,可直接输入金额
  454. if SameText('CurDealTotalPrice', AColumn.FieldName) then
  455. begin
  456. if not ANode.TotalPriceEnable then
  457. DataSetErrorMessage(Result, '该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  458. end
  459. else if SameText('CurDealQuantity', AColumn.FieldName) or
  460. SameText('CurQcQuantity', AColumn.FieldName) or
  461. SameText('CurPcQuantity', AColumn.FieldName) then
  462. begin
  463. if not ANode.CountPriceEnable then
  464. DataSetErrorMessage(Result, '该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  465. end;
  466. end;
  467. // 变更清单允许填写本期合同计量,按超计论
  468. {iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;
  469. if ANode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
  470. (SameText('CurDealQuantity', AColumn.FieldName) or
  471. SameText('CurDealTotalPrice', AColumn.FieldName)) then
  472. begin
  473. ErrorMessage(Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));
  474. Exit;
  475. end; }
  476. end;
  477. var
  478. NewRec: TStageRecord;
  479. vNode: TBillsIDTreeNode;
  480. begin
  481. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  482. if not CheckNodeWritable(vNode) then
  483. Exit;
  484. if CheckNeedAddPhaseRecord(vNode) then
  485. begin
  486. if Pos('Quantity', AColumn.FieldName) > 0 then
  487. if HasCardinalNum(ANewText) then
  488. raise Exception.Create('数量列公式不可输入参数');
  489. NewRec := StageData.AddStageRecord(ARecord.ValueByName('ID').AsInteger);
  490. SetNewRecValue(NewRec);
  491. vNode.StageRec := NewRec;
  492. end;
  493. end;
  494. procedure TBillsMeasureData.sdvBillsMeasureAfterClose(Sender: TObject);
  495. begin
  496. FBillsMeasureTree.Active := False;
  497. end;
  498. function TBillsMeasureData.OnGetCardinalNum(
  499. const ACardinalNum: string): Double;
  500. {
  501. function GetTotalPrice(ABillsID: Integer): Double;
  502. var
  503. stnNode: TsdIDTreeNode;
  504. begin
  505. stnNode := FBillsTree.FindNode(ABillsID);
  506. if Assigned(stnNode) then
  507. Result := stnNode.Rec.ValueByName('TotalPrice').AsFloat;
  508. end;
  509. function GetPhaseTotalPrice(ABillsID: Integer; const AType: string): Double;
  510. var
  511. Rec: TsdDataRecord;
  512. begin
  513. Rec := CurPhaseData.PhaseRecord(ABillsID);
  514. if Assigned(Rec) then
  515. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  516. end;
  517. }
  518. function GetTotalPrice(ANode: TsdIDTreeNode): Double;
  519. var
  520. iChild: Integer;
  521. begin
  522. Result := 0;
  523. if not Assigned(ANode) then Exit;
  524. if ANode.HasChildren then
  525. for iChild := 0 to ANode.ChildCount - 1 do
  526. Result := Result + GetTotalPrice(ANode.ChildNodes[iChild])
  527. else
  528. Result := ANode.Rec.ValueByName('TotalPrice').AsFloat;
  529. end;
  530. function GetPhaseTotalPrice(ANode: TsdIDTreeNode; const AType: string): Double;
  531. var
  532. iChild: Integer;
  533. Rec: TsdDataRecord;
  534. begin
  535. Result := 0;
  536. if not Assigned(ANode) then Exit;
  537. if ANode.HasChildren then
  538. for iChild := 0 to ANode.ChildCount - 1 do
  539. Result := Result + GetPhaseTotalPrice(ANode.ChildNodes[iChild], AType)
  540. else
  541. begin
  542. Rec := StageData.StageRecord(ANode.ID);
  543. if Assigned(Rec) then
  544. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  545. end;
  546. end;
  547. var
  548. iNodeID: Integer;
  549. begin
  550. Result := 0;
  551. iNodeID := StrToIntDef(Copy(ACardinalNum, 2, Length(ACardinalNum) - 1), -1);
  552. case ACardinalNum[1] of
  553. 'A','a': Result := GetTotalPrice(BillsMeasureTree.FindNode(iNodeID));
  554. 'B','b': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Deal');
  555. 'C','c': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Qc');
  556. 'D','d': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Pc');
  557. {'A','a': Result := GetTotalPrice(iNodeID);
  558. 'B','b': Result := GetPhaseTotalPrice(iNodeID, 'Deal');
  559. 'C','c': Result := GetPhaseTotalPrice(iNodeID, 'Qc');
  560. 'D','d': Result := GetPhaseTotalPrice(iNodeID, 'Pc');}
  561. end;
  562. end;
  563. function TBillsMeasureData.GetStageData: TStageData;
  564. begin
  565. Result := TProjectData(FProjectData).PhaseData.StageData;
  566. end;
  567. procedure TBillsMeasureData.ExpandNodeTo(ALevel: Integer);
  568. begin
  569. BillsMeasureTree.ExpandLevel := ALevel;
  570. end;
  571. procedure TBillsMeasureData.ExpandXmjNode;
  572. var
  573. iIndex: Integer;
  574. stnNode: TsdIDTreeNode;
  575. begin
  576. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  577. begin
  578. stnNode := BillsMeasureTree.Items[iIndex];
  579. if (stnNode.ParentID <> -1) then
  580. stnNode.Parent.Expanded := stnNode.Rec.ValueByName('B_Code').AsString = '';
  581. end;
  582. end;
  583. procedure TBillsMeasureData.CalculateAll;
  584. var
  585. Cacl: TBillsCalculate;
  586. begin
  587. Cacl := TBillsCalculate.Create(Self);
  588. try
  589. Cacl.Execute;
  590. finally
  591. Cacl.Free;
  592. end;
  593. end;
  594. procedure TBillsMeasureData.UpdateRecordDeal(ABillsID: Integer; AQuantity,
  595. ATotalPrice: Double);
  596. var
  597. stnNode: TsdIDTreeNode;
  598. begin
  599. stnNode := BillsMeasureTree.FindNode(ABillsID);
  600. if not Assigned(stnNode) then Exit;
  601. with stnNode.Rec do
  602. begin
  603. if not stnNode.HasChildren then
  604. ValueByName('AddDealQuantity').AsFloat := QuantityRoundTo(
  605. ValueByName('AddDealQuantity').AsFloat + AQuantity);
  606. ValueByName('AddDealTotalPrice').AsFloat := TotalPriceRoundTo(
  607. ValueByName('AddDealTotalPrice').AsFloat + ATotalPrice);
  608. end;
  609. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  610. UpdateRecordDeal(stnNode.ParentID, AQuantity, ATotalPrice);
  611. end;
  612. procedure TBillsMeasureData.UpdateRecordPc(ABillsID: Integer; AQuantity,
  613. ATotalPrice: Double);
  614. var
  615. stnNode: TsdIDTreeNode;
  616. begin
  617. stnNode := BillsMeasureTree.FindNode(ABillsID);
  618. if not Assigned(stnNode) then Exit;
  619. with stnNode.Rec do
  620. begin
  621. if not stnNode.HasChildren then
  622. ValueByName('AddPcQuantity').AsFloat := QuantityRoundTo(
  623. ValueByName('AddPcQuantity').AsFloat + AQuantity);
  624. ValueByName('AddPcTotalPrice').AsFloat := TotalPriceRoundTo(
  625. ValueByName('AddPcTotalPrice').AsFloat + ATotalPrice);
  626. end;
  627. UpdateRecordGather(stnNode, 0, ATotalPrice);
  628. UpdateRecordPc(stnNode.ParentID, AQuantity, ATotalPrice);
  629. end;
  630. procedure TBillsMeasureData.UpdateRecordQc(ABillsID: Integer; AQuantity,
  631. ATotalPrice: Double);
  632. var
  633. stnNode: TsdIDTreeNode;
  634. begin
  635. stnNode := BillsMeasureTree.FindNode(ABillsID);
  636. if not Assigned(stnNode) then Exit;
  637. with stnNode.Rec do
  638. begin
  639. if not stnNode.HasChildren then
  640. ValueByName('AddQcQuantity').AsFloat := QuantityRoundTo(
  641. ValueByName('AddQcQuantity').AsFloat + AQuantity);
  642. ValueByName('AddQcTotalPrice').AsFloat := TotalPriceRoundTo(
  643. ValueByName('AddQcTotalPrice').AsFloat + ATotalPrice);
  644. end;
  645. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  646. UpdateRecordQc(stnNode.ParentID, AQuantity, ATotalPrice);
  647. end;
  648. procedure TBillsMeasureData.UpdateRecordGather(ANode: TsdIDTreeNode;
  649. AQuantity, ATotalPrice: Double);
  650. begin
  651. with ANode.Rec do
  652. begin
  653. if not ANode.HasChildren then
  654. ValueByName('AddGatherQuantity').AsFloat := QuantityRoundTo(
  655. ValueByName('AddGatherQuantity').AsFloat + AQuantity);
  656. ValueByName('AddGatherTotalPrice').AsFloat := TotalPriceRoundTo(
  657. ValueByName('AddGatherTotalPrice').AsFloat + ATotalPrice);
  658. end;
  659. CalcAddDgnPrice(ANode);
  660. CalcAddCompleteRate(ANode);
  661. end;
  662. function TBillsMeasureData.GatherRelaBGL(ANode: TsdIDTreeNode): string;
  663. var
  664. iChild: Integer;
  665. Rec: TsdDataRecord;
  666. begin
  667. Result := '';
  668. if not Assigned(ANode) then Exit;
  669. if ANode.HasChildren then
  670. begin
  671. for iChild := 0 to ANode.ChildCount - 1 do
  672. Result := MergeRelaBGL(Result, GatherRelaBGL(ANode.ChildNodes[iChild]));
  673. end
  674. else
  675. begin
  676. with TProjectData(FProjectData).PhaseData.StageData do
  677. Rec := StageRecord(ANode.ID);
  678. if Assigned(Rec) then
  679. Result := MergeRelaBGL(Rec.ValueByName('QcBGLCode').AsString, Rec.ValueByName('PcBGLCode').AsString);
  680. end;
  681. end;
  682. procedure TBillsMeasureData.sdvBillsMeasureAfterValueChanged(
  683. AValue: TsdValue);
  684. var
  685. stnNode: TsdIDTreeNode;
  686. begin
  687. if TProjectData(FProjectData).PhaseData.Active then
  688. begin
  689. if AValue.FieldName = 'Price' then
  690. StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
  691. if AValue.FieldName = 'NewPrice' then
  692. StageData.ReCalculate(AValue.Owner.ValueByName('ID').AsInteger);
  693. end;
  694. if Pos('DgnQuantity1', AValue.FieldName) > 0 then
  695. begin
  696. stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger);
  697. CalcAddDgnPrice(stnNode);
  698. end;
  699. end;
  700. procedure TBillsMeasureData.ExpandCurPhase;
  701. var
  702. iIndex: Integer;
  703. stnNode: TsdIDTreeNode;
  704. StageRec: TsdDataRecord;
  705. begin
  706. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  707. begin
  708. stnNode := BillsMeasureTree.Items[iIndex];
  709. StageRec := TBillsIDTreeNode(stnNode).StageRec;
  710. if (stnNode.ParentID <> -1) then
  711. if Assigned(StageRec) then
  712. stnNode.Expanded := StageRec.ValueByName('GatherTotalPrice').AsFloat <> 0
  713. else
  714. stnNode.Expanded := False;
  715. end;
  716. end;
  717. procedure TBillsMeasureData.UpdateBGLInfo(ABillsID: Integer;
  718. ARec: TsdDataRecord; const AType: string);
  719. var
  720. stnNode: TsdIDTreeNode;
  721. begin
  722. stnNode := BillsMeasureTree.FindNode(ABillsID);
  723. if not Assigned(stnNode) then Exit;
  724. stnNode.Rec.ValueByName('Add' + AType + 'BGLCode').AsString :=
  725. ARec.ValueByName('End' + AType + 'BGLCode').AsString;
  726. stnNode.Rec.ValueByName('Add' + AType + 'BGLNum').AsString :=
  727. ARec.ValueByName('End' + AType + 'BGLNum').AsString;
  728. end;
  729. function TBillsMeasureData.SelectAndUpdateBGL(ABillsID: Integer;
  730. ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean;
  731. var
  732. AOrgBGL, ANewBGL: TBGLSelectInfo;
  733. ACurNode: TsdIDTreeNode;
  734. procedure UpdateBGL;
  735. begin
  736. ARec.ValueByName(AType + 'BGLCode').AsString := ANewBGL.MergedCode;
  737. ARec.ValueByName(AType + 'BGLNum').AsString := ANewBGL.MergedNum;
  738. TProjectData(ProjectData).BGLData.ApplyBGL(AOrgBGL, ANewBGL);
  739. end;
  740. begin
  741. Result := True;
  742. ACurNode := BillsMeasureTree.FindNode(ABillsID);
  743. AOrgBGL := TBGLSelectInfo.Create(ACurNode.Rec,
  744. ARec.ValueByName(AType + 'Quantity').AsFloat, True);
  745. AOrgBGL.MergedCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  746. AOrgBGL.MergedNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  747. ANewBGL := TBGLSelectInfo.Create(ACurNode.Rec, ANewValue, False);
  748. try
  749. if ANewBGL.TotalNum <> 0 then
  750. begin
  751. Result := SelectBGL(AOrgBGL, ANewBGL, ProjectData);
  752. if Result then
  753. UpdateBGL;
  754. end
  755. else
  756. UpdateBGL;
  757. StageData.UpdateBGLInfo(ARec, AType);
  758. UpdateBGLInfo(ABillsID, ARec, AType);
  759. finally
  760. AOrgBGL.Free;
  761. ANewBGL.Free;
  762. end;
  763. end;
  764. procedure TBillsMeasureData.Close;
  765. begin
  766. sdvBillsMeasure.Close;
  767. end;
  768. procedure TBillsMeasureData.CalcAddCompleteRate(ANode: TsdIDTreeNode);
  769. var
  770. fDividend, fDivisor: Double;
  771. begin
  772. with ANode.Rec do
  773. begin
  774. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  775. fDivisor := ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  776. + ValueByName('AddPcTotalPrice').AsFloat;
  777. if fDivisor <> 0 then
  778. ValueByName('AddCompleteRate').AsFloat := AdvRoundTo(fDividend/fDivisor*100);
  779. end;
  780. end;
  781. procedure TBillsMeasureData.CalcAddDgnPrice(ANode: TsdIDTreeNode);
  782. var
  783. fDividend, fDivisor: Double;
  784. begin
  785. with ANode.Rec do
  786. begin
  787. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  788. fDivisor := ValueByName('DealDgnQuantity1').AsFloat + ValueByName('CDgnQuantity1').AsFloat;
  789. if fDivisor <> 0 then
  790. ValueByName('AddDgnPrice').AsFloat := AdvRoundTo(fDividend/fDivisor);
  791. end;
  792. end;
  793. procedure TBillsMeasureData.SetOnRecChange(const Value: TRecChangeEvent);
  794. begin
  795. FOnRecChange := Value;
  796. end;
  797. procedure TBillsMeasureData.sdvBillsMeasureCurrentChanged(
  798. ARecord: TsdDataRecord);
  799. begin
  800. if Assigned(FOnRecChange) then
  801. FOnRecChange(ARecord);
  802. end;
  803. procedure TBillsMeasureData.ResetTreeNodeStageRec;
  804. var
  805. i: Integer;
  806. vNode: TBillsIDTreeNode;
  807. begin
  808. for i := 0 to BillsMeasureTree.Count - 1 do
  809. begin
  810. vNode := TBillsIDTreeNode(BillsMeasureTree.Items[i]);
  811. vNode.StageRec := StageData.StageRecord(vNode.ID);
  812. end;
  813. end;
  814. end.