BillsMeasureDm.pas 42 KB

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