BillsMeasureDm.pas 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279
  1. unit BillsMeasureDm;
  2. interface
  3. uses
  4. BillsDm, BillsTree, FormulaCalc, sdIDTree, StageDm,
  5. SysUtils, Classes, sdDB, DB, CalcDecimal;
  6. type
  7. TLocateZJJLEvent = procedure (ABillsID: Integer) of object;
  8. TBillsMeasureData = class(TDataModule)
  9. sdvBillsMeasure: TsdDataView;
  10. procedure sdvBillsMeasureAfterOpen(Sender: TObject);
  11. procedure sdvBillsMeasureAfterAddRecord(ARecord: TsdDataRecord);
  12. procedure sdvBillsMeasureGetText(var Text: String;
  13. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  14. DisplayText: Boolean);
  15. procedure sdvBillsMeasureSetText(var Text: String;
  16. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  17. var Allow: Boolean);
  18. procedure sdvBillsMeasureNeedLookupRecord(ARecord: TsdDataRecord;
  19. AColumn: TsdViewColumn; ANewText: String);
  20. procedure sdvBillsMeasureAfterClose(Sender: TObject);
  21. procedure sdvBillsMeasureAfterValueChanged(AValue: TsdValue);
  22. procedure sdvBillsMeasureCurrentChanged(ARecord: TsdDataRecord);
  23. procedure sdvBillsMeasureBeforeValueChange(AValue: TsdValue;
  24. const NewValue: Variant; var Allow: Boolean);
  25. private
  26. FProjectData: TObject;
  27. FBillsData: TBillsData;
  28. FBillsMeasureTree: TMeasureBillsIDTree;
  29. FFormulaCalc: TFormulaCalc;
  30. FShowParentData: Boolean;
  31. FOnRecChange: TRecChangeEvent;
  32. function OnGetCardinalNum(const ACardinalNum: string): Double;
  33. procedure CalcAddCompleteRate(ANode: TsdIDTreeNode);
  34. procedure CalcAddDgnPrice(ANode: TsdIDTreeNode);
  35. function SelectAndUpdateBGL(ABillsID: Integer; ARec: TsdDataRecord;
  36. ANewValue: Double; const AType: string): Boolean;
  37. procedure CalculateNode(ANode: TMeasureBillsIDTreeNode);
  38. procedure UpdateRecordGather(ANode: TsdIDTreeNode; AQuantity, ATotalPrice: Double);
  39. function GetStageData: TStageData;
  40. procedure SetOnRecChange(const Value: TRecChangeEvent);
  41. function GetDecimal: TCalcDecimal;
  42. public
  43. constructor Create(AProjectData: TObject);
  44. destructor Destroy; override;
  45. procedure Open;
  46. procedure Close;
  47. procedure ReConnectTree;
  48. function CheckNodeGatherCalc(ANode: TMeasureBillsIDTreeNode): Boolean;
  49. procedure CalculateAll;
  50. procedure ResetPhaseStageLink;
  51. procedure ResetTreeNodeStageRec;
  52. procedure FreeTreeNodeStageRec;
  53. procedure ExpandNodeTo(ALevel: Integer);
  54. procedure ExpandXmjNode;
  55. procedure ExpandCurPhase;
  56. function GatherRelaBGL(ANode: TsdIDTreeNode): string;
  57. function FindNodeWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  58. procedure CalcMeasureFilter;
  59. procedure ClearCurQcQty(ANode: TMeasureBillsIDTreeNode);
  60. // 计算 修改各期原报审核数据时,需对累计数据做增量
  61. procedure UpdateRecordDeal(ABillsID: Integer; AQuantity, ATotalPrice: Double);
  62. procedure UpdateRecordQc(ABillsID: Integer; AQuantity, ATotalPrice: Double);
  63. procedure UpdateRecordPc(ABillsID: Integer; AQuantity, ATotalPrice: Double);
  64. procedure UpdateRecordPM(ABillsID: Integer; ADiffer: Double);
  65. procedure UpdateGather(ABillsID: Integer; ADiffer: Double);
  66. procedure UpdateBGLInfo(ABillsID: Integer; ARec: TsdDataRecord; const AType: string);
  67. property ProjectData: TObject read FProjectData;
  68. property BillsData: TBillsData read FBillsData;
  69. property BillsMeasureTree: TMeasureBillsIDTree read FBillsMeasureTree;
  70. property Decimal: TCalcDecimal read GetDecimal;
  71. property StageData: TStageData read GetStageData;
  72. property ShowParentData: Boolean read FShowParentData write FShowParentData;
  73. property OnRecChange: TRecChangeEvent read FOnRecChange write SetOnRecChange;
  74. end;
  75. implementation
  76. uses
  77. ProjectData, PhaseData, Math, ZhAPI, BillsCommand, BGLSelectFrm,
  78. BGLDm, UtilMethods, mDataRecord, ConstUnit, Variants, ConditionalDefines;
  79. {$R *.dfm}
  80. { TBillsMeasureData }
  81. constructor TBillsMeasureData.Create(AProjectData: TObject);
  82. begin
  83. inherited Create(nil);
  84. FProjectData := AProjectData;
  85. FBillsData := TProjectData(FProjectData).BillsData;
  86. FBillsMeasureTree := TMeasureBillsIDTree.Create;
  87. FBillsMeasureTree.KeyFieldName := 'ID';
  88. FBillsMeasureTree.ParentFieldName := 'ParentID';
  89. FBillsMeasureTree.NextSiblingFieldName := 'NextSiblingID';
  90. FBillsMeasureTree.AutoCreateKeyID := True;
  91. FBillsMeasureTree.AutoExpand := True;
  92. FBillsMeasureTree.DataView := sdvBillsMeasure;
  93. FBillsMeasureTree.SeedID := Max(FBillsMeasureTree.SeedID, 100);
  94. FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True);
  95. FBillsMeasureTree.CompileTree := TProjectData(FProjectData).BillsCompileData.BillsCompileTree;
  96. FFormulaCalc := TFormulaCalc.Create(FBillsMeasureTree);
  97. FFormulaCalc.OnGetValue := OnGetCardinalNum;
  98. end;
  99. destructor TBillsMeasureData.Destroy;
  100. begin
  101. FFormulaCalc.Free;
  102. FBillsMeasureTree.Free;
  103. inherited;
  104. end;
  105. procedure TBillsMeasureData.Open;
  106. begin
  107. sdvBillsMeasure.DataSet := TProjectData(FProjectData).BillsData.sddBills;
  108. sdvBillsMeasure.Open;
  109. end;
  110. procedure TBillsMeasureData.ReConnectTree;
  111. begin
  112. FBillsMeasureTree.DataView := nil;
  113. FBillsMeasureTree.DataView := sdvBillsMeasure;
  114. FBillsMeasureTree.Link(TProjectData(FProjectData).BillsCompileData.BillsCompileTree, True);
  115. end;
  116. procedure TBillsMeasureData.ResetPhaseStageLink;
  117. begin
  118. with TProjectData(FProjectData).PhaseData do
  119. begin
  120. sdvBillsMeasure.Columns.FindColumn('CurDealQuantity').LookupDataSet := StageData.sddStage;
  121. sdvBillsMeasure.Columns.FindColumn('CurDealTotalPrice').LookupDataSet := StageData.sddStage;
  122. sdvBillsMeasure.Columns.FindColumn('CurQcQuantity').LookupDataSet := StageData.sddStage;
  123. sdvBillsMeasure.Columns.FindColumn('CurQcTotalPrice').LookupDataSet := StageData.sddStage;
  124. sdvBillsMeasure.Columns.FindColumn('CurQcBGLCode').LookupDataSet := StageData.sddStage;
  125. sdvBillsMeasure.Columns.FindColumn('CurPcQuantity').LookupDataSet := StageData.sddStage;
  126. sdvBillsMeasure.Columns.FindColumn('CurPcTotalPrice').LookupDataSet := StageData.sddStage;
  127. sdvBillsMeasure.Columns.FindColumn('CurPcBGLCode').LookupDataSet := StageData.sddStage;
  128. sdvBillsMeasure.Columns.FindColumn('CurGatherQuantity').LookupDataSet := StageData.sddStage;
  129. sdvBillsMeasure.Columns.FindColumn('CurGatherTotalPrice').LookupDataSet := StageData.sddStage;
  130. sdvBillsMeasure.Columns.FindColumn('EndDealQuantity').LookupDataSet := StageData.sddStage;
  131. sdvBillsMeasure.Columns.FindColumn('EndDealTotalPrice').LookupDataSet := StageData.sddStage;
  132. sdvBillsMeasure.Columns.FindColumn('EndQcQuantity').LookupDataSet := StageData.sddStage;
  133. sdvBillsMeasure.Columns.FindColumn('EndQcTotalPrice').LookupDataSet := StageData.sddStage;
  134. sdvBillsMeasure.Columns.FindColumn('EndPcQuantity').LookupDataSet := StageData.sddStage;
  135. sdvBillsMeasure.Columns.FindColumn('EndPcTotalPrice').LookupDataSet := StageData.sddStage;
  136. sdvBillsMeasure.Columns.FindColumn('EndGatherQuantity').LookupDataSet := StageData.sddStage;
  137. sdvBillsMeasure.Columns.FindColumn('EndGatherTotalPrice').LookupDataSet := StageData.sddStage;
  138. sdvBillsMeasure.Columns.FindColumn('PM_PreTotalPrice').LookupDataSet := StageData.sddStage;
  139. sdvBillsMeasure.Columns.FindColumn('PM_TotalPrice').LookupDataSet := StageData.sddStage;
  140. end;
  141. end;
  142. procedure TBillsMeasureData.sdvBillsMeasureAfterOpen(Sender: TObject);
  143. begin
  144. FBillsMeasureTree.Active := True;
  145. end;
  146. procedure TBillsMeasureData.sdvBillsMeasureAfterAddRecord(
  147. ARecord: TsdDataRecord);
  148. begin
  149. if TProjectData(FProjectData).PhaseData.Active then
  150. ARecord.ValueByName('IsMeasureAdd').AsBoolean := True;
  151. end;
  152. procedure TBillsMeasureData.sdvBillsMeasureGetText(var Text: String;
  153. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  154. DisplayText: Boolean);
  155. function GetQuantityValueOrFormula(const AQtyType: string): string;
  156. begin
  157. with AValue.Owner do
  158. begin
  159. if ValueByName(AQtyType + 'Flag').AsInteger = 1 then
  160. Result := ValueByName(AQtyType + 'Formula').AsString
  161. else
  162. Result := Text;
  163. end;
  164. end;
  165. function GetTotalPriceValueOrFormula(const AQtyType: string): string;
  166. begin
  167. with AValue.Owner do
  168. begin
  169. if ValueByName(AQtyType + 'Formula').AsString <> '' then
  170. Result := ValueByName(AQtyType + 'Formula').AsString
  171. else
  172. Result := Text;
  173. end;
  174. end;
  175. procedure GetDisplayText(var AText: string; AValue: TsdValue;
  176. AColumn: TsdViewColumn);
  177. var
  178. stnNode: TsdIDTreeNode;
  179. begin
  180. if Assigned(AValue) and (AValue.DataType = ftFloat) and (AValue.AsFloat = 0) then
  181. begin
  182. Text := '';
  183. Exit;
  184. end;
  185. // 所有本期数据,当节点为父节点时,不显示值(实际上需要计算其中的金额值,但又不能显示)
  186. // 有病。每天都在变。
  187. if not ShowParentData and (Pos('Cur', AColumn.FieldName) > 0) and (Pos('Gather', AColumn.FieldName) = 0) then
  188. begin
  189. stnNode := BillsMeasureTree.FindNode(AValue.Owner.ValueByName('BillsID').AsInteger);
  190. if stnNode.HasChildren then
  191. Text := '';
  192. end;
  193. end;
  194. procedure GetEditText(var AText: string; AValue: TsdValue;
  195. AColumn: TsdViewColumn);
  196. begin
  197. if SameText(AColumn.FieldName, 'Quantity') then
  198. Text := GetQuantityValueOrFormula('Qty')
  199. else if SameText(AColumn.FieldName, 'CurDealQuantity') then
  200. Text := GetQuantityValueOrFormula('Deal')
  201. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  202. Text := GetQuantityValueOrFormula('Qc')
  203. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  204. Text := GetQuantityValueOrFormula('Pc')
  205. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  206. Text := GetTotalPriceValueOrFormula('Deal')
  207. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  208. Text := GetTotalPriceValueOrFormula('Qc')
  209. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  210. Text := GetTotalPriceValueOrFormula('Pc');
  211. end;
  212. var
  213. fPercent: Double;
  214. begin
  215. if not Assigned(AValue) then Exit;
  216. if DisplayText then
  217. GetDisplayText(Text, AValue, AColumn)
  218. else
  219. GetEditText(Text, AValue, AColumn);
  220. end;
  221. procedure TBillsMeasureData.sdvBillsMeasureSetText(var Text: String;
  222. ARecord: TsdDataRecord; AValue: TsdValue; AColumn: TsdViewColumn;
  223. var Allow: Boolean);
  224. function GetBillsID: Integer;
  225. begin
  226. if Pos('Cur', AColumn.FieldName) = 1 then
  227. Result := AValue.Owner.ValueByName('BillsID').AsInteger
  228. else
  229. Result := ARecord.ValueByName('ID').AsInteger;
  230. end;
  231. procedure CheckLockedData;
  232. begin
  233. if SameText(AColumn.FieldName, 'Code') or
  234. SameText(AColumn.FieldName, 'B_Code') or
  235. SameText(AColumn.FieldName, 'Name') or
  236. SameText(AColumn.FieldName, 'Units') or
  237. SameText(AColumn.FieldName, 'Price') then
  238. if ARecord.ValueByName('LockedInfo').AsBoolean then
  239. DataSetErrorMessage(Allow, '清单信息已被锁定,不允许修改编号、名称、单位、清单单价!');
  240. if not Allow then Exit;
  241. if SameText(AColumn.FieldName, 'NewPrice') then
  242. if ARecord.ValueByName('LockedNewPrice').AsBoolean then
  243. DataSetErrorMessage(Allow, '变更单价已被锁定,不允许修改!');
  244. end;
  245. procedure CheckNodeWritable(ANode: TBillsIDTreeNode);
  246. var
  247. iCreatePhase: Integer;
  248. begin
  249. iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;
  250. {if ANode.ID = iPriceMarginID then
  251. DataSetErrorMessage(Allow, sBills_PMHint);}
  252. if SameText('B_Code', AColumn.FieldName) or
  253. SameText('Name', AColumn.FieldName) or
  254. SameText('Units', AColumn.FieldName) then
  255. if ANode.Rec.ValueByName('AddQcQuantity').AsFloat <> 0 then
  256. DataSetErrorMessage(Allow, '该清单已进行过变更,不可修改清单编号、名称、单位!');
  257. if not Allow then Exit;
  258. if SameText('Price', AColumn.FieldName) then
  259. if ANode.Rec.ValueByName('AddGatherTotalPrice').AsFloat <> 0 then
  260. DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单单价!');
  261. if not Allow then Exit;
  262. if SameText('NewPrice', AColumn.FieldName) then
  263. if ANode.Rec.ValueByName('AddPcTotalPrice').AsFloat <> 0 then
  264. DataSetErrorMessage(Allow, '该清单已经计量,不可修改清单变更单价!');
  265. if not Allow then Exit;
  266. if ANode.HasChildren then
  267. begin
  268. if Text = '' then
  269. Exit
  270. else if ((Pos('Quantity', AColumn.FieldName) > 0) and (Pos('Dgn', AColumn.FieldName) <=0)) or
  271. (Pos('TotalPrice', AColumn.FieldName) > 0) then
  272. DataSetErrorMessage(Allow, '该清单有子计算项,不能直接修改!')
  273. else if (Pos('Price', AColumn.FieldName) > 0) then
  274. DataSetErrorMessage(Allow, '仅最底层清单可输入单价!');
  275. end
  276. else
  277. begin
  278. // 目前仅允许本期合同计量,可直接输入金额
  279. if SameText('CurDealTotalPrice', AColumn.FieldName) then
  280. begin
  281. if not ANode.TotalPriceEnable then
  282. DataSetErrorMessage(Allow, '该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  283. end
  284. else if SameText('CurDealQuantity', AColumn.FieldName) or
  285. SameText('CurQcQuantity', AColumn.FieldName) or
  286. SameText('CurPcQuantity', AColumn.FieldName) or
  287. SameText('Price', AColumn.FieldName) then
  288. begin
  289. if not ANode.CountPriceEnable then
  290. DataSetErrorMessage(Allow, '该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  291. end;
  292. end;
  293. if not Allow then Exit;
  294. // 变更清单允许填写本期合同计量,按超计论
  295. {if vNode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
  296. (SameText('CurDealQuantity', AColumn.FieldName) or
  297. SameText('CurDealTotalPrice', AColumn.FieldName)) then
  298. DataSetErrorMessage(Allow, Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));}
  299. end;
  300. procedure SetQuantity(ANode: TBillsIDTreeNode; const AField: string);
  301. var
  302. vNode: TBillsIDTreeNode;
  303. begin
  304. if CheckStringNull(Text) or CheckNumeric(Text) then
  305. begin
  306. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  307. // 变更应选择变更令
  308. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  309. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  310. if not Allow then Exit;
  311. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 0;
  312. AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
  313. end
  314. else
  315. begin
  316. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  317. // 变更应选择变更令
  318. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  319. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  320. if not Allow then Exit;
  321. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 1;
  322. AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
  323. end;
  324. ANode.Rec.SetIntValue(ANode.Rec.CalcType, 0);
  325. end;
  326. procedure SetTotalPrice(ANode: TBillsIDTreeNode; const AField: string);
  327. begin
  328. // 变更应选择变更令
  329. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  330. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  331. if not Allow then Exit;
  332. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 2;
  333. AValue.Owner.ValueByName(AField + 'Quantity').AsString := '';
  334. if CheckStringNull(Text) or CheckNumeric(Text) then
  335. begin
  336. AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
  337. Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
  338. end
  339. else
  340. begin
  341. AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
  342. Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
  343. end;
  344. ANode.Rec.SetIntValue(ANode.Rec.CalcType, 1);
  345. end;
  346. procedure DoCurChanged(ANode: TBillsIDTreeNode);
  347. begin
  348. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  349. SetQuantity(ANode, 'Deal')
  350. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  351. SetQuantity(ANode, 'Qc')
  352. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  353. SetQuantity(ANode, 'Pc')
  354. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  355. SetTotalPrice(ANode, 'Deal')
  356. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  357. SetTotalPrice(ANode, 'Qc')
  358. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  359. SetTotalPrice(ANode, 'Pc')
  360. else if (Pos('DgnQuantity', AColumn.FieldName) > 0) or
  361. SameText(AColumn.FieldName, 'Quantity') then
  362. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
  363. else if SameText(AColumn.FieldName, 'NewPrice') or
  364. SameText(AColumn.FieldName, 'Price') then
  365. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)))
  366. else if SameText(AColumn.FieldName, 'Code') then
  367. BillsMeasureTree.RecodeChildrenCode(ANode, AValue.AsString, Text)
  368. else if SameText(AColumn.FieldName, 'B_Code') then
  369. BillsMeasureTree.RecodeChildrenB_Code(ANode, AValue.AsString, Text);
  370. end;
  371. function CheckValidData: Boolean;
  372. begin
  373. Result := (AValue.AsString <> Text);
  374. if (Pos('Quantity', AColumn.FieldName) > 0) or
  375. (Pos('Price', AColumn.FieldName) > 0) then
  376. begin
  377. if (AValue.AsFloat = 0) and (Text = '') then
  378. Result := False;
  379. end;
  380. end;
  381. var
  382. vNode: TBillsIDTreeNode;
  383. begin
  384. if not Assigned(AValue) then Exit;
  385. // 修改后数据与原数据相同则不提交
  386. if not CheckValidData then
  387. Allow := False;
  388. if not Allow then Exit;
  389. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GetBillsID));
  390. CheckLockedData;
  391. if not Allow then Exit;
  392. CheckNodeWritable(vNode);
  393. if not Allow then Exit;
  394. Text := Trim(Text);
  395. if Pos('=', Text) = 1 then
  396. Text := Copy(Text, 2, Length(Text) - 1);
  397. DoCurChanged(vNode);
  398. end;
  399. procedure TBillsMeasureData.sdvBillsMeasureNeedLookupRecord(
  400. ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);
  401. function CheckNeedAddPhaseRecord(ANode: TMeasureBillsIDTreeNode): Boolean;
  402. begin
  403. Result := SameText(AColumn.FieldName, 'CurDealQuantity') or
  404. SameText(AColumn.FieldName, 'CurQcQuantity') or
  405. SameText(AColumn.FieldName, 'CurPcQuantity') or
  406. SameText(AColumn.FieldName, 'CurDealTotalPrice') or
  407. SameText(AColumn.FieldName, 'CurQcTotalPrice') or
  408. SameText(AColumn.FieldName, 'CurPcTotalPrice');
  409. Result := Result and not ANode.HasChildren;
  410. Result := Result and not Assigned(ANode.StageRec);
  411. end;
  412. function HasCardinalNum(AFormula: string): Boolean;
  413. var
  414. iCharIndex: Integer;
  415. begin
  416. Result := False;
  417. iCharIndex := 1;
  418. while ((iCharIndex <= Length(AFormula)) and not Result) do
  419. begin
  420. if AFormula[iCharIndex] in ['A'..'D', 'a'..'d'] then
  421. Result := True;
  422. Inc(iCharIndex);
  423. end;
  424. end;
  425. procedure SetQuantityRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string);
  426. var
  427. bAllow: Boolean;
  428. begin
  429. bAllow := True;
  430. // 变更应选择变更令
  431. if SameText(AType , 'Qc') or SameText(AType , 'Pc') then
  432. bAllow := SelectAndUpdateBGL(ARecord.ValueByName('ID').AsInteger,
  433. APhaseRec, StrToFloatDef(ANewText, 0), AType);
  434. if bAllow then
  435. begin
  436. if ANode.Rec.CalcType.AsInteger <> 0 then
  437. ANode.Rec.CalcType.AsInteger := 0;
  438. if CheckNumeric(ANewText) then
  439. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(StrToFloatDef(ANewText, 0))
  440. else
  441. begin
  442. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 1;
  443. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(EvaluateExprs(ANewText));
  444. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  445. end;
  446. end;
  447. end;
  448. procedure SetTotalPriceRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string);
  449. begin
  450. if ANode.Rec.CalcType.AsInteger <> 1 then
  451. ANode.Rec.CalcType.AsInteger := 1;
  452. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 2;
  453. if CheckNumeric(ANewText) then
  454. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(StrToFloatDef(ANewText, 0))
  455. else
  456. begin
  457. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(EvaluateExprs(ANewText));
  458. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  459. end;
  460. end;
  461. procedure SetNewRecValue(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord);
  462. begin
  463. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  464. SetQuantityRec(ANode, APhaseRec, 'Deal')
  465. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  466. SetQuantityRec(ANode, APhaseRec, 'Qc')
  467. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  468. SetQuantityRec(ANode, APhaseRec, 'Pc')
  469. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  470. SetTotalPriceRec(ANode, APhaseRec, 'Deal')
  471. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  472. SetTotalPriceRec(ANode, APhaseRec, 'Qc')
  473. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  474. SetTotalPriceRec(ANode, APhaseRec, 'Pc');
  475. end;
  476. function CheckNodeWritable(ANode: TBillsIDTreeNode): Boolean;
  477. var
  478. iCreatePhase: Integer;
  479. begin
  480. Result := True;
  481. {if ANode.ID = iPriceMarginID then
  482. DataSetErrorMessage(Result, sBills_PMHint);}
  483. if ANode.HasChildren then
  484. begin
  485. if ANewText = '' then
  486. Result := False
  487. else
  488. DataSetErrorMessage(Result, '该清单有子计算项,不能直接修改!');
  489. end
  490. else
  491. begin
  492. // 目前仅允许本期合同计量,可直接输入金额
  493. if SameText('CurDealTotalPrice', AColumn.FieldName) then
  494. begin
  495. if not ANode.TotalPriceEnable then
  496. DataSetErrorMessage(Result, '该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  497. end
  498. else if SameText('CurDealQuantity', AColumn.FieldName) or
  499. SameText('CurQcQuantity', AColumn.FieldName) or
  500. SameText('CurPcQuantity', AColumn.FieldName) then
  501. begin
  502. if not ANode.CountPriceEnable then
  503. DataSetErrorMessage(Result, '该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  504. end;
  505. end;
  506. // 变更清单允许填写本期合同计量,按超计论
  507. {iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;
  508. if ANode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
  509. (SameText('CurDealQuantity', AColumn.FieldName) or
  510. SameText('CurDealTotalPrice', AColumn.FieldName)) then
  511. begin
  512. ErrorMessage(Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));
  513. Exit;
  514. end; }
  515. end;
  516. var
  517. NewRec: TStageRecord;
  518. vNode: TMeasureBillsIDTreeNode;
  519. begin
  520. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  521. if not CheckNodeWritable(vNode) then
  522. Exit;
  523. if CheckNeedAddPhaseRecord(vNode) then
  524. begin
  525. if (Pos('Quantity', AColumn.FieldName) > 0) or (Pos('TotalPrice', AColumn.FieldName) > 0) then
  526. if HasCardinalNum(ANewText) then
  527. raise Exception.Create('公式不可输入参数');
  528. NewRec := StageData.AddStageRecord(ARecord.ValueByName('ID').AsInteger);
  529. vNode.StageRec := NewRec;
  530. SetNewRecValue(vNode, NewRec);
  531. end;
  532. end;
  533. procedure TBillsMeasureData.sdvBillsMeasureAfterClose(Sender: TObject);
  534. begin
  535. FBillsMeasureTree.Active := False;
  536. end;
  537. function TBillsMeasureData.OnGetCardinalNum(
  538. const ACardinalNum: string): Double;
  539. {
  540. function GetTotalPrice(ABillsID: Integer): Double;
  541. var
  542. stnNode: TsdIDTreeNode;
  543. begin
  544. stnNode := FBillsTree.FindNode(ABillsID);
  545. if Assigned(stnNode) then
  546. Result := stnNode.Rec.ValueByName('TotalPrice').AsFloat;
  547. end;
  548. function GetPhaseTotalPrice(ABillsID: Integer; const AType: string): Double;
  549. var
  550. Rec: TsdDataRecord;
  551. begin
  552. Rec := CurPhaseData.PhaseRecord(ABillsID);
  553. if Assigned(Rec) then
  554. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  555. end;
  556. }
  557. function GetTotalPrice(ANode: TsdIDTreeNode): Double;
  558. var
  559. iChild: Integer;
  560. begin
  561. Result := 0;
  562. if not Assigned(ANode) then Exit;
  563. if ANode.HasChildren then
  564. for iChild := 0 to ANode.ChildCount - 1 do
  565. Result := Result + GetTotalPrice(ANode.ChildNodes[iChild])
  566. else
  567. Result := ANode.Rec.ValueByName('TotalPrice').AsFloat;
  568. end;
  569. function GetPhaseTotalPrice(ANode: TsdIDTreeNode; const AType: string): Double;
  570. var
  571. iChild: Integer;
  572. Rec: TsdDataRecord;
  573. begin
  574. Result := 0;
  575. if not Assigned(ANode) then Exit;
  576. if ANode.HasChildren then
  577. for iChild := 0 to ANode.ChildCount - 1 do
  578. Result := Result + GetPhaseTotalPrice(ANode.ChildNodes[iChild], AType)
  579. else
  580. begin
  581. Rec := StageData.StageRecord(ANode.ID);
  582. if Assigned(Rec) then
  583. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  584. end;
  585. end;
  586. var
  587. iNodeID: Integer;
  588. begin
  589. Result := 0;
  590. iNodeID := StrToIntDef(Copy(ACardinalNum, 2, Length(ACardinalNum) - 1), -1);
  591. case ACardinalNum[1] of
  592. 'A','a': Result := GetTotalPrice(BillsMeasureTree.FindNode(iNodeID));
  593. 'B','b': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Deal');
  594. 'C','c': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Qc');
  595. 'D','d': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Pc');
  596. {'A','a': Result := GetTotalPrice(iNodeID);
  597. 'B','b': Result := GetPhaseTotalPrice(iNodeID, 'Deal');
  598. 'C','c': Result := GetPhaseTotalPrice(iNodeID, 'Qc');
  599. 'D','d': Result := GetPhaseTotalPrice(iNodeID, 'Pc');}
  600. end;
  601. end;
  602. function TBillsMeasureData.GetStageData: TStageData;
  603. begin
  604. Result := TProjectData(FProjectData).PhaseData.StageData;
  605. end;
  606. procedure TBillsMeasureData.ExpandNodeTo(ALevel: Integer);
  607. begin
  608. BillsMeasureTree.ExpandLevel := ALevel;
  609. end;
  610. procedure TBillsMeasureData.ExpandXmjNode;
  611. var
  612. iIndex: Integer;
  613. stnNode: TBillsIDTreeNode;
  614. begin
  615. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  616. begin
  617. stnNode := TBillsIDTreeNode(BillsMeasureTree.Items[iIndex]);
  618. if (stnNode.ParentID <> -1) then
  619. stnNode.Parent.Expanded := stnNode.Rec.B_Code.AsString = '';
  620. end;
  621. end;
  622. procedure TBillsMeasureData.CalculateAll;
  623. var
  624. //Cacl: TBillsCalculate;
  625. i: Integer;
  626. begin
  627. if not TProjectData(FProjectData).StageDataReadOnly then
  628. for i := 0 to BillsMeasureTree.Count - 1 do
  629. CalculateNode(TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]));
  630. {Cacl := TBillsCalculate.Create(Self);
  631. try
  632. Cacl.Execute;
  633. finally
  634. Cacl.Free;
  635. end;}
  636. end;
  637. procedure TBillsMeasureData.UpdateRecordDeal(ABillsID: Integer; AQuantity,
  638. ATotalPrice: Double);
  639. var
  640. stnNode: TsdIDTreeNode;
  641. begin
  642. stnNode := BillsMeasureTree.FindNode(ABillsID);
  643. if not Assigned(stnNode) then Exit;
  644. with stnNode.Rec do
  645. begin
  646. if not stnNode.HasChildren then
  647. ValueByName('AddDealQuantity').AsFloat := QuantityRoundTo(
  648. ValueByName('AddDealQuantity').AsFloat + AQuantity);
  649. ValueByName('AddDealTotalPrice').AsFloat := TotalPriceRoundTo(
  650. ValueByName('AddDealTotalPrice').AsFloat + ATotalPrice);
  651. end;
  652. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  653. UpdateRecordDeal(stnNode.ParentID, AQuantity, ATotalPrice);
  654. end;
  655. procedure TBillsMeasureData.UpdateRecordPc(ABillsID: Integer; AQuantity,
  656. ATotalPrice: Double);
  657. var
  658. stnNode: TsdIDTreeNode;
  659. begin
  660. stnNode := BillsMeasureTree.FindNode(ABillsID);
  661. if not Assigned(stnNode) then Exit;
  662. with stnNode.Rec do
  663. begin
  664. if not stnNode.HasChildren then
  665. ValueByName('AddPcQuantity').AsFloat := QuantityRoundTo(
  666. ValueByName('AddPcQuantity').AsFloat + AQuantity);
  667. ValueByName('AddPcTotalPrice').AsFloat := TotalPriceRoundTo(
  668. ValueByName('AddPcTotalPrice').AsFloat + ATotalPrice);
  669. end;
  670. UpdateRecordGather(stnNode, 0, ATotalPrice);
  671. UpdateRecordPc(stnNode.ParentID, AQuantity, ATotalPrice);
  672. end;
  673. procedure TBillsMeasureData.UpdateRecordQc(ABillsID: Integer; AQuantity,
  674. ATotalPrice: Double);
  675. var
  676. stnNode: TsdIDTreeNode;
  677. begin
  678. stnNode := BillsMeasureTree.FindNode(ABillsID);
  679. if not Assigned(stnNode) then Exit;
  680. with stnNode.Rec do
  681. begin
  682. if not stnNode.HasChildren then
  683. ValueByName('AddQcQuantity').AsFloat := QuantityRoundTo(
  684. ValueByName('AddQcQuantity').AsFloat + AQuantity);
  685. ValueByName('AddQcTotalPrice').AsFloat := TotalPriceRoundTo(
  686. ValueByName('AddQcTotalPrice').AsFloat + ATotalPrice);
  687. end;
  688. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  689. UpdateRecordQc(stnNode.ParentID, AQuantity, ATotalPrice);
  690. end;
  691. procedure TBillsMeasureData.UpdateRecordGather(ANode: TsdIDTreeNode;
  692. AQuantity, ATotalPrice: Double);
  693. begin
  694. with ANode.Rec do
  695. begin
  696. if not ANode.HasChildren then
  697. ValueByName('AddGatherQuantity').AsFloat := QuantityRoundTo(
  698. ValueByName('AddGatherQuantity').AsFloat + AQuantity);
  699. ValueByName('AddGatherTotalPrice').AsFloat := TotalPriceRoundTo(
  700. ValueByName('AddGatherTotalPrice').AsFloat + ATotalPrice);
  701. end;
  702. CalcAddDgnPrice(ANode);
  703. CalcAddCompleteRate(ANode);
  704. end;
  705. function TBillsMeasureData.GatherRelaBGL(ANode: TsdIDTreeNode): string;
  706. var
  707. iChild: Integer;
  708. Rec: TsdDataRecord;
  709. begin
  710. Result := '';
  711. if not Assigned(ANode) then Exit;
  712. if ANode.HasChildren then
  713. begin
  714. for iChild := 0 to ANode.ChildCount - 1 do
  715. Result := MergeRelaBGL(Result, GatherRelaBGL(ANode.ChildNodes[iChild]));
  716. end
  717. else
  718. begin
  719. with TProjectData(FProjectData).PhaseData.StageData do
  720. Rec := StageRecord(ANode.ID);
  721. if Assigned(Rec) then
  722. Result := MergeRelaBGL(Rec.ValueByName('QcBGLCode').AsString, Rec.ValueByName('PcBGLCode').AsString);
  723. end;
  724. end;
  725. procedure TBillsMeasureData.sdvBillsMeasureAfterValueChanged(
  726. AValue: TsdValue);
  727. var
  728. iID: Integer;
  729. vNode: TBillsIDTreeNode;
  730. begin
  731. iID := AValue.Owner.ValueByName('ID').AsInteger;
  732. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(iID));
  733. if AValue.Owner.Owner.Name = 'sddBills' then
  734. begin
  735. if SameText(AValue.FieldName, 'Price') then
  736. TProjectData(FProjectData).BillsCompileData.Calculate(iID);
  737. if TProjectData(FProjectData).PhaseData.Active then
  738. begin
  739. if AValue.FieldName = 'Price' then
  740. StageData.ReCalculate(iID);
  741. if AValue.FieldName = 'NewPrice' then
  742. StageData.ReCalculate(iID);
  743. end;
  744. if Pos('DgnQuantity1', AValue.FieldName) > 0 then
  745. CalcAddDgnPrice(vNode);
  746. if (AValue.FieldName = 'Code') then
  747. BillsMeasureTree.RecodeChildrenCode(vNode, VarToStrDef(AValue.OldValue, ''), AValue.AsString)
  748. else if (AValue.FieldName = 'B_Code') then
  749. BillsMeasureTree.RecodeChildrenB_Code(vNode, VarToStrDef(AValue.OldValue, ''), AValue.AsString);
  750. if (AValue.FieldName = 'IsGatherZJJL') then
  751. BillsData.SyncSetOthersGatherZJJL(vNode, BillsMeasureTree);
  752. end;
  753. end;
  754. procedure TBillsMeasureData.ExpandCurPhase;
  755. var
  756. iIndex: Integer;
  757. stnNode: TsdIDTreeNode;
  758. StageRec: TStageRecord;
  759. begin
  760. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  761. begin
  762. stnNode := BillsMeasureTree.Items[iIndex];
  763. StageRec := TMeasureBillsIDTreeNode(stnNode).StageRec;
  764. if (stnNode.ParentID <> -1) then
  765. if Assigned(StageRec) then
  766. stnNode.Expanded := StageRec.GatherTotalPrice.AsFloat <> 0
  767. else
  768. stnNode.Expanded := False;
  769. end;
  770. end;
  771. procedure TBillsMeasureData.UpdateBGLInfo(ABillsID: Integer;
  772. ARec: TsdDataRecord; const AType: string);
  773. var
  774. stnNode: TsdIDTreeNode;
  775. begin
  776. stnNode := BillsMeasureTree.FindNode(ABillsID);
  777. if not Assigned(stnNode) then Exit;
  778. stnNode.Rec.ValueByName('Add' + AType + 'BGLCode').AsString :=
  779. ARec.ValueByName('End' + AType + 'BGLCode').AsString;
  780. stnNode.Rec.ValueByName('Add' + AType + 'BGLNum').AsString :=
  781. ARec.ValueByName('End' + AType + 'BGLNum').AsString;
  782. end;
  783. function TBillsMeasureData.SelectAndUpdateBGL(ABillsID: Integer;
  784. ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean;
  785. var
  786. AOrgBGL, ANewBGL: TBGLSelectInfo;
  787. ACurNode: TsdIDTreeNode;
  788. procedure UpdateBGL;
  789. begin
  790. ARec.ValueByName(AType + 'BGLCode').AsString := ANewBGL.MergedCode;
  791. ARec.ValueByName(AType + 'BGLNum').AsString := ANewBGL.MergedNum;
  792. TProjectData(ProjectData).BGLData.ApplyBGL(AOrgBGL, ANewBGL);
  793. end;
  794. begin
  795. Result := True;
  796. ACurNode := BillsMeasureTree.FindNode(ABillsID);
  797. AOrgBGL := TBGLSelectInfo.Create(ACurNode.Rec,
  798. ARec.ValueByName(AType + 'Quantity').AsFloat, True);
  799. AOrgBGL.MergedCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  800. AOrgBGL.MergedNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  801. ANewBGL := TBGLSelectInfo.Create(ACurNode.Rec, ANewValue, False);
  802. try
  803. if ANewBGL.TotalNum <> 0 then
  804. begin
  805. Result := SelectBGL(AOrgBGL, ANewBGL, ProjectData);
  806. if Result then
  807. UpdateBGL;
  808. end
  809. else
  810. UpdateBGL;
  811. StageData.UpdateBGLInfo(ARec, AType);
  812. UpdateBGLInfo(ABillsID, ARec, AType);
  813. finally
  814. AOrgBGL.Free;
  815. ANewBGL.Free;
  816. end;
  817. end;
  818. procedure TBillsMeasureData.Close;
  819. begin
  820. sdvBillsMeasure.Close;
  821. end;
  822. procedure TBillsMeasureData.CalcAddCompleteRate(ANode: TsdIDTreeNode);
  823. var
  824. fDividend, fDivisor: Double;
  825. begin
  826. with ANode.Rec do
  827. begin
  828. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  829. //fDivisor := CommonCalcRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  830. // + ValueByName('AddPcTotalPrice').AsFloat);
  831. fDivisor := TotalPriceRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  832. + ValueByName('AddPcTotalPrice').AsFloat);
  833. if fDivisor <> 0 then
  834. ValueByName('AddCompleteRate').AsFloat := AdvRoundTo(fDividend/fDivisor*100)
  835. else
  836. ValueByName('AddCompleteRate').Clear;
  837. end;
  838. end;
  839. procedure TBillsMeasureData.CalcAddDgnPrice(ANode: TsdIDTreeNode);
  840. var
  841. fDividend, fDivisor: Double;
  842. begin
  843. with ANode.Rec do
  844. begin
  845. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  846. fDivisor := ValueByName('DealDgnQuantity1').AsFloat + ValueByName('CDgnQuantity1').AsFloat;
  847. if fDivisor <> 0 then
  848. ValueByName('AddDgnPrice').AsFloat := AdvRoundTo(fDividend/fDivisor)
  849. else
  850. ValueByName('AddDgnPrice').Clear;
  851. end;
  852. end;
  853. procedure TBillsMeasureData.SetOnRecChange(const Value: TRecChangeEvent);
  854. begin
  855. FOnRecChange := Value;
  856. end;
  857. procedure TBillsMeasureData.sdvBillsMeasureCurrentChanged(
  858. ARecord: TsdDataRecord);
  859. begin
  860. if Assigned(FOnRecChange) then
  861. FOnRecChange(ARecord);
  862. end;
  863. procedure TBillsMeasureData.ResetTreeNodeStageRec;
  864. var
  865. i: Integer;
  866. vNode: TMeasureBillsIDTreeNode;
  867. begin
  868. if not StageData.Active then Exit;
  869. for i := 0 to BillsMeasureTree.Count - 1 do
  870. begin
  871. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  872. vNode.StageRec := StageData.StageRecord(vNode.ID);
  873. end;
  874. end;
  875. procedure TBillsMeasureData.UpdateRecordPM(ABillsID: Integer;
  876. ADiffer: Double);
  877. var
  878. stnNode: TBillsIDTreeNode;
  879. begin
  880. stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  881. if not Assigned(stnNode) then Exit;
  882. stnNode.Rec.PM_AddTotalPrice.AsFloat := stnNode.Rec.PM_AddTotalPrice.AsFloat + ADiffer;
  883. UpdateRecordPM(stnNode.ParentID, ADiffer);
  884. end;
  885. procedure TBillsMeasureData.CalculateNode(ANode: TMeasureBillsIDTreeNode);
  886. begin
  887. if Assigned(ANode.StageRec) then
  888. begin
  889. if not ANode.HasChildren then
  890. begin
  891. ANode.Rec.AddDealQuantity.AsFloat := ANode.StageRec.EndDealQuantity.AsFloat;
  892. ANode.Rec.AddQcQuantity.AsFloat := ANode.StageRec.EndQcQuantity.AsFloat;
  893. ANode.Rec.AddQcBGLCode.AsString := ANode.StageRec.EndQcBGLCode.AsString;
  894. ANode.Rec.AddQcBGLNum.AsString := ANode.StageRec.EndQcBGLNum.AsString;
  895. ANode.Rec.AddPcQuantity.AsFloat := ANode.StageRec.EndPcQuantity.AsFloat;
  896. ANode.Rec.AddPcBGLCode.AsString := ANode.StageRec.EndPcBGLCode.AsString;
  897. ANode.Rec.AddPcBGLNum.AsString := ANode.StageRec.EndPcBGLNum.AsString;
  898. ANode.Rec.AddGatherQuantity.AsFloat := ANode.StageRec.EndGatherQuantity.AsFloat;
  899. end;
  900. ANode.Rec.AddDealTotalPrice.AsFloat := ANode.StageRec.EndDealTotalPrice.AsFloat;
  901. ANode.Rec.AddQcTotalPrice.AsFloat := ANode.StageRec.EndQcTotalPrice.AsFloat;
  902. ANode.Rec.AddPcTotalPrice.AsFloat := ANode.StageRec.EndPcTotalPrice.AsFloat;
  903. ANode.Rec.AddGatherTotalPrice.AsFloat := ANode.StageRec.EndGatherTotalPrice.AsFloat;
  904. ANode.Rec.PM_AddTotalPrice.AsFloat := ANode.StageRec.PM_PreTotalPrice.AsFloat + ANode.StageRec.PM_TotalPrice.AsFloat;
  905. CalcAddCompleteRate(ANode);
  906. end
  907. else
  908. begin
  909. if not ANode.HasChildren then
  910. begin
  911. ANode.Rec.AddDealQuantity.Clear;
  912. ANode.Rec.AddQcQuantity.Clear;
  913. ANode.Rec.AddQcBGLCode.Clear;
  914. ANode.Rec.AddQcBGLNum.Clear;
  915. ANode.Rec.AddPcQuantity.Clear;
  916. ANode.Rec.AddPcBGLCode.Clear;
  917. ANode.Rec.AddPcBGLNum.Clear;
  918. ANode.Rec.AddGatherQuantity.Clear;
  919. end;
  920. ANode.Rec.AddDealTotalPrice.Clear;
  921. ANode.Rec.AddQcTotalPrice.Clear;
  922. ANode.Rec.AddPcTotalPrice.Clear;
  923. ANode.Rec.AddGatherTotalPrice.Clear;
  924. ANode.Rec.AddCompleteRate.Clear;
  925. ANode.Rec.PM_AddTotalPrice.Clear;
  926. end;
  927. end;
  928. procedure TBillsMeasureData.UpdateGather(ABillsID: Integer;
  929. ADiffer: Double);
  930. var
  931. stnNode: TBillsIDTreeNode;
  932. begin
  933. stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  934. if not Assigned(stnNode) then Exit;
  935. with stnNode.Rec do
  936. AddDifferValue(AddGatherTotalPrice, ADiffer);
  937. UpdateGather(stnNode.ParentID, ADiffer);
  938. end;
  939. procedure TBillsMeasureData.FreeTreeNodeStageRec;
  940. var
  941. i: Integer;
  942. vNode: TMeasureBillsIDTreeNode;
  943. begin
  944. for i := 0 to BillsMeasureTree.Count - 1 do
  945. begin
  946. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  947. vNode.StageRec := nil;
  948. end;
  949. end;
  950. function TBillsMeasureData.FindNodeWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  951. function CheckNodeHasZJJL(ANode: TsdIDTreeNode): Boolean;
  952. begin
  953. Result := Assigned(TProjectData(FProjectData).PhaseData.ZJJLData.FindZJJLRecord(ANode.ID));
  954. end;
  955. function FindChildWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  956. var
  957. iChild: Integer;
  958. vChild: TsdIDTreeNode;
  959. begin
  960. Result := nil;
  961. for iChild := 0 to ANode.ChildCount - 1 do
  962. begin
  963. vChild := ANode.ChildNodes[iChild];
  964. if CheckNodeHasZJJL(vChild) then
  965. Result := vChild
  966. else if vChild.HasChildren then
  967. Result := FindChildWithZJJL(vChild);
  968. if Assigned(Result) then
  969. Break;
  970. end;
  971. end;
  972. function FindParentWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  973. var
  974. vParent: TsdIDTreeNode;
  975. begin
  976. Result := nil;
  977. vParent := ANode.Parent;
  978. while Assigned(vParent) and not Assigned(Result) do
  979. begin
  980. if CheckNodeHasZJJL(vParent) then
  981. Result := vParent;
  982. vParent := vParent.Parent;
  983. end;
  984. end;
  985. begin
  986. if not CheckNodeHasZJJL(ANode) then
  987. begin
  988. Result := FindChildWithZJJL(ANode);
  989. if not Assigned(Result) then
  990. Result := FindParentWithZJJL(ANode);
  991. end
  992. else
  993. Result := ANode;
  994. end;
  995. procedure TBillsMeasureData.sdvBillsMeasureBeforeValueChange(
  996. AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
  997. function CheckParentExist(ANode: TBillsIDTreeNode): Boolean;
  998. var
  999. vParent: TBillsIDTreeNode;
  1000. begin
  1001. Result := False;
  1002. vParent := TBillsIDTreeNode(ANode.Parent);
  1003. while Assigned(vParent) and not Result do
  1004. begin
  1005. if vParent.Rec.IsGatherZJJL.AsBoolean then
  1006. Result := True;
  1007. vParent := TBillsIDTreeNode(vParent.Parent);
  1008. end;
  1009. end;
  1010. procedure CancelParentCheck(ANode: TBillsIDTreeNode);
  1011. var
  1012. vParent: TBillsIDTreeNode;
  1013. begin
  1014. vParent := TBillsIDTreeNode(ANode.Parent);
  1015. while Assigned(vParent) do
  1016. begin
  1017. if vParent.Rec.IsGatherZJJL.AsBoolean then
  1018. vParent.Rec.IsGatherZJJL.AsBoolean := False;
  1019. vParent := TBillsIDTreeNode(vParent.Parent);
  1020. end;
  1021. end;
  1022. function CheckChildrenExist(ANode: TBillsIDTreeNode): Boolean;
  1023. var
  1024. iChild: Integer;
  1025. vChild: TBillsIDTreeNode;
  1026. begin
  1027. Result := False;
  1028. for iChild := 0 to ANode.ChildCount - 1 do
  1029. begin
  1030. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  1031. if vChild.Rec.IsGatherZJJL.AsBoolean or CheckChildrenExist(vChild) then
  1032. begin
  1033. Result := True;
  1034. Break;
  1035. end;
  1036. end;
  1037. end;
  1038. procedure CancelChildrenCheck(ANode: TBillsIDTreeNode);
  1039. var
  1040. iChild: Integer;
  1041. vChild: TBillsIDTreeNode;
  1042. begin
  1043. for iChild := 0 to ANode.ChildCount - 1 do
  1044. begin
  1045. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  1046. if vChild.Rec.IsGatherZJJL.AsBoolean then
  1047. vChild.Rec.IsGatherZJJL.AsBoolean := False
  1048. else
  1049. CancelChildrenCheck(vChild);
  1050. end;
  1051. end;
  1052. var
  1053. vNode: TBillsIDTreeNode;
  1054. begin
  1055. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger));
  1056. if SameText(AValue.FieldName, 'IsGatherZJJL') and NewValue then
  1057. begin
  1058. if CheckParentExist(vNode) then
  1059. begin
  1060. if QuestMessage('父项已勾选,继续将取消父项勾选。') then
  1061. CancelParentCheck(vNode)
  1062. else
  1063. Allow := False;
  1064. end
  1065. else if CheckChildrenExist(vNode) then
  1066. begin
  1067. if QuestMessage('子项已勾选,继续将取消子项勾选。') then
  1068. CancelChildrenCheck(vNode)
  1069. else
  1070. Allow := False;
  1071. end;
  1072. end;
  1073. end;
  1074. function TBillsMeasureData.CheckNodeGatherCalc(
  1075. ANode: TMeasureBillsIDTreeNode): Boolean;
  1076. var
  1077. fLeafSumDeal, fLeafSumQc, fLeafSumGather: Double;
  1078. i, iCount: Integer;
  1079. vChild: TMeasureBillsIDTreeNode;
  1080. begin
  1081. if Assigned(ANode.StageRec) then
  1082. begin
  1083. fLeafSumDeal := 0;
  1084. fLeafSumQc := 0;
  1085. fLeafSumGather := 0;
  1086. iCount := ANode.PosterityCount;
  1087. i := 0;
  1088. vChild := TMeasureBillsIDTreeNode(ANode.NextNode);
  1089. while i < iCount do
  1090. begin
  1091. if not vChild.HasChildren and Assigned(vChild.StageRec) then
  1092. begin
  1093. fLeafSumDeal := fLeafSumDeal + vChild.StageRec.DealTotalPrice.AsFloat;
  1094. fLeafSumQc := fLeafSumQc + vChild.StageRec.QcTotalPrice.AsFloat;
  1095. fLeafSumGather := fLeafSumGather + vChild.StageRec.GatherTotalPrice.AsFloat;
  1096. end;
  1097. vChild := TMeasureBillsIDTreeNode(vChild.NextNode);
  1098. Inc(i);
  1099. end;
  1100. Result := Decimal.TotalPrice.CheckSameNum(fLeafSumDeal, ANode.StageRec.DealTotalPrice.AsFloat) and
  1101. Decimal.TotalPrice.CheckSameNum(fLeafSumQc, ANode.StageRec.QcTotalPrice.AsFloat) and
  1102. Decimal.TotalPrice.CheckSameNum(fLeafSumGather, ANode.StageRec.GatherTotalPrice.AsFloat);
  1103. end
  1104. else
  1105. Result := True;
  1106. end;
  1107. function TBillsMeasureData.GetDecimal: TCalcDecimal;
  1108. begin
  1109. Result := TProjectData(FProjectData).ProjProperties.DecimalManager.Common;
  1110. end;
  1111. procedure TBillsMeasureData.CalcMeasureFilter;
  1112. var
  1113. i: Integer;
  1114. vNode: TMeasureBillsIDTreeNode;
  1115. begin
  1116. for i := 0 to BillsMeasureTree.Count - 1 do
  1117. begin
  1118. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  1119. vNode.Rec.SetBoolValue(vNode.Rec.HisHasMeasure, vNode.Rec.HisHasMeasure.AsBoolean or vNode.Rec.CurHasMeasure.AsBoolean);
  1120. vNode.Rec.SetBoolValue(vNode.Rec.CurHasMeasure, False);
  1121. end;
  1122. end;
  1123. procedure TBillsMeasureData.ClearCurQcQty(ANode: TMeasureBillsIDTreeNode);
  1124. begin
  1125. if not Assigned(ANode) or not Assigned(ANode.StageRec) then Exit;
  1126. if (ANode.StageRec.QcQuantity.AsFloat = 0) then Exit;
  1127. SelectAndUpdateBGL(ANode.ID, ANode.StageRec, 0, 'Qc');
  1128. ANode.StageRec.QcQuantity.Clear;
  1129. end;
  1130. end.