BillsMeasureDm.pas 31 KB

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