BillsMeasureDm.pas 40 KB

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