BillsMeasureDm.pas 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261
  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. // 变更应选择变更令
  304. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  305. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  306. if not Allow then Exit;
  307. if CheckStringNull(Text) or CheckNumeric(Text) then
  308. begin
  309. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 0;
  310. AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
  311. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)));
  312. end
  313. else
  314. begin
  315. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 1;
  316. AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
  317. Text := FloatToStr(QuantityRoundTo(EvaluateExprs(Text)));
  318. end;
  319. ANode.Rec.SetIntValue(ANode.Rec.CalcType, 0);
  320. end;
  321. procedure SetTotalPrice(ANode: TBillsIDTreeNode; const AField: string);
  322. begin
  323. // 变更应选择变更令
  324. if SameText(AField , 'Qc') or SameText(AField , 'Pc') then
  325. Allow := SelectAndUpdateBGL(GetBillsID, AValue.Owner, StrToFloatDef(Text, 0), AField);
  326. if not Allow then Exit;
  327. AValue.Owner.ValueByName(AField + 'Flag').AsInteger := 2;
  328. AValue.Owner.ValueByName(AField + 'Quantity').AsString := '';
  329. if CheckStringNull(Text) or CheckNumeric(Text) then
  330. begin
  331. AValue.Owner.ValueByName(AField + 'Formula').AsString := '';
  332. Text := FloatToStr(TotalPriceRoundTo(StrToFloatDef(Text, 0)));
  333. end
  334. else
  335. begin
  336. AValue.Owner.ValueByName(AField + 'Formula').AsString := Text;
  337. Text := FloatToStr(TotalPriceRoundTo(EvaluateExprs(Text)));
  338. end;
  339. ANode.Rec.SetIntValue(ANode.Rec.CalcType, 1);
  340. end;
  341. procedure DoCurChanged(ANode: TBillsIDTreeNode);
  342. begin
  343. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  344. SetQuantity(ANode, 'Deal')
  345. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  346. SetQuantity(ANode, 'Qc')
  347. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  348. SetQuantity(ANode, 'Pc')
  349. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  350. SetTotalPrice(ANode, 'Deal')
  351. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  352. SetTotalPrice(ANode, 'Qc')
  353. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  354. SetTotalPrice(ANode, 'Pc')
  355. else if (Pos('DgnQuantity', AColumn.FieldName) > 0) or
  356. SameText(AColumn.FieldName, 'Quantity') then
  357. Text := FloatToStr(QuantityRoundTo(StrToFloatDef(Text, 0)))
  358. else if SameText(AColumn.FieldName, 'NewPrice') or
  359. SameText(AColumn.FieldName, 'Price') then
  360. Text := FloatToStr(PriceRoundTo(StrToFloatDef(Text, 0)))
  361. else if SameText(AColumn.FieldName, 'Code') then
  362. BillsMeasureTree.RecodeChildrenCode(ANode, AValue.AsString, Text)
  363. else if SameText(AColumn.FieldName, 'B_Code') then
  364. BillsMeasureTree.RecodeChildrenB_Code(ANode, AValue.AsString, Text);
  365. end;
  366. function CheckValidData: Boolean;
  367. begin
  368. Result := (AValue.AsString <> Text);
  369. if (Pos('Quantity', AColumn.FieldName) > 0) or
  370. (Pos('Price', AColumn.FieldName) > 0) then
  371. begin
  372. if (AValue.AsFloat = 0) and (Text = '') then
  373. Result := False;
  374. end;
  375. end;
  376. var
  377. vNode: TBillsIDTreeNode;
  378. begin
  379. if not Assigned(AValue) then Exit;
  380. // 修改后数据与原数据相同则不提交
  381. if not CheckValidData then
  382. Allow := False;
  383. if not Allow then Exit;
  384. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(GetBillsID));
  385. CheckLockedData;
  386. if not Allow then Exit;
  387. CheckNodeWritable(vNode);
  388. if not Allow then Exit;
  389. Text := Trim(Text);
  390. if Pos('=', Text) = 1 then
  391. Text := Copy(Text, 2, Length(Text) - 1);
  392. DoCurChanged(vNode);
  393. end;
  394. procedure TBillsMeasureData.sdvBillsMeasureNeedLookupRecord(
  395. ARecord: TsdDataRecord; AColumn: TsdViewColumn; ANewText: String);
  396. function CheckNeedAddPhaseRecord(ANode: TMeasureBillsIDTreeNode): Boolean;
  397. begin
  398. Result := SameText(AColumn.FieldName, 'CurDealQuantity') or
  399. SameText(AColumn.FieldName, 'CurQcQuantity') or
  400. SameText(AColumn.FieldName, 'CurPcQuantity') or
  401. SameText(AColumn.FieldName, 'CurDealTotalPrice') or
  402. SameText(AColumn.FieldName, 'CurQcTotalPrice') or
  403. SameText(AColumn.FieldName, 'CurPcTotalPrice');
  404. Result := Result and not ANode.HasChildren;
  405. Result := Result and not Assigned(ANode.StageRec);
  406. end;
  407. function HasCardinalNum(AFormula: string): Boolean;
  408. var
  409. iCharIndex: Integer;
  410. begin
  411. Result := False;
  412. iCharIndex := 1;
  413. while ((iCharIndex <= Length(AFormula)) and not Result) do
  414. begin
  415. if AFormula[iCharIndex] in ['A'..'D', 'a'..'d'] then
  416. Result := True;
  417. Inc(iCharIndex);
  418. end;
  419. end;
  420. procedure SetQuantityRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string);
  421. var
  422. bAllow: Boolean;
  423. begin
  424. bAllow := True;
  425. // 变更应选择变更令
  426. if SameText(AType , 'Qc') or SameText(AType , 'Pc') then
  427. bAllow := SelectAndUpdateBGL(ARecord.ValueByName('ID').AsInteger,
  428. APhaseRec, StrToFloatDef(ANewText, 0), AType);
  429. if bAllow then
  430. begin
  431. if ANode.Rec.CalcType.AsInteger <> 0 then
  432. ANode.Rec.CalcType.AsInteger := 0;
  433. if CheckNumeric(ANewText) then
  434. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(StrToFloatDef(ANewText, 0))
  435. else
  436. begin
  437. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 1;
  438. APhaseRec.ValueByName(AType + 'Quantity').AsFloat := QuantityRoundTo(EvaluateExprs(ANewText));
  439. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  440. end;
  441. end;
  442. end;
  443. procedure SetTotalPriceRec(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord; const AType: string);
  444. begin
  445. if ANode.Rec.CalcType.AsInteger <> 1 then
  446. ANode.Rec.CalcType.AsInteger := 1;
  447. APhaseRec.ValueByName(AType + 'Flag').AsInteger := 2;
  448. if CheckNumeric(ANewText) then
  449. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(StrToFloatDef(ANewText, 0))
  450. else
  451. begin
  452. APhaseRec.ValueByName(AType + 'TotalPrice').AsFloat := TotalPriceRoundTo(EvaluateExprs(ANewText));
  453. APhaseRec.ValueByName(AType + 'Formula').AsString := ANewText;
  454. end;
  455. end;
  456. procedure SetNewRecValue(ANode: TBillsIDTreeNode; APhaseRec: TsdDataRecord);
  457. begin
  458. if SameText(AColumn.FieldName, 'CurDealQuantity') then
  459. SetQuantityRec(ANode, APhaseRec, 'Deal')
  460. else if SameText(AColumn.FieldName, 'CurQcQuantity') then
  461. SetQuantityRec(ANode, APhaseRec, 'Qc')
  462. else if SameText(AColumn.FieldName, 'CurPcQuantity') then
  463. SetQuantityRec(ANode, APhaseRec, 'Pc')
  464. else if SameText(AColumn.FieldName, 'CurDealTotalPrice') then
  465. SetTotalPriceRec(ANode, APhaseRec, 'Deal')
  466. else if SameText(AColumn.FieldName, 'CurQcTotalPrice') then
  467. SetTotalPriceRec(ANode, APhaseRec, 'Qc')
  468. else if SameText(AColumn.FieldName, 'CurPcTotalPrice') then
  469. SetTotalPriceRec(ANode, APhaseRec, 'Pc');
  470. end;
  471. function CheckNodeWritable(ANode: TBillsIDTreeNode): Boolean;
  472. var
  473. iCreatePhase: Integer;
  474. begin
  475. Result := True;
  476. {if ANode.ID = iPriceMarginID then
  477. DataSetErrorMessage(Result, sBills_PMHint);}
  478. if ANode.HasChildren then
  479. begin
  480. if ANewText = '' then
  481. Result := False
  482. else
  483. DataSetErrorMessage(Result, '该清单有子计算项,不能直接修改!');
  484. end
  485. else
  486. begin
  487. // 目前仅允许本期合同计量,可直接输入金额
  488. if SameText('CurDealTotalPrice', AColumn.FieldName) then
  489. begin
  490. if not ANode.TotalPriceEnable then
  491. DataSetErrorMessage(Result, '该清单不可直接输入金额,如需直接输入金额,请先清空所有数量、单价!');
  492. end
  493. else if SameText('CurDealQuantity', AColumn.FieldName) or
  494. SameText('CurQcQuantity', AColumn.FieldName) or
  495. SameText('CurPcQuantity', AColumn.FieldName) then
  496. begin
  497. if not ANode.CountPriceEnable then
  498. DataSetErrorMessage(Result, '该清单不可输入数量单价,如需使用数量×单价计算,请先清空所有直接输入的金额!');
  499. end;
  500. end;
  501. // 变更清单允许填写本期合同计量,按超计论
  502. {iCreatePhase := ANode.Rec.ValueByName('CreatePhaseID').AsInteger;
  503. if ANode.Rec.ValueByName('IsMeasureAdd').AsBoolean and (iCreatePhase > 0) and
  504. (SameText('CurDealQuantity', AColumn.FieldName) or
  505. SameText('CurDealTotalPrice', AColumn.FieldName)) then
  506. begin
  507. ErrorMessage(Format('该清单为第%d期新增清单,不可填写本期合同计量数据!', [iCreatePhase]));
  508. Exit;
  509. end; }
  510. end;
  511. var
  512. NewRec: TStageRecord;
  513. vNode: TMeasureBillsIDTreeNode;
  514. begin
  515. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.FindNode(ARecord.ValueByName('ID').AsInteger));
  516. if not CheckNodeWritable(vNode) then
  517. Exit;
  518. if CheckNeedAddPhaseRecord(vNode) then
  519. begin
  520. if (Pos('Quantity', AColumn.FieldName) > 0) or (Pos('TotalPrice', AColumn.FieldName) > 0) then
  521. if HasCardinalNum(ANewText) then
  522. raise Exception.Create('公式不可输入参数');
  523. NewRec := StageData.AddStageRecord(ARecord.ValueByName('ID').AsInteger);
  524. vNode.StageRec := NewRec;
  525. SetNewRecValue(vNode, NewRec);
  526. end;
  527. end;
  528. procedure TBillsMeasureData.sdvBillsMeasureAfterClose(Sender: TObject);
  529. begin
  530. FBillsMeasureTree.Active := False;
  531. end;
  532. function TBillsMeasureData.OnGetCardinalNum(
  533. const ACardinalNum: string): Double;
  534. {
  535. function GetTotalPrice(ABillsID: Integer): Double;
  536. var
  537. stnNode: TsdIDTreeNode;
  538. begin
  539. stnNode := FBillsTree.FindNode(ABillsID);
  540. if Assigned(stnNode) then
  541. Result := stnNode.Rec.ValueByName('TotalPrice').AsFloat;
  542. end;
  543. function GetPhaseTotalPrice(ABillsID: Integer; const AType: string): Double;
  544. var
  545. Rec: TsdDataRecord;
  546. begin
  547. Rec := CurPhaseData.PhaseRecord(ABillsID);
  548. if Assigned(Rec) then
  549. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  550. end;
  551. }
  552. function GetTotalPrice(ANode: TsdIDTreeNode): Double;
  553. var
  554. iChild: Integer;
  555. begin
  556. Result := 0;
  557. if not Assigned(ANode) then Exit;
  558. if ANode.HasChildren then
  559. for iChild := 0 to ANode.ChildCount - 1 do
  560. Result := Result + GetTotalPrice(ANode.ChildNodes[iChild])
  561. else
  562. Result := ANode.Rec.ValueByName('TotalPrice').AsFloat;
  563. end;
  564. function GetPhaseTotalPrice(ANode: TsdIDTreeNode; const AType: string): Double;
  565. var
  566. iChild: Integer;
  567. Rec: TsdDataRecord;
  568. begin
  569. Result := 0;
  570. if not Assigned(ANode) then Exit;
  571. if ANode.HasChildren then
  572. for iChild := 0 to ANode.ChildCount - 1 do
  573. Result := Result + GetPhaseTotalPrice(ANode.ChildNodes[iChild], AType)
  574. else
  575. begin
  576. Rec := StageData.StageRecord(ANode.ID);
  577. if Assigned(Rec) then
  578. Result := Rec.ValueByName(AType + 'TotalPrice').AsFloat;
  579. end;
  580. end;
  581. var
  582. iNodeID: Integer;
  583. begin
  584. Result := 0;
  585. iNodeID := StrToIntDef(Copy(ACardinalNum, 2, Length(ACardinalNum) - 1), -1);
  586. case ACardinalNum[1] of
  587. 'A','a': Result := GetTotalPrice(BillsMeasureTree.FindNode(iNodeID));
  588. 'B','b': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Deal');
  589. 'C','c': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Qc');
  590. 'D','d': Result := GetPhaseTotalPrice(BillsMeasureTree.FindNode(iNodeID), 'Pc');
  591. {'A','a': Result := GetTotalPrice(iNodeID);
  592. 'B','b': Result := GetPhaseTotalPrice(iNodeID, 'Deal');
  593. 'C','c': Result := GetPhaseTotalPrice(iNodeID, 'Qc');
  594. 'D','d': Result := GetPhaseTotalPrice(iNodeID, 'Pc');}
  595. end;
  596. end;
  597. function TBillsMeasureData.GetStageData: TStageData;
  598. begin
  599. Result := TProjectData(FProjectData).PhaseData.StageData;
  600. end;
  601. procedure TBillsMeasureData.ExpandNodeTo(ALevel: Integer);
  602. begin
  603. BillsMeasureTree.ExpandLevel := ALevel;
  604. end;
  605. procedure TBillsMeasureData.ExpandXmjNode;
  606. var
  607. iIndex: Integer;
  608. stnNode: TBillsIDTreeNode;
  609. begin
  610. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  611. begin
  612. stnNode := TBillsIDTreeNode(BillsMeasureTree.Items[iIndex]);
  613. if (stnNode.ParentID <> -1) then
  614. stnNode.Parent.Expanded := stnNode.Rec.B_Code.AsString = '';
  615. end;
  616. end;
  617. procedure TBillsMeasureData.CalculateAll;
  618. var
  619. //Cacl: TBillsCalculate;
  620. i: Integer;
  621. begin
  622. if not TProjectData(FProjectData).StageDataReadOnly then
  623. for i := 0 to BillsMeasureTree.Count - 1 do
  624. CalculateNode(TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]));
  625. {Cacl := TBillsCalculate.Create(Self);
  626. try
  627. Cacl.Execute;
  628. finally
  629. Cacl.Free;
  630. end;}
  631. end;
  632. procedure TBillsMeasureData.UpdateRecordDeal(ABillsID: Integer; AQuantity,
  633. ATotalPrice: Double);
  634. var
  635. stnNode: TsdIDTreeNode;
  636. begin
  637. stnNode := BillsMeasureTree.FindNode(ABillsID);
  638. if not Assigned(stnNode) then Exit;
  639. with stnNode.Rec do
  640. begin
  641. if not stnNode.HasChildren then
  642. ValueByName('AddDealQuantity').AsFloat := QuantityRoundTo(
  643. ValueByName('AddDealQuantity').AsFloat + AQuantity);
  644. ValueByName('AddDealTotalPrice').AsFloat := TotalPriceRoundTo(
  645. ValueByName('AddDealTotalPrice').AsFloat + ATotalPrice);
  646. end;
  647. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  648. UpdateRecordDeal(stnNode.ParentID, AQuantity, ATotalPrice);
  649. end;
  650. procedure TBillsMeasureData.UpdateRecordPc(ABillsID: Integer; AQuantity,
  651. ATotalPrice: Double);
  652. var
  653. stnNode: TsdIDTreeNode;
  654. begin
  655. stnNode := BillsMeasureTree.FindNode(ABillsID);
  656. if not Assigned(stnNode) then Exit;
  657. with stnNode.Rec do
  658. begin
  659. if not stnNode.HasChildren then
  660. ValueByName('AddPcQuantity').AsFloat := QuantityRoundTo(
  661. ValueByName('AddPcQuantity').AsFloat + AQuantity);
  662. ValueByName('AddPcTotalPrice').AsFloat := TotalPriceRoundTo(
  663. ValueByName('AddPcTotalPrice').AsFloat + ATotalPrice);
  664. end;
  665. UpdateRecordGather(stnNode, 0, ATotalPrice);
  666. UpdateRecordPc(stnNode.ParentID, AQuantity, ATotalPrice);
  667. end;
  668. procedure TBillsMeasureData.UpdateRecordQc(ABillsID: Integer; AQuantity,
  669. ATotalPrice: Double);
  670. var
  671. stnNode: TsdIDTreeNode;
  672. begin
  673. stnNode := BillsMeasureTree.FindNode(ABillsID);
  674. if not Assigned(stnNode) then Exit;
  675. with stnNode.Rec do
  676. begin
  677. if not stnNode.HasChildren then
  678. ValueByName('AddQcQuantity').AsFloat := QuantityRoundTo(
  679. ValueByName('AddQcQuantity').AsFloat + AQuantity);
  680. ValueByName('AddQcTotalPrice').AsFloat := TotalPriceRoundTo(
  681. ValueByName('AddQcTotalPrice').AsFloat + ATotalPrice);
  682. end;
  683. UpdateRecordGather(stnNode, AQuantity, ATotalPrice);
  684. UpdateRecordQc(stnNode.ParentID, AQuantity, ATotalPrice);
  685. end;
  686. procedure TBillsMeasureData.UpdateRecordGather(ANode: TsdIDTreeNode;
  687. AQuantity, ATotalPrice: Double);
  688. begin
  689. with ANode.Rec do
  690. begin
  691. if not ANode.HasChildren then
  692. ValueByName('AddGatherQuantity').AsFloat := QuantityRoundTo(
  693. ValueByName('AddGatherQuantity').AsFloat + AQuantity);
  694. ValueByName('AddGatherTotalPrice').AsFloat := TotalPriceRoundTo(
  695. ValueByName('AddGatherTotalPrice').AsFloat + ATotalPrice);
  696. end;
  697. CalcAddDgnPrice(ANode);
  698. CalcAddCompleteRate(ANode);
  699. end;
  700. function TBillsMeasureData.GatherRelaBGL(ANode: TsdIDTreeNode): string;
  701. var
  702. iChild: Integer;
  703. Rec: TsdDataRecord;
  704. begin
  705. Result := '';
  706. if not Assigned(ANode) then Exit;
  707. if ANode.HasChildren then
  708. begin
  709. for iChild := 0 to ANode.ChildCount - 1 do
  710. Result := MergeRelaBGL(Result, GatherRelaBGL(ANode.ChildNodes[iChild]));
  711. end
  712. else
  713. begin
  714. with TProjectData(FProjectData).PhaseData.StageData do
  715. Rec := StageRecord(ANode.ID);
  716. if Assigned(Rec) then
  717. Result := MergeRelaBGL(Rec.ValueByName('QcBGLCode').AsString, Rec.ValueByName('PcBGLCode').AsString);
  718. end;
  719. end;
  720. procedure TBillsMeasureData.sdvBillsMeasureAfterValueChanged(
  721. AValue: TsdValue);
  722. var
  723. iID: Integer;
  724. vNode: TBillsIDTreeNode;
  725. begin
  726. iID := AValue.Owner.ValueByName('ID').AsInteger;
  727. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(iID));
  728. if AValue.Owner.Owner.Name = 'sddBills' then
  729. begin
  730. if SameText(AValue.FieldName, 'Price') then
  731. TProjectData(FProjectData).BillsCompileData.Calculate(iID);
  732. if TProjectData(FProjectData).PhaseData.Active then
  733. begin
  734. if AValue.FieldName = 'Price' then
  735. StageData.ReCalculate(iID);
  736. if AValue.FieldName = 'NewPrice' then
  737. StageData.ReCalculate(iID);
  738. end;
  739. if Pos('DgnQuantity1', AValue.FieldName) > 0 then
  740. CalcAddDgnPrice(vNode);
  741. if (AValue.FieldName = 'Code') then
  742. BillsMeasureTree.RecodeChildrenCode(vNode, VarToStrDef(AValue.OldValue, ''), AValue.AsString)
  743. else if (AValue.FieldName = 'B_Code') then
  744. BillsMeasureTree.RecodeChildrenB_Code(vNode, VarToStrDef(AValue.OldValue, ''), AValue.AsString);
  745. end;
  746. end;
  747. procedure TBillsMeasureData.ExpandCurPhase;
  748. var
  749. iIndex: Integer;
  750. stnNode: TsdIDTreeNode;
  751. StageRec: TStageRecord;
  752. begin
  753. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  754. begin
  755. stnNode := BillsMeasureTree.Items[iIndex];
  756. StageRec := TMeasureBillsIDTreeNode(stnNode).StageRec;
  757. if (stnNode.ParentID <> -1) then
  758. if Assigned(StageRec) then
  759. stnNode.Expanded := StageRec.GatherTotalPrice.AsFloat <> 0
  760. else
  761. stnNode.Expanded := False;
  762. end;
  763. end;
  764. procedure TBillsMeasureData.UpdateBGLInfo(ABillsID: Integer;
  765. ARec: TsdDataRecord; const AType: string);
  766. var
  767. stnNode: TsdIDTreeNode;
  768. begin
  769. stnNode := BillsMeasureTree.FindNode(ABillsID);
  770. if not Assigned(stnNode) then Exit;
  771. stnNode.Rec.ValueByName('Add' + AType + 'BGLCode').AsString :=
  772. ARec.ValueByName('End' + AType + 'BGLCode').AsString;
  773. stnNode.Rec.ValueByName('Add' + AType + 'BGLNum').AsString :=
  774. ARec.ValueByName('End' + AType + 'BGLNum').AsString;
  775. end;
  776. function TBillsMeasureData.SelectAndUpdateBGL(ABillsID: Integer;
  777. ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean;
  778. var
  779. AOrgBGL, ANewBGL: TBGLSelectInfo;
  780. ACurNode: TsdIDTreeNode;
  781. procedure UpdateBGL;
  782. begin
  783. ARec.ValueByName(AType + 'BGLCode').AsString := ANewBGL.MergedCode;
  784. ARec.ValueByName(AType + 'BGLNum').AsString := ANewBGL.MergedNum;
  785. TProjectData(ProjectData).BGLData.ApplyBGL(AOrgBGL, ANewBGL);
  786. end;
  787. begin
  788. Result := True;
  789. ACurNode := BillsMeasureTree.FindNode(ABillsID);
  790. AOrgBGL := TBGLSelectInfo.Create(ACurNode.Rec,
  791. ARec.ValueByName(AType + 'Quantity').AsFloat, True);
  792. AOrgBGL.MergedCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  793. AOrgBGL.MergedNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  794. ANewBGL := TBGLSelectInfo.Create(ACurNode.Rec, ANewValue, False);
  795. try
  796. if ANewBGL.TotalNum <> 0 then
  797. begin
  798. Result := SelectBGL(AOrgBGL, ANewBGL, ProjectData);
  799. if Result then
  800. UpdateBGL;
  801. end
  802. else
  803. UpdateBGL;
  804. StageData.UpdateBGLInfo(ARec, AType);
  805. UpdateBGLInfo(ABillsID, ARec, AType);
  806. finally
  807. AOrgBGL.Free;
  808. ANewBGL.Free;
  809. end;
  810. end;
  811. procedure TBillsMeasureData.Close;
  812. begin
  813. sdvBillsMeasure.Close;
  814. end;
  815. procedure TBillsMeasureData.CalcAddCompleteRate(ANode: TsdIDTreeNode);
  816. var
  817. fDividend, fDivisor: Double;
  818. begin
  819. with ANode.Rec do
  820. begin
  821. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  822. //fDivisor := CommonCalcRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  823. // + ValueByName('AddPcTotalPrice').AsFloat);
  824. fDivisor := TotalPriceRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  825. + ValueByName('AddPcTotalPrice').AsFloat);
  826. if fDivisor <> 0 then
  827. ValueByName('AddCompleteRate').AsFloat := AdvRoundTo(fDividend/fDivisor*100)
  828. else
  829. ValueByName('AddCompleteRate').Clear;
  830. end;
  831. end;
  832. procedure TBillsMeasureData.CalcAddDgnPrice(ANode: TsdIDTreeNode);
  833. var
  834. fDividend, fDivisor: Double;
  835. begin
  836. with ANode.Rec do
  837. begin
  838. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  839. fDivisor := ValueByName('DealDgnQuantity1').AsFloat + ValueByName('CDgnQuantity1').AsFloat;
  840. if fDivisor <> 0 then
  841. ValueByName('AddDgnPrice').AsFloat := AdvRoundTo(fDividend/fDivisor)
  842. else
  843. ValueByName('AddDgnPrice').Clear;
  844. end;
  845. end;
  846. procedure TBillsMeasureData.SetOnRecChange(const Value: TRecChangeEvent);
  847. begin
  848. FOnRecChange := Value;
  849. end;
  850. procedure TBillsMeasureData.sdvBillsMeasureCurrentChanged(
  851. ARecord: TsdDataRecord);
  852. begin
  853. if Assigned(FOnRecChange) then
  854. FOnRecChange(ARecord);
  855. end;
  856. procedure TBillsMeasureData.ResetTreeNodeStageRec;
  857. var
  858. i: Integer;
  859. vNode: TMeasureBillsIDTreeNode;
  860. begin
  861. if not StageData.Active then Exit;
  862. for i := 0 to BillsMeasureTree.Count - 1 do
  863. begin
  864. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  865. vNode.StageRec := StageData.StageRecord(vNode.ID);
  866. end;
  867. end;
  868. procedure TBillsMeasureData.UpdateRecordPM(ABillsID: Integer;
  869. ADiffer: Double);
  870. var
  871. stnNode: TBillsIDTreeNode;
  872. begin
  873. stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  874. if not Assigned(stnNode) then Exit;
  875. stnNode.Rec.PM_AddTotalPrice.AsFloat := stnNode.Rec.PM_AddTotalPrice.AsFloat + ADiffer;
  876. UpdateRecordPM(stnNode.ParentID, ADiffer);
  877. end;
  878. procedure TBillsMeasureData.CalculateNode(ANode: TMeasureBillsIDTreeNode);
  879. begin
  880. if Assigned(ANode.StageRec) then
  881. begin
  882. if not ANode.HasChildren then
  883. begin
  884. ANode.Rec.AddDealQuantity.AsFloat := ANode.StageRec.EndDealQuantity.AsFloat;
  885. ANode.Rec.AddQcQuantity.AsFloat := ANode.StageRec.EndQcQuantity.AsFloat;
  886. ANode.Rec.AddQcBGLCode.AsString := ANode.StageRec.EndQcBGLCode.AsString;
  887. ANode.Rec.AddQcBGLNum.AsString := ANode.StageRec.EndQcBGLNum.AsString;
  888. ANode.Rec.AddPcQuantity.AsFloat := ANode.StageRec.EndPcQuantity.AsFloat;
  889. ANode.Rec.AddPcBGLCode.AsString := ANode.StageRec.EndPcBGLCode.AsString;
  890. ANode.Rec.AddPcBGLNum.AsString := ANode.StageRec.EndPcBGLNum.AsString;
  891. ANode.Rec.AddGatherQuantity.AsFloat := ANode.StageRec.EndGatherQuantity.AsFloat;
  892. end;
  893. ANode.Rec.AddDealTotalPrice.AsFloat := ANode.StageRec.EndDealTotalPrice.AsFloat;
  894. ANode.Rec.AddQcTotalPrice.AsFloat := ANode.StageRec.EndQcTotalPrice.AsFloat;
  895. ANode.Rec.AddPcTotalPrice.AsFloat := ANode.StageRec.EndPcTotalPrice.AsFloat;
  896. ANode.Rec.AddGatherTotalPrice.AsFloat := ANode.StageRec.EndGatherTotalPrice.AsFloat;
  897. ANode.Rec.PM_AddTotalPrice.AsFloat := ANode.StageRec.PM_PreTotalPrice.AsFloat + ANode.StageRec.PM_TotalPrice.AsFloat;
  898. CalcAddCompleteRate(ANode);
  899. end
  900. else
  901. begin
  902. if not ANode.HasChildren then
  903. begin
  904. ANode.Rec.AddDealQuantity.Clear;
  905. ANode.Rec.AddQcQuantity.Clear;
  906. ANode.Rec.AddQcBGLCode.Clear;
  907. ANode.Rec.AddQcBGLNum.Clear;
  908. ANode.Rec.AddPcQuantity.Clear;
  909. ANode.Rec.AddPcBGLCode.Clear;
  910. ANode.Rec.AddPcBGLNum.Clear;
  911. ANode.Rec.AddGatherQuantity.Clear;
  912. end;
  913. ANode.Rec.AddDealTotalPrice.Clear;
  914. ANode.Rec.AddQcTotalPrice.Clear;
  915. ANode.Rec.AddPcTotalPrice.Clear;
  916. ANode.Rec.AddGatherTotalPrice.Clear;
  917. ANode.Rec.AddCompleteRate.Clear;
  918. ANode.Rec.PM_AddTotalPrice.Clear;
  919. end;
  920. end;
  921. procedure TBillsMeasureData.UpdateGather(ABillsID: Integer;
  922. ADiffer: Double);
  923. var
  924. stnNode: TBillsIDTreeNode;
  925. begin
  926. stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  927. if not Assigned(stnNode) then Exit;
  928. with stnNode.Rec do
  929. AddDifferValue(AddGatherTotalPrice, ADiffer);
  930. UpdateGather(stnNode.ParentID, ADiffer);
  931. end;
  932. procedure TBillsMeasureData.FreeTreeNodeStageRec;
  933. var
  934. i: Integer;
  935. vNode: TMeasureBillsIDTreeNode;
  936. begin
  937. for i := 0 to BillsMeasureTree.Count - 1 do
  938. begin
  939. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  940. vNode.StageRec := nil;
  941. end;
  942. end;
  943. function TBillsMeasureData.FindNodeWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  944. function CheckNodeHasZJJL(ANode: TsdIDTreeNode): Boolean;
  945. begin
  946. Result := Assigned(TProjectData(FProjectData).PhaseData.ZJJLData.FindZJJLRecord(ANode.ID));
  947. end;
  948. function FindChildWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  949. var
  950. iChild: Integer;
  951. vChild: TsdIDTreeNode;
  952. begin
  953. Result := nil;
  954. for iChild := 0 to ANode.ChildCount - 1 do
  955. begin
  956. vChild := ANode.ChildNodes[iChild];
  957. if CheckNodeHasZJJL(vChild) then
  958. Result := vChild
  959. else if vChild.HasChildren then
  960. Result := FindChildWithZJJL(vChild);
  961. if Assigned(Result) then
  962. Break;
  963. end;
  964. end;
  965. function FindParentWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  966. var
  967. vParent: TsdIDTreeNode;
  968. begin
  969. Result := nil;
  970. vParent := ANode.Parent;
  971. while Assigned(vParent) and not Assigned(Result) do
  972. begin
  973. if CheckNodeHasZJJL(vParent) then
  974. Result := vParent;
  975. vParent := vParent.Parent;
  976. end;
  977. end;
  978. begin
  979. if not CheckNodeHasZJJL(ANode) then
  980. begin
  981. Result := FindChildWithZJJL(ANode);
  982. if not Assigned(Result) then
  983. Result := FindParentWithZJJL(ANode);
  984. end
  985. else
  986. Result := ANode;
  987. end;
  988. procedure TBillsMeasureData.sdvBillsMeasureBeforeValueChange(
  989. AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
  990. function CheckParentExist(ANode: TBillsIDTreeNode): Boolean;
  991. var
  992. vParent: TBillsIDTreeNode;
  993. begin
  994. Result := False;
  995. vParent := TBillsIDTreeNode(ANode.Parent);
  996. while Assigned(vParent) and not Result do
  997. begin
  998. if vParent.Rec.IsGatherZJJL.AsBoolean then
  999. Result := True;
  1000. vParent := TBillsIDTreeNode(vParent.Parent);
  1001. end;
  1002. end;
  1003. procedure CancelParentCheck(ANode: TBillsIDTreeNode);
  1004. var
  1005. vParent: TBillsIDTreeNode;
  1006. begin
  1007. vParent := TBillsIDTreeNode(ANode.Parent);
  1008. while Assigned(vParent) do
  1009. begin
  1010. if vParent.Rec.IsGatherZJJL.AsBoolean then
  1011. vParent.Rec.IsGatherZJJL.AsBoolean := False;
  1012. vParent := TBillsIDTreeNode(vParent.Parent);
  1013. end;
  1014. end;
  1015. function CheckChildrenExist(ANode: TBillsIDTreeNode): Boolean;
  1016. var
  1017. iChild: Integer;
  1018. vChild: TBillsIDTreeNode;
  1019. begin
  1020. Result := False;
  1021. for iChild := 0 to ANode.ChildCount - 1 do
  1022. begin
  1023. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  1024. if vChild.Rec.IsGatherZJJL.AsBoolean or CheckChildrenExist(vChild) then
  1025. begin
  1026. Result := True;
  1027. Break;
  1028. end;
  1029. end;
  1030. end;
  1031. procedure CancelChildrenCheck(ANode: TBillsIDTreeNode);
  1032. var
  1033. iChild: Integer;
  1034. vChild: TBillsIDTreeNode;
  1035. begin
  1036. for iChild := 0 to ANode.ChildCount - 1 do
  1037. begin
  1038. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  1039. if vChild.Rec.IsGatherZJJL.AsBoolean then
  1040. vChild.Rec.IsGatherZJJL.AsBoolean := False
  1041. else
  1042. CancelChildrenCheck(vChild);
  1043. end;
  1044. end;
  1045. var
  1046. vNode: TBillsIDTreeNode;
  1047. begin
  1048. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger));
  1049. if SameText(AValue.FieldName, 'IsGatherZJJL') and NewValue then
  1050. begin
  1051. if CheckParentExist(vNode) then
  1052. begin
  1053. if QuestMessage('父项已勾选,继续将取消父项勾选。') then
  1054. CancelParentCheck(vNode)
  1055. else
  1056. Allow := False;
  1057. end
  1058. else if CheckChildrenExist(vNode) then
  1059. begin
  1060. if QuestMessage('子项已勾选,继续将取消子项勾选。') then
  1061. CancelChildrenCheck(vNode)
  1062. else
  1063. Allow := False;
  1064. end;
  1065. end;
  1066. end;
  1067. function TBillsMeasureData.CheckNodeGatherCalc(
  1068. ANode: TMeasureBillsIDTreeNode): Boolean;
  1069. var
  1070. fLeafSumDeal, fLeafSumQc, fLeafSumGather: Double;
  1071. i, iCount: Integer;
  1072. vChild: TMeasureBillsIDTreeNode;
  1073. begin
  1074. if Assigned(ANode.StageRec) then
  1075. begin
  1076. fLeafSumDeal := 0;
  1077. fLeafSumQc := 0;
  1078. fLeafSumGather := 0;
  1079. iCount := ANode.PosterityCount;
  1080. i := 0;
  1081. vChild := TMeasureBillsIDTreeNode(ANode.NextNode);
  1082. while i < iCount do
  1083. begin
  1084. if not vChild.HasChildren and Assigned(vChild.StageRec) then
  1085. begin
  1086. fLeafSumDeal := fLeafSumDeal + vChild.StageRec.DealTotalPrice.AsFloat;
  1087. fLeafSumQc := fLeafSumQc + vChild.StageRec.QcTotalPrice.AsFloat;
  1088. fLeafSumGather := fLeafSumGather + vChild.StageRec.GatherTotalPrice.AsFloat;
  1089. end;
  1090. vChild := TMeasureBillsIDTreeNode(vChild.NextNode);
  1091. Inc(i);
  1092. end;
  1093. Result := Decimal.TotalPrice.CheckSameNum(fLeafSumDeal, ANode.StageRec.DealTotalPrice.AsFloat) and
  1094. Decimal.TotalPrice.CheckSameNum(fLeafSumQc, ANode.StageRec.QcTotalPrice.AsFloat) and
  1095. Decimal.TotalPrice.CheckSameNum(fLeafSumGather, ANode.StageRec.GatherTotalPrice.AsFloat);
  1096. end
  1097. else
  1098. Result := True;
  1099. end;
  1100. function TBillsMeasureData.GetDecimal: TCalcDecimal;
  1101. begin
  1102. Result := TProjectData(FProjectData).ProjProperties.DecimalManager.Common;
  1103. end;
  1104. procedure TBillsMeasureData.CalcMeasureFilter;
  1105. var
  1106. i: Integer;
  1107. vNode: TMeasureBillsIDTreeNode;
  1108. begin
  1109. for i := 0 to BillsMeasureTree.Count - 1 do
  1110. begin
  1111. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  1112. vNode.Rec.SetBoolValue(vNode.Rec.HisHasMeasure, vNode.Rec.HisHasMeasure.AsBoolean or vNode.Rec.CurHasMeasure.AsBoolean);
  1113. vNode.Rec.SetBoolValue(vNode.Rec.CurHasMeasure, False);
  1114. end;
  1115. end;
  1116. end.