BillsMeasureDm.pas 39 KB

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