BillsMeasureDm.pas 42 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264
  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. if (AValue.FieldName = 'IsGatherZJJL') then
  746. BillsData.SyncSetOthersGatherZJJL(vNode, BillsMeasureTree);
  747. end;
  748. end;
  749. procedure TBillsMeasureData.ExpandCurPhase;
  750. var
  751. iIndex: Integer;
  752. stnNode: TsdIDTreeNode;
  753. StageRec: TStageRecord;
  754. begin
  755. for iIndex := 0 to BillsMeasureTree.Count - 1 do
  756. begin
  757. stnNode := BillsMeasureTree.Items[iIndex];
  758. StageRec := TMeasureBillsIDTreeNode(stnNode).StageRec;
  759. if (stnNode.ParentID <> -1) then
  760. if Assigned(StageRec) then
  761. stnNode.Expanded := StageRec.GatherTotalPrice.AsFloat <> 0
  762. else
  763. stnNode.Expanded := False;
  764. end;
  765. end;
  766. procedure TBillsMeasureData.UpdateBGLInfo(ABillsID: Integer;
  767. ARec: TsdDataRecord; const AType: string);
  768. var
  769. stnNode: TsdIDTreeNode;
  770. begin
  771. stnNode := BillsMeasureTree.FindNode(ABillsID);
  772. if not Assigned(stnNode) then Exit;
  773. stnNode.Rec.ValueByName('Add' + AType + 'BGLCode').AsString :=
  774. ARec.ValueByName('End' + AType + 'BGLCode').AsString;
  775. stnNode.Rec.ValueByName('Add' + AType + 'BGLNum').AsString :=
  776. ARec.ValueByName('End' + AType + 'BGLNum').AsString;
  777. end;
  778. function TBillsMeasureData.SelectAndUpdateBGL(ABillsID: Integer;
  779. ARec: TsdDataRecord; ANewValue: Double; const AType: string): Boolean;
  780. var
  781. AOrgBGL, ANewBGL: TBGLSelectInfo;
  782. ACurNode: TsdIDTreeNode;
  783. procedure UpdateBGL;
  784. begin
  785. ARec.ValueByName(AType + 'BGLCode').AsString := ANewBGL.MergedCode;
  786. ARec.ValueByName(AType + 'BGLNum').AsString := ANewBGL.MergedNum;
  787. TProjectData(ProjectData).BGLData.ApplyBGL(AOrgBGL, ANewBGL);
  788. end;
  789. begin
  790. Result := True;
  791. ACurNode := BillsMeasureTree.FindNode(ABillsID);
  792. AOrgBGL := TBGLSelectInfo.Create(ACurNode.Rec,
  793. ARec.ValueByName(AType + 'Quantity').AsFloat, True);
  794. AOrgBGL.MergedCode := ARec.ValueByName(AType + 'BGLCode').AsString;
  795. AOrgBGL.MergedNum := ARec.ValueByName(AType + 'BGLNum').AsString;
  796. ANewBGL := TBGLSelectInfo.Create(ACurNode.Rec, ANewValue, False);
  797. try
  798. if ANewBGL.TotalNum <> 0 then
  799. begin
  800. Result := SelectBGL(AOrgBGL, ANewBGL, ProjectData);
  801. if Result then
  802. UpdateBGL;
  803. end
  804. else
  805. UpdateBGL;
  806. StageData.UpdateBGLInfo(ARec, AType);
  807. UpdateBGLInfo(ABillsID, ARec, AType);
  808. finally
  809. AOrgBGL.Free;
  810. ANewBGL.Free;
  811. end;
  812. end;
  813. procedure TBillsMeasureData.Close;
  814. begin
  815. sdvBillsMeasure.Close;
  816. end;
  817. procedure TBillsMeasureData.CalcAddCompleteRate(ANode: TsdIDTreeNode);
  818. var
  819. fDividend, fDivisor: Double;
  820. begin
  821. with ANode.Rec do
  822. begin
  823. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  824. //fDivisor := CommonCalcRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  825. // + ValueByName('AddPcTotalPrice').AsFloat);
  826. fDivisor := TotalPriceRoundTo(ValueByName('TotalPrice').AsFloat + ValueByName('AddQcTotalPrice').AsFloat
  827. + ValueByName('AddPcTotalPrice').AsFloat);
  828. if fDivisor <> 0 then
  829. ValueByName('AddCompleteRate').AsFloat := AdvRoundTo(fDividend/fDivisor*100)
  830. else
  831. ValueByName('AddCompleteRate').Clear;
  832. end;
  833. end;
  834. procedure TBillsMeasureData.CalcAddDgnPrice(ANode: TsdIDTreeNode);
  835. var
  836. fDividend, fDivisor: Double;
  837. begin
  838. with ANode.Rec do
  839. begin
  840. fDividend := ValueByName('AddGatherTotalPrice').AsFloat;
  841. fDivisor := ValueByName('DealDgnQuantity1').AsFloat + ValueByName('CDgnQuantity1').AsFloat;
  842. if fDivisor <> 0 then
  843. ValueByName('AddDgnPrice').AsFloat := AdvRoundTo(fDividend/fDivisor)
  844. else
  845. ValueByName('AddDgnPrice').Clear;
  846. end;
  847. end;
  848. procedure TBillsMeasureData.SetOnRecChange(const Value: TRecChangeEvent);
  849. begin
  850. FOnRecChange := Value;
  851. end;
  852. procedure TBillsMeasureData.sdvBillsMeasureCurrentChanged(
  853. ARecord: TsdDataRecord);
  854. begin
  855. if Assigned(FOnRecChange) then
  856. FOnRecChange(ARecord);
  857. end;
  858. procedure TBillsMeasureData.ResetTreeNodeStageRec;
  859. var
  860. i: Integer;
  861. vNode: TMeasureBillsIDTreeNode;
  862. begin
  863. if not StageData.Active then Exit;
  864. for i := 0 to BillsMeasureTree.Count - 1 do
  865. begin
  866. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  867. vNode.StageRec := StageData.StageRecord(vNode.ID);
  868. end;
  869. end;
  870. procedure TBillsMeasureData.UpdateRecordPM(ABillsID: Integer;
  871. ADiffer: Double);
  872. var
  873. stnNode: TBillsIDTreeNode;
  874. begin
  875. stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  876. if not Assigned(stnNode) then Exit;
  877. stnNode.Rec.PM_AddTotalPrice.AsFloat := stnNode.Rec.PM_AddTotalPrice.AsFloat + ADiffer;
  878. UpdateRecordPM(stnNode.ParentID, ADiffer);
  879. end;
  880. procedure TBillsMeasureData.CalculateNode(ANode: TMeasureBillsIDTreeNode);
  881. begin
  882. if Assigned(ANode.StageRec) then
  883. begin
  884. if not ANode.HasChildren then
  885. begin
  886. ANode.Rec.AddDealQuantity.AsFloat := ANode.StageRec.EndDealQuantity.AsFloat;
  887. ANode.Rec.AddQcQuantity.AsFloat := ANode.StageRec.EndQcQuantity.AsFloat;
  888. ANode.Rec.AddQcBGLCode.AsString := ANode.StageRec.EndQcBGLCode.AsString;
  889. ANode.Rec.AddQcBGLNum.AsString := ANode.StageRec.EndQcBGLNum.AsString;
  890. ANode.Rec.AddPcQuantity.AsFloat := ANode.StageRec.EndPcQuantity.AsFloat;
  891. ANode.Rec.AddPcBGLCode.AsString := ANode.StageRec.EndPcBGLCode.AsString;
  892. ANode.Rec.AddPcBGLNum.AsString := ANode.StageRec.EndPcBGLNum.AsString;
  893. ANode.Rec.AddGatherQuantity.AsFloat := ANode.StageRec.EndGatherQuantity.AsFloat;
  894. end;
  895. ANode.Rec.AddDealTotalPrice.AsFloat := ANode.StageRec.EndDealTotalPrice.AsFloat;
  896. ANode.Rec.AddQcTotalPrice.AsFloat := ANode.StageRec.EndQcTotalPrice.AsFloat;
  897. ANode.Rec.AddPcTotalPrice.AsFloat := ANode.StageRec.EndPcTotalPrice.AsFloat;
  898. ANode.Rec.AddGatherTotalPrice.AsFloat := ANode.StageRec.EndGatherTotalPrice.AsFloat;
  899. ANode.Rec.PM_AddTotalPrice.AsFloat := ANode.StageRec.PM_PreTotalPrice.AsFloat + ANode.StageRec.PM_TotalPrice.AsFloat;
  900. CalcAddCompleteRate(ANode);
  901. end
  902. else
  903. begin
  904. if not ANode.HasChildren then
  905. begin
  906. ANode.Rec.AddDealQuantity.Clear;
  907. ANode.Rec.AddQcQuantity.Clear;
  908. ANode.Rec.AddQcBGLCode.Clear;
  909. ANode.Rec.AddQcBGLNum.Clear;
  910. ANode.Rec.AddPcQuantity.Clear;
  911. ANode.Rec.AddPcBGLCode.Clear;
  912. ANode.Rec.AddPcBGLNum.Clear;
  913. ANode.Rec.AddGatherQuantity.Clear;
  914. end;
  915. ANode.Rec.AddDealTotalPrice.Clear;
  916. ANode.Rec.AddQcTotalPrice.Clear;
  917. ANode.Rec.AddPcTotalPrice.Clear;
  918. ANode.Rec.AddGatherTotalPrice.Clear;
  919. ANode.Rec.AddCompleteRate.Clear;
  920. ANode.Rec.PM_AddTotalPrice.Clear;
  921. end;
  922. end;
  923. procedure TBillsMeasureData.UpdateGather(ABillsID: Integer;
  924. ADiffer: Double);
  925. var
  926. stnNode: TBillsIDTreeNode;
  927. begin
  928. stnNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(ABillsID));
  929. if not Assigned(stnNode) then Exit;
  930. with stnNode.Rec do
  931. AddDifferValue(AddGatherTotalPrice, ADiffer);
  932. UpdateGather(stnNode.ParentID, ADiffer);
  933. end;
  934. procedure TBillsMeasureData.FreeTreeNodeStageRec;
  935. var
  936. i: Integer;
  937. vNode: TMeasureBillsIDTreeNode;
  938. begin
  939. for i := 0 to BillsMeasureTree.Count - 1 do
  940. begin
  941. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  942. vNode.StageRec := nil;
  943. end;
  944. end;
  945. function TBillsMeasureData.FindNodeWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  946. function CheckNodeHasZJJL(ANode: TsdIDTreeNode): Boolean;
  947. begin
  948. Result := Assigned(TProjectData(FProjectData).PhaseData.ZJJLData.FindZJJLRecord(ANode.ID));
  949. end;
  950. function FindChildWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  951. var
  952. iChild: Integer;
  953. vChild: TsdIDTreeNode;
  954. begin
  955. Result := nil;
  956. for iChild := 0 to ANode.ChildCount - 1 do
  957. begin
  958. vChild := ANode.ChildNodes[iChild];
  959. if CheckNodeHasZJJL(vChild) then
  960. Result := vChild
  961. else if vChild.HasChildren then
  962. Result := FindChildWithZJJL(vChild);
  963. if Assigned(Result) then
  964. Break;
  965. end;
  966. end;
  967. function FindParentWithZJJL(ANode: TsdIDTreeNode): TsdIDTreeNode;
  968. var
  969. vParent: TsdIDTreeNode;
  970. begin
  971. Result := nil;
  972. vParent := ANode.Parent;
  973. while Assigned(vParent) and not Assigned(Result) do
  974. begin
  975. if CheckNodeHasZJJL(vParent) then
  976. Result := vParent;
  977. vParent := vParent.Parent;
  978. end;
  979. end;
  980. begin
  981. if not CheckNodeHasZJJL(ANode) then
  982. begin
  983. Result := FindChildWithZJJL(ANode);
  984. if not Assigned(Result) then
  985. Result := FindParentWithZJJL(ANode);
  986. end
  987. else
  988. Result := ANode;
  989. end;
  990. procedure TBillsMeasureData.sdvBillsMeasureBeforeValueChange(
  991. AValue: TsdValue; const NewValue: Variant; var Allow: Boolean);
  992. function CheckParentExist(ANode: TBillsIDTreeNode): Boolean;
  993. var
  994. vParent: TBillsIDTreeNode;
  995. begin
  996. Result := False;
  997. vParent := TBillsIDTreeNode(ANode.Parent);
  998. while Assigned(vParent) and not Result do
  999. begin
  1000. if vParent.Rec.IsGatherZJJL.AsBoolean then
  1001. Result := True;
  1002. vParent := TBillsIDTreeNode(vParent.Parent);
  1003. end;
  1004. end;
  1005. procedure CancelParentCheck(ANode: TBillsIDTreeNode);
  1006. var
  1007. vParent: TBillsIDTreeNode;
  1008. begin
  1009. vParent := TBillsIDTreeNode(ANode.Parent);
  1010. while Assigned(vParent) do
  1011. begin
  1012. if vParent.Rec.IsGatherZJJL.AsBoolean then
  1013. vParent.Rec.IsGatherZJJL.AsBoolean := False;
  1014. vParent := TBillsIDTreeNode(vParent.Parent);
  1015. end;
  1016. end;
  1017. function CheckChildrenExist(ANode: TBillsIDTreeNode): Boolean;
  1018. var
  1019. iChild: Integer;
  1020. vChild: TBillsIDTreeNode;
  1021. begin
  1022. Result := False;
  1023. for iChild := 0 to ANode.ChildCount - 1 do
  1024. begin
  1025. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  1026. if vChild.Rec.IsGatherZJJL.AsBoolean or CheckChildrenExist(vChild) then
  1027. begin
  1028. Result := True;
  1029. Break;
  1030. end;
  1031. end;
  1032. end;
  1033. procedure CancelChildrenCheck(ANode: TBillsIDTreeNode);
  1034. var
  1035. iChild: Integer;
  1036. vChild: TBillsIDTreeNode;
  1037. begin
  1038. for iChild := 0 to ANode.ChildCount - 1 do
  1039. begin
  1040. vChild := TBillsIDTreeNode(ANode.ChildNodes[iChild]);
  1041. if vChild.Rec.IsGatherZJJL.AsBoolean then
  1042. vChild.Rec.IsGatherZJJL.AsBoolean := False
  1043. else
  1044. CancelChildrenCheck(vChild);
  1045. end;
  1046. end;
  1047. var
  1048. vNode: TBillsIDTreeNode;
  1049. begin
  1050. vNode := TBillsIDTreeNode(BillsMeasureTree.FindNode(AValue.Owner.ValueByName('ID').AsInteger));
  1051. if SameText(AValue.FieldName, 'IsGatherZJJL') and NewValue then
  1052. begin
  1053. if CheckParentExist(vNode) then
  1054. begin
  1055. if QuestMessage('父项已勾选,继续将取消父项勾选。') then
  1056. CancelParentCheck(vNode)
  1057. else
  1058. Allow := False;
  1059. end
  1060. else if CheckChildrenExist(vNode) then
  1061. begin
  1062. if QuestMessage('子项已勾选,继续将取消子项勾选。') then
  1063. CancelChildrenCheck(vNode)
  1064. else
  1065. Allow := False;
  1066. end;
  1067. end;
  1068. end;
  1069. function TBillsMeasureData.CheckNodeGatherCalc(
  1070. ANode: TMeasureBillsIDTreeNode): Boolean;
  1071. var
  1072. fLeafSumDeal, fLeafSumQc, fLeafSumGather: Double;
  1073. i, iCount: Integer;
  1074. vChild: TMeasureBillsIDTreeNode;
  1075. begin
  1076. if Assigned(ANode.StageRec) then
  1077. begin
  1078. fLeafSumDeal := 0;
  1079. fLeafSumQc := 0;
  1080. fLeafSumGather := 0;
  1081. iCount := ANode.PosterityCount;
  1082. i := 0;
  1083. vChild := TMeasureBillsIDTreeNode(ANode.NextNode);
  1084. while i < iCount do
  1085. begin
  1086. if not vChild.HasChildren and Assigned(vChild.StageRec) then
  1087. begin
  1088. fLeafSumDeal := fLeafSumDeal + vChild.StageRec.DealTotalPrice.AsFloat;
  1089. fLeafSumQc := fLeafSumQc + vChild.StageRec.QcTotalPrice.AsFloat;
  1090. fLeafSumGather := fLeafSumGather + vChild.StageRec.GatherTotalPrice.AsFloat;
  1091. end;
  1092. vChild := TMeasureBillsIDTreeNode(vChild.NextNode);
  1093. Inc(i);
  1094. end;
  1095. Result := Decimal.TotalPrice.CheckSameNum(fLeafSumDeal, ANode.StageRec.DealTotalPrice.AsFloat) and
  1096. Decimal.TotalPrice.CheckSameNum(fLeafSumQc, ANode.StageRec.QcTotalPrice.AsFloat) and
  1097. Decimal.TotalPrice.CheckSameNum(fLeafSumGather, ANode.StageRec.GatherTotalPrice.AsFloat);
  1098. end
  1099. else
  1100. Result := True;
  1101. end;
  1102. function TBillsMeasureData.GetDecimal: TCalcDecimal;
  1103. begin
  1104. Result := TProjectData(FProjectData).ProjProperties.DecimalManager.Common;
  1105. end;
  1106. procedure TBillsMeasureData.CalcMeasureFilter;
  1107. var
  1108. i: Integer;
  1109. vNode: TMeasureBillsIDTreeNode;
  1110. begin
  1111. for i := 0 to BillsMeasureTree.Count - 1 do
  1112. begin
  1113. vNode := TMeasureBillsIDTreeNode(BillsMeasureTree.Items[i]);
  1114. vNode.Rec.SetBoolValue(vNode.Rec.HisHasMeasure, vNode.Rec.HisHasMeasure.AsBoolean or vNode.Rec.CurHasMeasure.AsBoolean);
  1115. vNode.Rec.SetBoolValue(vNode.Rec.CurHasMeasure, False);
  1116. end;
  1117. end;
  1118. end.