BillsMeasureDm.pas 32 KB

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