BillsMeasureDm.pas 42 KB

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