BillsMeasureDm.pas 31 KB

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