BillsTree.pas 8.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311
  1. unit BillsTree;
  2. interface
  3. uses
  4. sdIDTree, sdDB, mDataRecord;
  5. type
  6. TReCalculateTreeNode = procedure(AID: Integer) of Object;
  7. TBillsIDTreeNode = class(TsdIDTreeNode)
  8. private
  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. FStageRec: TStageRecord;
  18. function HasCountPrice: Boolean;
  19. function HasTotalPrice: Boolean;
  20. function GetRec: TBillsRecord;
  21. public
  22. function CanUpLevel: Boolean; override;
  23. function CanDownLevel: Boolean; override;
  24. function CanUpMove: Boolean; override;
  25. function CanDownMove: Boolean; override;
  26. function UpLevel: Boolean; override;
  27. function DownLevel: Boolean; override;
  28. function HasMeasure: Boolean;
  29. function HasLedger: Boolean;
  30. function CountPriceEnable: Boolean;
  31. function TotalPriceEnable: Boolean;
  32. property Rec: TBillsRecord read GetRec;
  33. property DealQuantity: Double read FDealQuantity write FDealQuantity;
  34. property DealTotalPrice: Double read FDealTotalPrice write FDealTotalPrice;
  35. property QcQuantity: Double read FQcQuantity write FQcQuantity;
  36. property QcTotalPrice: Double read FQcTotalPrice write FQcTotalPrice;
  37. property PcQuantity: Double read FPcQuantity write FPcQuantity;
  38. property PcTotalPrice: Double read FPcTotalPrice write FPcTotalPrice;
  39. property GatherQuantity: Double read FGatherQuantity write FGatherQuantity;
  40. property GatherTotalPrice: Double read FGatherTotalPrice write FGatherTotalPrice;
  41. // Cache Data
  42. property StageRec: TStageRecord read FStageRec write FStageRec;
  43. end;
  44. TbitAfterDeleteNode = procedure (AParent: TsdIDTreeNode) of object;
  45. TBillsIDTree = class(TsdIDTree)
  46. private
  47. FDoOnAfterDeleteNode: TbitAfterDeleteNode;
  48. FOnReCalcParent: TReCalculateTreeNode;
  49. protected
  50. function CreateItem: TsdIDTreeNode; override;
  51. public
  52. function CanDelete(ANode: TsdIDTreeNode): Boolean; override;
  53. function DeleteNode(ANode: TsdIDTreeNode): Boolean; override;
  54. function Add(AParentID, ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode; override;
  55. procedure DoOnReCalcParent(AID: Integer);
  56. property DoOnAfterDeleteNode: TbitAfterDeleteNode read FDoOnAfterDeleteNode write FDoOnAfterDeleteNode;
  57. property OnReCalcParent: TReCalculateTreeNode read FOnReCalcParent write FOnReCalcParent;
  58. end;
  59. TEstimateIDTreeNode = class(TsdIDTreeNode)
  60. public
  61. function CanExpand: Boolean; override;
  62. end;
  63. TEstimateIDTree = class(TsdIDTree)
  64. public
  65. function CreateItem: TsdIDTreeNode; override;
  66. end;
  67. implementation
  68. { TBillsIDTree }
  69. function TBillsIDTree.Add(AParentID,
  70. ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode;
  71. begin
  72. // 不允许插入首层节点
  73. if (Selected <> nil) and (Selected.Level = 0) then
  74. Result := inherited Add(Selected.ID, -1)
  75. else
  76. Result := inherited Add(AParentID, ANextSiblingID);
  77. end;
  78. function TBillsIDTree.CanDelete(ANode: TsdIDTreeNode): Boolean;
  79. begin
  80. Result := Inherited CanDelete(ANode)
  81. and (ANode.ID >= 100)
  82. and (not ANode.Rec.ValueByName('LockedLevel').AsBoolean)
  83. and (ANode.Rec.ValueByName('AddDealQuantity').AsFloat = 0)
  84. and (ANode.Rec.ValueByName('AddDealTotalPrice').AsFloat = 0)
  85. and (ANode.Rec.ValueByName('AddQcQuantity').AsFloat = 0)
  86. and (ANode.Rec.ValueByName('AddQcTotalPrice').AsFloat = 0)
  87. and (ANode.Rec.ValueByName('AddPcQuantity').AsFloat = 0)
  88. and (ANode.Rec.ValueByName('AddPcTotalPrice').AsFloat = 0);
  89. end;
  90. function TBillsIDTree.CreateItem: TsdIDTreeNode;
  91. begin
  92. Result := TBillsIDTreeNode.Create(Self);
  93. end;
  94. function TBillsIDTree.DeleteNode(ANode: TsdIDTreeNode): Boolean;
  95. var
  96. vParent: TsdIDTreeNode;
  97. begin
  98. vParent := ANode.Parent;
  99. Result := inherited DeleteNode(ANode);
  100. if Assigned(FDoOnAfterDeleteNode) then
  101. FDoOnAfterDeleteNode(vParent);
  102. end;
  103. procedure TBillsIDTree.DoOnReCalcParent(AID: Integer);
  104. begin
  105. if Assigned(FOnReCalcParent) then
  106. FOnReCalcParent(AID);
  107. end;
  108. { TBillsIDTreeNode }
  109. function TBillsIDTreeNode.CanDownLevel: Boolean;
  110. begin
  111. Result := Inherited CanDownLevel
  112. and (Level > 0)
  113. and (not Rec.ValueByName('LockedLevel').AsBoolean)
  114. and not HasMeasure;
  115. if Assigned(PrevSibling) then
  116. begin
  117. Result := Result
  118. and (PrevSibling.HasChildren or not TBillsIDTreeNode(PrevSibling).HasMeasure);
  119. end;
  120. end;
  121. function TBillsIDTreeNode.CanDownMove: Boolean;
  122. begin
  123. Result := Inherited CanDownMove
  124. and (not Rec.ValueByName('LockedLevel').AsBoolean);
  125. end;
  126. function TBillsIDTreeNode.CanUpLevel: Boolean;
  127. var
  128. vNextSibling: TsdIDTreeNode;
  129. begin
  130. Result := Inherited CanUpLevel
  131. and (Level > 1)
  132. and (not Rec.ValueByName('LockedLevel').AsBoolean)
  133. and not HasMeasure;
  134. vNextSibling := NextSibling;
  135. while Assigned(vNextSibling) and Result do
  136. begin
  137. Result := Result
  138. and not TBillsIDTreeNode(NextSibling).HasMeasure;
  139. vNextSibling := vNextSibling.NextSibling;
  140. end;
  141. end;
  142. function TBillsIDTreeNode.CanUpMove: Boolean;
  143. begin
  144. Result := Inherited CanUpMove
  145. and (not Rec.ValueByName('LockedLevel').AsBoolean);
  146. end;
  147. function TBillsIDTreeNode.CountPriceEnable: Boolean;
  148. begin
  149. Result := HasCountPrice or (not HasTotalPrice);
  150. end;
  151. function TBillsIDTreeNode.DownLevel: Boolean;
  152. var
  153. iOrgParentID: Integer;
  154. begin
  155. iOrgParentID := ParentID;
  156. Result := inherited DownLevel;
  157. if not Result then Exit;
  158. // 如升级后变为父项,则清空数量、单价
  159. if Assigned(Parent) then
  160. begin
  161. Parent.Rec.ValueByName('OrgQuantity').AsFloat := 0;
  162. Parent.Rec.ValueByName('MisQuantity').AsFloat := 0;
  163. Parent.Rec.ValueByName('OthQuantity').AsFloat := 0;
  164. Parent.Rec.ValueByName('Quantity').AsFloat := 0;
  165. Parent.Rec.ValueByName('Price').AsFloat := 0;
  166. end;
  167. TBillsIDTree(Owner).OnReCalcParent(ParentID);
  168. TBillsIDTree(Owner).OnReCalcParent(iOrgParentID);
  169. end;
  170. function TBillsIDTreeNode.GetRec: TBillsRecord;
  171. begin
  172. Result := TBillsRecord(TsdIDTreeNode(Self).Rec);
  173. end;
  174. function TBillsIDTreeNode.HasCountPrice: Boolean;
  175. begin
  176. Result := False;
  177. if not Assigned(Rec) then Exit;
  178. Result := (Rec.Price.AsFloat <> 0)
  179. or (Rec.OrgQuantity.AsFloat <> 0)
  180. or (Rec.MisQuantity.AsFloat <> 0)
  181. or (Rec.OthQuantity.AsFloat <> 0)
  182. or (Rec.AddDealQuantity.AsFloat <> 0)
  183. or (Rec.AddQcQuantity.AsFloat <> 0)
  184. or (Rec.AddPcQuantity.AsFloat <> 0);
  185. end;
  186. function TBillsIDTreeNode.HasLedger: Boolean;
  187. begin
  188. Result := False;
  189. if not Assigned(Rec) then Exit;
  190. Result := (Rec.Price.AsFloat <> 0)
  191. or (Rec.Quantity.AsFloat <> 0);
  192. end;
  193. function TBillsIDTreeNode.HasMeasure: Boolean;
  194. begin
  195. Result := False;
  196. if not Assigned(Rec) then Exit;
  197. Result := (Rec.AddDealQuantity.AsFloat <> 0)
  198. or (Rec.AddDealTotalPrice.AsFloat <> 0)
  199. or (Rec.AddQcQuantity.AsFloat <> 0)
  200. or (Rec.AddQcTotalPrice.AsFloat <> 0)
  201. or (Rec.AddPcQuantity.AsFloat <> 0)
  202. or (Rec.AddPcTotalPrice.AsFloat <> 0);
  203. end;
  204. function TBillsIDTreeNode.HasTotalPrice: Boolean;
  205. begin
  206. Result := False;
  207. if not Assigned(Rec) then Exit;
  208. Result := (Rec.OrgTotalPrice.AsFloat <> 0)
  209. or (Rec.MisTotalPrice.AsFloat <> 0)
  210. or (Rec.OthTotalPrice.AsFloat <> 0)
  211. or (Rec.AddDealTotalPrice.AsFloat <> 0)
  212. or (Rec.AddQcTotalPrice.AsFloat <> 0)
  213. or (Rec.AddPcTotalPrice.AsFloat <> 0);
  214. end;
  215. function TBillsIDTreeNode.TotalPriceEnable: Boolean;
  216. begin
  217. Result := not HasCountPrice;
  218. end;
  219. function TBillsIDTreeNode.UpLevel: Boolean;
  220. var
  221. iOrgParentID: Integer;
  222. begin
  223. iOrgParentID := ParentID;
  224. Result := inherited UpLevel;
  225. if not Result then Exit;
  226. // 如升级后变为父项,则清空数量、单价
  227. if HasChildren then
  228. begin
  229. Rec.ValueByName('OrgQuantity').AsFloat := 0;
  230. Rec.ValueByName('MisQuantity').AsFloat := 0;
  231. Rec.ValueByName('OthQuantity').AsFloat := 0;
  232. Rec.ValueByName('Quantity').AsFloat := 0;
  233. Rec.ValueByName('Price').AsFloat := 0;
  234. end;
  235. TBillsIDTree(Owner).OnReCalcParent(iOrgParentID);
  236. TBillsIDTree(Owner).OnReCalcParent(ParentID);
  237. end;
  238. { TEstimateIDTreeNode }
  239. function TEstimateIDTreeNode.CanExpand: Boolean;
  240. var
  241. iChild: Integer;
  242. vChild: TsdIDTreeNode;
  243. begin
  244. Result := True;
  245. if HasChildren then
  246. for iChild := 0 to ChildCount - 1 do
  247. begin
  248. vChild := ChildNodes[iChild];
  249. if vChild.Rec.ValueByName('B_Code').AsString <> '' then
  250. begin
  251. Result := False;
  252. Break;
  253. end;
  254. end;
  255. end;
  256. { TEstimateIDTree }
  257. function TEstimateIDTree.CreateItem: TsdIDTreeNode;
  258. begin
  259. Result := TEstimateIDTreeNode.Create(Self);
  260. end;
  261. end.