BillsMeasureDm.pas 31 KB

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