BillsTree.pas 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486
  1. unit BillsTree;
  2. interface
  3. uses
  4. sdIDTree, sdDB, mDataRecord, ZhAPI;
  5. type
  6. TBillsIDTreeNode = class(TsdIDTreeNode)
  7. private
  8. FStageRec: TStageRecord;
  9. FDealQuantity: Double;
  10. FDealTotalPrice: Double;
  11. FQcQuantity: Double;
  12. FQcTotalPrice: Double;
  13. FPcQuantity: Double;
  14. FPcTotalPrice: Double;
  15. FGatherTotalPrice: Double;
  16. FGatherQuantity: Double;
  17. function HasCountPrice: Boolean;
  18. function HasTotalPrice: Boolean;
  19. function GetRec: TBillsRecord;
  20. function GetChapterParentID: Integer;
  21. function GetChapterParent: TBillsIDTreeNode;
  22. public
  23. function CanUpLevel: Boolean; override;
  24. function CanDownLevel: Boolean; override;
  25. function CanUpMove: Boolean; override;
  26. function CanDownMove: Boolean; override;
  27. function UpLevel: Boolean; override;
  28. function DownLevel: Boolean; override;
  29. function HasMeasure: Boolean;
  30. function HasLedger: Boolean;
  31. function CountPriceEnable: Boolean;
  32. function TotalPriceEnable: Boolean;
  33. procedure RecodeChildrenCode(const AParentCode: string);
  34. procedure RecodeChildrenB_Code(const AParentCode: string);
  35. property Rec: TBillsRecord read GetRec;
  36. property ChapterParent: TBillsIDTreeNode read GetChapterParent;
  37. property ChapterParentID: Integer read GetChapterParentID;
  38. property DealQuantity: Double read FDealQuantity write FDealQuantity;
  39. property DealTotalPrice: Double read FDealTotalPrice write FDealTotalPrice;
  40. property QcQuantity: Double read FQcQuantity write FQcQuantity;
  41. property QcTotalPrice: Double read FQcTotalPrice write FQcTotalPrice;
  42. property PcQuantity: Double read FPcQuantity write FPcQuantity;
  43. property PcTotalPrice: Double read FPcTotalPrice write FPcTotalPrice;
  44. property GatherQuantity: Double read FGatherQuantity write FGatherQuantity;
  45. property GatherTotalPrice: Double read FGatherTotalPrice write FGatherTotalPrice;
  46. // Cache Data
  47. property StageRec: TStageRecord read FStageRec write FStageRec;
  48. end;
  49. TReCalculateNode = procedure(AID: Integer) of object;
  50. TBillsIDTree = class(TsdIDTree)
  51. protected
  52. function CreateItem: TsdIDTreeNode; override;
  53. public
  54. function CanDelete(ANode: TsdIDTreeNode): Boolean; override;
  55. function DeleteNode(ANode: TsdIDTreeNode): Boolean; override;
  56. function Add(AParentID, ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode; override;
  57. procedure RecodeChildrenCode(ANode: TBillsIDTreeNode; AOrgCode, ANewCode: string);
  58. procedure RecodeChildrenB_Code(ANode: TBillsIDTreeNode; AOrgCode, ANewCode: string);
  59. procedure DoOnReCalcNode(AID: Integer); overload; virtual; abstract;
  60. procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; virtual; abstract;
  61. end;
  62. TCompileBillsIDTree = class(TBillsIDTree)
  63. private
  64. FOnReCalcNode: TReCalculateNode;
  65. public
  66. procedure DoOnReCalcNode(AID: Integer); overload; override;
  67. procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; override;
  68. property OnReCalcNode: TReCalculateNode read FOnReCalcNode write FOnReCalcNode;
  69. end;
  70. TMeasureBillsIDTreeNode = class(TBillsIDTreeNode)
  71. private
  72. FStageRec: TStageRecord;
  73. public
  74. // Cache Data
  75. property StageRec: TStageRecord read FStageRec write FStageRec;
  76. end;
  77. TMeasureBillsIDTree = class(TBillsIDTree)
  78. private
  79. FCompileTree: TCompileBillsIDTree;
  80. protected
  81. function CreateItem: TsdIDTreeNode; override;
  82. public
  83. procedure DoOnReCalcNode(AID: Integer); overload; override;
  84. procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; override;
  85. property CompileTree: TCompileBillsIDTree read FCompileTree write FCompileTree;
  86. end;
  87. TEstimateIDTreeNode = class(TsdIDTreeNode)
  88. public
  89. function CanExpand: Boolean; override;
  90. end;
  91. TEstimateIDTree = class(TsdIDTree)
  92. public
  93. function CreateItem: TsdIDTreeNode; override;
  94. end;
  95. implementation
  96. uses SysUtils;
  97. { TBillsIDTree }
  98. function TBillsIDTree.Add(AParentID,
  99. ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode;
  100. begin
  101. // 不允许插入首层节点
  102. if (Selected <> nil) and (Selected.Level = 0) then
  103. Result := inherited Add(Selected.ID, -1)
  104. else
  105. Result := inherited Add(AParentID, ANextSiblingID);
  106. end;
  107. function TBillsIDTree.CanDelete(ANode: TsdIDTreeNode): Boolean;
  108. begin
  109. Result := Inherited CanDelete(ANode)
  110. and (ANode.ID >= 100)
  111. and (not ANode.Rec.ValueByName('LockedLevel').AsBoolean)
  112. and (ANode.Rec.ValueByName('AddDealQuantity').AsFloat = 0)
  113. and (ANode.Rec.ValueByName('AddDealTotalPrice').AsFloat = 0)
  114. and (ANode.Rec.ValueByName('AddQcQuantity').AsFloat = 0)
  115. and (ANode.Rec.ValueByName('AddQcTotalPrice').AsFloat = 0)
  116. and (ANode.Rec.ValueByName('AddPcQuantity').AsFloat = 0)
  117. and (ANode.Rec.ValueByName('AddPcTotalPrice').AsFloat = 0);
  118. end;
  119. function TBillsIDTree.CreateItem: TsdIDTreeNode;
  120. begin
  121. Result := TBillsIDTreeNode.Create(Self);
  122. end;
  123. function TBillsIDTree.DeleteNode(ANode: TsdIDTreeNode): Boolean;
  124. var
  125. vParent: TsdIDTreeNode;
  126. begin
  127. vParent := ANode.Parent;
  128. Result := inherited DeleteNode(ANode);
  129. DoOnReCalcNode(vParent);
  130. end;
  131. procedure TBillsIDTree.RecodeChildrenB_Code(ANode: TBillsIDTreeNode;
  132. AOrgCode, ANewCode: string);
  133. var
  134. iCount, iTotal: Integer;
  135. vChild: TBillsIDTreeNode;
  136. begin
  137. if (ANewCode = '') or (AOrgCode = '') or (AOrgCode = ANewCode) then Exit;
  138. iCount := 0;
  139. iTotal := ANode.PosterityCount;
  140. vChild := TBillsIDTreeNode(ANode.NextNode);
  141. while (iCount < iTotal) and Assigned(vChild) do
  142. begin
  143. if vChild.Rec.B_Code.AsString <> '' then
  144. begin
  145. if Pos(AOrgCode+'-', vChild.Rec.B_Code.AsString) = 1 then
  146. begin
  147. vChild.Rec.B_Code.AsString := StringReplace(vChild.Rec.B_Code.AsString,
  148. AOrgCode+'-', ANewCode+'-', []);
  149. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  150. end;
  151. end;
  152. vChild := TBillsIDTreeNode(vChild.NextNode);
  153. Inc(iCount);
  154. end;
  155. end;
  156. procedure TBillsIDTree.RecodeChildrenCode(ANode: TBillsIDTreeNode;
  157. AOrgCode, ANewCode: string);
  158. var
  159. iCount, iTotal: Integer;
  160. vChild: TBillsIDTreeNode;
  161. begin
  162. if (ANewCode = '') or (AOrgCode = '') or (AOrgCode = ANewCode) then Exit;
  163. iCount := 0;
  164. iTotal := ANode.PosterityCount;
  165. vChild := TBillsIDTreeNode(ANode.NextNode);
  166. while (iCount < iTotal) and Assigned(vChild) do
  167. begin
  168. if vChild.Rec.Code.AsString <> '' then
  169. begin
  170. if Pos(AOrgCode+'-', vChild.Rec.Code.AsString) = 1 then
  171. begin
  172. vChild.Rec.Code.AsString := StringReplace(vChild.Rec.Code.AsString,
  173. AOrgCode+'-', ANewCode+'-', []);
  174. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  175. end;
  176. end;
  177. vChild := TBillsIDTreeNode(vChild.NextNode);
  178. Inc(iCount);
  179. end;
  180. end;
  181. { TBillsIDTreeNode }
  182. function TBillsIDTreeNode.CanDownLevel: Boolean;
  183. begin
  184. Result := Inherited CanDownLevel
  185. and (Level > 0)
  186. and (not Rec.ValueByName('LockedLevel').AsBoolean)
  187. and not HasMeasure;
  188. if Assigned(PrevSibling) then
  189. begin
  190. Result := Result
  191. and (PrevSibling.HasChildren or not TBillsIDTreeNode(PrevSibling).HasMeasure);
  192. end;
  193. end;
  194. function TBillsIDTreeNode.CanDownMove: Boolean;
  195. begin
  196. Result := Inherited CanDownMove
  197. and (not Rec.ValueByName('LockedLevel').AsBoolean);
  198. end;
  199. function TBillsIDTreeNode.CanUpLevel: Boolean;
  200. var
  201. vNextSibling: TsdIDTreeNode;
  202. begin
  203. Result := Inherited CanUpLevel
  204. and (Level > 1)
  205. and (not Rec.ValueByName('LockedLevel').AsBoolean)
  206. and not HasMeasure;
  207. vNextSibling := NextSibling;
  208. while Assigned(vNextSibling) and Result do
  209. begin
  210. Result := Result
  211. and not TBillsIDTreeNode(NextSibling).HasMeasure;
  212. vNextSibling := vNextSibling.NextSibling;
  213. end;
  214. end;
  215. function TBillsIDTreeNode.CanUpMove: Boolean;
  216. begin
  217. Result := Inherited CanUpMove
  218. and (not Rec.ValueByName('LockedLevel').AsBoolean);
  219. end;
  220. function TBillsIDTreeNode.CountPriceEnable: Boolean;
  221. begin
  222. Result := HasCountPrice or (not HasTotalPrice);
  223. end;
  224. function TBillsIDTreeNode.DownLevel: Boolean;
  225. var
  226. iOrgParentID: Integer;
  227. begin
  228. iOrgParentID := ParentID;
  229. Result := inherited DownLevel;
  230. if not Result then Exit;
  231. // 如升级后变为父项,则清空数量、单价
  232. if Assigned(Parent) then
  233. begin
  234. Parent.Rec.ValueByName('OrgQuantity').AsFloat := 0;
  235. Parent.Rec.ValueByName('MisQuantity').AsFloat := 0;
  236. Parent.Rec.ValueByName('OthQuantity').AsFloat := 0;
  237. Parent.Rec.ValueByName('Quantity').AsFloat := 0;
  238. Parent.Rec.ValueByName('Price').AsFloat := 0;
  239. end;
  240. TBillsIDTree(Owner).DoOnReCalcNode(ParentID);
  241. TBillsIDTree(Owner).DoOnReCalcNode(iOrgParentID);
  242. end;
  243. function TBillsIDTreeNode.GetChapterParent: TBillsIDTreeNode;
  244. begin
  245. Result := nil;
  246. if Self.Level <= 1 then Exit;
  247. Result := TBillsIDTreeNode(Self.Parent);
  248. while Result.Level > 1 do
  249. Result := TBillsIDTreeNode(Result.Parent);
  250. end;
  251. function TBillsIDTreeNode.GetChapterParentID: Integer;
  252. var
  253. vNode: TBillsIDTreeNode;
  254. begin
  255. vNode := GetChapterParent;
  256. if Assigned(vNode) then
  257. Result := vNode.ID
  258. else
  259. Result := -1;
  260. end;
  261. function TBillsIDTreeNode.GetRec: TBillsRecord;
  262. begin
  263. Result := TBillsRecord(TsdIDTreeNode(Self).Rec);
  264. end;
  265. function TBillsIDTreeNode.HasCountPrice: Boolean;
  266. begin
  267. Result := False;
  268. if not Assigned(Rec) then Exit;
  269. Result := (Rec.Price.AsFloat <> 0)
  270. or (Rec.OrgQuantity.AsFloat <> 0)
  271. or (Rec.MisQuantity.AsFloat <> 0)
  272. or (Rec.OthQuantity.AsFloat <> 0)
  273. or (Rec.AddDealQuantity.AsFloat <> 0)
  274. or (Rec.AddQcQuantity.AsFloat <> 0)
  275. or (Rec.AddPcQuantity.AsFloat <> 0);
  276. end;
  277. function TBillsIDTreeNode.HasLedger: Boolean;
  278. begin
  279. Result := False;
  280. if not Assigned(Rec) then Exit;
  281. Result := (Rec.Price.AsFloat <> 0)
  282. or (Rec.Quantity.AsFloat <> 0);
  283. end;
  284. function TBillsIDTreeNode.HasMeasure: Boolean;
  285. begin
  286. Result := False;
  287. if not Assigned(Rec) then Exit;
  288. Result := (Rec.AddDealQuantity.AsFloat <> 0)
  289. or (Rec.AddDealTotalPrice.AsFloat <> 0)
  290. or (Rec.AddQcQuantity.AsFloat <> 0)
  291. or (Rec.AddQcTotalPrice.AsFloat <> 0)
  292. or (Rec.AddPcQuantity.AsFloat <> 0)
  293. or (Rec.AddPcTotalPrice.AsFloat <> 0);
  294. end;
  295. function TBillsIDTreeNode.HasTotalPrice: Boolean;
  296. begin
  297. Result := False;
  298. if not Assigned(Rec) then Exit;
  299. Result := (Rec.OrgTotalPrice.AsFloat <> 0)
  300. or (Rec.MisTotalPrice.AsFloat <> 0)
  301. or (Rec.OthTotalPrice.AsFloat <> 0)
  302. or (Rec.AddDealTotalPrice.AsFloat <> 0)
  303. or (Rec.AddQcTotalPrice.AsFloat <> 0)
  304. or (Rec.AddPcTotalPrice.AsFloat <> 0);
  305. end;
  306. procedure TBillsIDTreeNode.RecodeChildrenB_Code(const AParentCode: string);
  307. var
  308. iChild: Integer;
  309. vChild: TBillsIDTreeNode;
  310. begin
  311. if (AParentCode = '') then Exit;
  312. for iChild := 0 to Self.ChildCount - 1 do
  313. begin
  314. vChild := TBillsIDTreeNode(Self.ChildNodes[iChild]);
  315. if vChild.Rec.B_Code.AsString <> '' then
  316. begin
  317. vChild.Rec.SetStrValue(vChild.Rec.B_Code, AParentCode + '-' + GetLastSetmentOfCode(AParentCode));
  318. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  319. end;
  320. end;
  321. end;
  322. procedure TBillsIDTreeNode.RecodeChildrenCode(const AParentCode: string);
  323. var
  324. iChild: Integer;
  325. vChild: TBillsIDTreeNode;
  326. begin
  327. if (AParentCode = '') then Exit;
  328. for iChild := 0 to Self.ChildCount - 1 do
  329. begin
  330. vChild := TBillsIDTreeNode(Self.ChildNodes[iChild]);
  331. if vChild.Rec.Code.AsString <> '' then
  332. begin
  333. vChild.Rec.SetStrValue(vChild.Rec.Code, AParentCode + '-' + GetLastSetmentOfCode(AParentCode));
  334. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  335. end;
  336. end;
  337. end;
  338. function TBillsIDTreeNode.TotalPriceEnable: Boolean;
  339. begin
  340. Result := not HasCountPrice;
  341. end;
  342. function TBillsIDTreeNode.UpLevel: Boolean;
  343. var
  344. iOrgParentID: Integer;
  345. begin
  346. iOrgParentID := ParentID;
  347. Result := inherited UpLevel;
  348. if not Result then Exit;
  349. // 如升级后变为父项,则清空数量、单价
  350. if HasChildren then
  351. begin
  352. Rec.ValueByName('OrgQuantity').AsFloat := 0;
  353. Rec.ValueByName('MisQuantity').AsFloat := 0;
  354. Rec.ValueByName('OthQuantity').AsFloat := 0;
  355. Rec.ValueByName('Quantity').AsFloat := 0;
  356. Rec.ValueByName('Price').AsFloat := 0;
  357. end;
  358. TBillsIDTree(Owner).DoOnReCalcNode(iOrgParentID);
  359. TBillsIDTree(Owner).DoOnReCalcNode(ParentID);
  360. end;
  361. { TEstimateIDTreeNode }
  362. function TEstimateIDTreeNode.CanExpand: Boolean;
  363. var
  364. iChild: Integer;
  365. vChild: TsdIDTreeNode;
  366. begin
  367. Result := True;
  368. if HasChildren then
  369. for iChild := 0 to ChildCount - 1 do
  370. begin
  371. vChild := ChildNodes[iChild];
  372. if vChild.Rec.ValueByName('B_Code').AsString <> '' then
  373. begin
  374. Result := False;
  375. Break;
  376. end;
  377. end;
  378. end;
  379. { TEstimateIDTree }
  380. function TEstimateIDTree.CreateItem: TsdIDTreeNode;
  381. begin
  382. Result := TEstimateIDTreeNode.Create(Self);
  383. end;
  384. { TCompileBillsIDTree }
  385. procedure TCompileBillsIDTree.DoOnReCalcNode(AID: Integer);
  386. begin
  387. if (AID <> -1) and Assigned(FOnReCalcNode) then
  388. FOnReCalcNode(AID);
  389. end;
  390. procedure TCompileBillsIDTree.DoOnReCalcNode(ANode: TsdIDTreeNode);
  391. begin
  392. if Assigned(ANode) then
  393. DoOnReCalcNode(ANode.ID);
  394. end;
  395. { TMeasureBillsIDTree }
  396. procedure TMeasureBillsIDTree.DoOnReCalcNode(AID: Integer);
  397. begin
  398. if Assigned(FCompileTree) then
  399. FCompileTree.DoOnReCalcNode(AID);
  400. end;
  401. function TMeasureBillsIDTree.CreateItem: TsdIDTreeNode;
  402. begin
  403. Result := TMeasureBillsIDTreeNode.Create(Self);
  404. end;
  405. procedure TMeasureBillsIDTree.DoOnReCalcNode(ANode: TsdIDTreeNode);
  406. begin
  407. if Assigned(FCompileTree) then
  408. FCompileTree.DoOnReCalcNode(ANode);
  409. end;
  410. end.