BillsMeasureDm.pas 31 KB

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