BillsMeasureDm.pas 32 KB

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