BillsMeasureDm.pas 29 KB

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