BillsTree.pas 12 KB

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