BillsTree.pas 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526
  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. private
  52. function GetNewID(AID: Integer = -1): Integer;
  53. protected
  54. function CreateItem: TsdIDTreeNode; override;
  55. public
  56. function CanDelete(ANode: TsdIDTreeNode): Boolean; override;
  57. function DeleteNode(ANode: TsdIDTreeNode): Boolean; override;
  58. function Add(AParentID, ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode; override;
  59. function AddNode(AParentID, ANextSiblingID: TsdTreeNodeID; AID: Integer = -1): TsdIDTreeNode;
  60. procedure RecodeChildrenCode(ANode: TBillsIDTreeNode; AOrgCode, ANewCode: string);
  61. procedure RecodeChildrenB_Code(ANode: TBillsIDTreeNode; AOrgCode, ANewCode: string);
  62. procedure DoOnReCalcNode(AID: Integer); overload; virtual; abstract;
  63. procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; virtual; abstract;
  64. end;
  65. TCompileBillsIDTree = class(TBillsIDTree)
  66. private
  67. FOnReCalcNode: TReCalculateNode;
  68. public
  69. procedure DoOnReCalcNode(AID: Integer); overload; override;
  70. procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; override;
  71. property OnReCalcNode: TReCalculateNode read FOnReCalcNode write FOnReCalcNode;
  72. end;
  73. TMeasureBillsIDTreeNode = class(TBillsIDTreeNode)
  74. private
  75. FStageRec: TStageRecord;
  76. public
  77. // Cache Data
  78. property StageRec: TStageRecord read FStageRec write FStageRec;
  79. end;
  80. TMeasureBillsIDTree = class(TBillsIDTree)
  81. private
  82. FCompileTree: TCompileBillsIDTree;
  83. protected
  84. function CreateItem: TsdIDTreeNode; override;
  85. public
  86. procedure DoOnReCalcNode(AID: Integer); overload; override;
  87. procedure DoOnReCalcNode(ANode: TsdIDTreeNode); overload; override;
  88. property CompileTree: TCompileBillsIDTree read FCompileTree write FCompileTree;
  89. end;
  90. TEstimateIDTreeNode = class(TsdIDTreeNode)
  91. public
  92. function CanExpand: Boolean; override;
  93. end;
  94. TEstimateIDTree = class(TsdIDTree)
  95. public
  96. function CreateItem: TsdIDTreeNode; override;
  97. end;
  98. implementation
  99. uses SysUtils, UtilMethods;
  100. { TBillsIDTree }
  101. function TBillsIDTree.Add(AParentID,
  102. ANextSiblingID: TsdTreeNodeID): TsdIDTreeNode;
  103. begin
  104. // 不允许插入首层节点
  105. if (Selected <> nil) and (Selected.Level = 0) then
  106. Result := inherited Add(Selected.ID, -1)
  107. else
  108. Result := inherited Add(AParentID, ANextSiblingID);
  109. end;
  110. function TBillsIDTree.AddNode(AParentID, ANextSiblingID: TsdTreeNodeID;
  111. AID: Integer): TsdIDTreeNode;
  112. var
  113. iID: Integer;
  114. Rec: TsdDataRecord;
  115. begin
  116. if not (Assigned(DataView) and DataView.Active){Active} then
  117. begin
  118. WarningMessage('无法在一个关闭的数据集上执行该操作');
  119. Exit;
  120. end;
  121. Result := nil;
  122. if CanAdd(AParentID, ANextSiblingID) then
  123. begin
  124. Rec := DataView.Append(True);
  125. try
  126. Rec.AddValue(ParentField, AParentID);
  127. Rec.AddValue(NextSiblingField, ANextSiblingID);
  128. iID := GetNewID(AID);
  129. if AutoCreateKeyID then
  130. Rec.AddValue(KeyField, iID);
  131. InitDBRecord(Rec);
  132. finally
  133. Rec.EndUpdate;
  134. end;
  135. Result := Add(iID, AParentID, ANextSiblingID, Rec);
  136. end;
  137. end;
  138. function TBillsIDTree.CanDelete(ANode: TsdIDTreeNode): Boolean;
  139. begin
  140. Result := Inherited CanDelete(ANode)
  141. and ((ANode.ID >= 100) or (ANode.Level > 0))
  142. and (not TBillsIDTreeNode(ANode).HasMeasure);
  143. end;
  144. function TBillsIDTree.CreateItem: TsdIDTreeNode;
  145. begin
  146. Result := TBillsIDTreeNode.Create(Self);
  147. end;
  148. function TBillsIDTree.DeleteNode(ANode: TsdIDTreeNode): Boolean;
  149. var
  150. vParent: TsdIDTreeNode;
  151. begin
  152. vParent := ANode.Parent;
  153. Result := inherited DeleteNode(ANode);
  154. DoOnReCalcNode(vParent);
  155. end;
  156. function TBillsIDTree.GetNewID(AID: Integer): Integer;
  157. var
  158. vNode: TsdIDTreeNode;
  159. begin
  160. vNode := FindNode(AID);
  161. if Assigned(vNode) or (AID <= 0) or (AID >= 100) then
  162. Result := NextNewID
  163. else
  164. Result := AID;
  165. end;
  166. procedure TBillsIDTree.RecodeChildrenB_Code(ANode: TBillsIDTreeNode;
  167. AOrgCode, ANewCode: string);
  168. var
  169. iCount, iTotal: Integer;
  170. vChild: TBillsIDTreeNode;
  171. begin
  172. if (ANewCode = '') or (AOrgCode = '') or (AOrgCode = ANewCode) then Exit;
  173. iCount := 0;
  174. iTotal := ANode.PosterityCount;
  175. vChild := TBillsIDTreeNode(ANode.NextNode);
  176. while (iCount < iTotal) and Assigned(vChild) do
  177. begin
  178. if vChild.Rec.B_Code.AsString <> '' then
  179. begin
  180. if Pos(AOrgCode+'-', vChild.Rec.B_Code.AsString) = 1 then
  181. begin
  182. vChild.Rec.B_Code.AsString := StringReplace(vChild.Rec.B_Code.AsString,
  183. AOrgCode+'-', ANewCode+'-', []);
  184. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  185. end;
  186. end;
  187. vChild := TBillsIDTreeNode(vChild.NextNode);
  188. Inc(iCount);
  189. end;
  190. end;
  191. procedure TBillsIDTree.RecodeChildrenCode(ANode: TBillsIDTreeNode;
  192. AOrgCode, ANewCode: string);
  193. var
  194. iCount, iTotal: Integer;
  195. vChild: TBillsIDTreeNode;
  196. begin
  197. if (ANewCode = '') or (AOrgCode = '') or (AOrgCode = ANewCode) then Exit;
  198. iCount := 0;
  199. iTotal := ANode.PosterityCount;
  200. vChild := TBillsIDTreeNode(ANode.NextNode);
  201. while (iCount < iTotal) and Assigned(vChild) do
  202. begin
  203. if vChild.Rec.Code.AsString <> '' then
  204. begin
  205. if Pos(AOrgCode+'-', vChild.Rec.Code.AsString) = 1 then
  206. begin
  207. vChild.Rec.Code.AsString := StringReplace(vChild.Rec.Code.AsString,
  208. AOrgCode+'-', ANewCode+'-', []);
  209. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  210. end;
  211. end;
  212. vChild := TBillsIDTreeNode(vChild.NextNode);
  213. Inc(iCount);
  214. end;
  215. end;
  216. { TBillsIDTreeNode }
  217. function TBillsIDTreeNode.CanDownLevel: Boolean;
  218. begin
  219. Result := Inherited CanDownLevel
  220. and (Level > 0)
  221. and (not Rec.ValueByName('LockedLevel').AsBoolean)
  222. and not HasMeasure;
  223. if Assigned(PrevSibling) then
  224. begin
  225. Result := Result
  226. and (PrevSibling.HasChildren or not TBillsIDTreeNode(PrevSibling).HasMeasure);
  227. end;
  228. end;
  229. function TBillsIDTreeNode.CanDownMove: Boolean;
  230. begin
  231. Result := Inherited CanDownMove
  232. and (not Rec.ValueByName('LockedLevel').AsBoolean);
  233. end;
  234. function TBillsIDTreeNode.CanUpLevel: Boolean;
  235. var
  236. vNextSibling: TBillsIDTreeNode;
  237. begin
  238. Result := Inherited CanUpLevel
  239. and (Level > 1)
  240. and (not Rec.ValueByName('LockedLevel').AsBoolean)
  241. and not HasMeasure;
  242. vNextSibling := TBillsIDTreeNode(NextSibling);
  243. while Assigned(vNextSibling) and Result do
  244. begin
  245. Result := Result
  246. and not TBillsIDTreeNode(vNextSibling).HasMeasure;
  247. vNextSibling := TBillsIDTreeNode(vNextSibling.NextSibling);
  248. end;
  249. end;
  250. function TBillsIDTreeNode.CanUpMove: Boolean;
  251. begin
  252. Result := Inherited CanUpMove
  253. and (not Rec.ValueByName('LockedLevel').AsBoolean);
  254. end;
  255. function TBillsIDTreeNode.CountPriceEnable: Boolean;
  256. begin
  257. Result := HasCountPrice or (not HasTotalPrice);
  258. end;
  259. function TBillsIDTreeNode.DownLevel: Boolean;
  260. var
  261. iOrgParentID: Integer;
  262. begin
  263. iOrgParentID := ParentID;
  264. Result := inherited DownLevel;
  265. if not Result then Exit;
  266. // 如升级后变为父项,则清空数量、单价
  267. if Assigned(Parent) then
  268. begin
  269. Parent.Rec.ValueByName('OrgQuantity').AsFloat := 0;
  270. Parent.Rec.ValueByName('MisQuantity').AsFloat := 0;
  271. Parent.Rec.ValueByName('OthQuantity').AsFloat := 0;
  272. Parent.Rec.ValueByName('Quantity').AsFloat := 0;
  273. Parent.Rec.ValueByName('Price').AsFloat := 0;
  274. end;
  275. TBillsIDTree(Owner).DoOnReCalcNode(ParentID);
  276. TBillsIDTree(Owner).DoOnReCalcNode(iOrgParentID);
  277. end;
  278. function TBillsIDTreeNode.GetChapterParent: TBillsIDTreeNode;
  279. begin
  280. Result := nil;
  281. if Self.Level <= 1 then Exit;
  282. Result := TBillsIDTreeNode(Self.Parent);
  283. while Result.Level > 1 do
  284. Result := TBillsIDTreeNode(Result.Parent);
  285. end;
  286. function TBillsIDTreeNode.GetChapterParentID: Integer;
  287. var
  288. vNode: TBillsIDTreeNode;
  289. begin
  290. vNode := GetChapterParent;
  291. if Assigned(vNode) then
  292. Result := vNode.ID
  293. else
  294. Result := -1;
  295. end;
  296. function TBillsIDTreeNode.GetRec: TBillsRecord;
  297. begin
  298. Result := TBillsRecord(TsdIDTreeNode(Self).Rec);
  299. end;
  300. function TBillsIDTreeNode.HasCountPrice: Boolean;
  301. begin
  302. Result := False;
  303. if not Assigned(Rec) then Exit;
  304. Result := (Rec.Price.AsFloat <> 0)
  305. or (Rec.OrgQuantity.AsFloat <> 0)
  306. or (Rec.MisQuantity.AsFloat <> 0)
  307. or (Rec.OthQuantity.AsFloat <> 0)
  308. or (Rec.AddDealQuantity.AsFloat <> 0)
  309. or (Rec.AddQcQuantity.AsFloat <> 0)
  310. or (Rec.AddPcQuantity.AsFloat <> 0);
  311. end;
  312. function TBillsIDTreeNode.HasLedger: Boolean;
  313. begin
  314. Result := False;
  315. if not Assigned(Rec) then Exit;
  316. Result := (Rec.Price.AsFloat <> 0)
  317. or (Rec.Quantity.AsFloat <> 0);
  318. end;
  319. function TBillsIDTreeNode.HasMeasure: Boolean;
  320. begin
  321. Result := False;
  322. if not Assigned(Rec) then Exit;
  323. Result := (Rec.AddDealQuantity.AsFloat <> 0)
  324. or (Rec.AddDealTotalPrice.AsFloat <> 0)
  325. or (Rec.AddQcQuantity.AsFloat <> 0)
  326. or (Rec.AddQcTotalPrice.AsFloat <> 0)
  327. or (Rec.AddPcQuantity.AsFloat <> 0)
  328. or (Rec.AddPcTotalPrice.AsFloat <> 0)
  329. or (Rec.HisHasMeasure.AsBoolean)
  330. or (Rec.CurHasMeasure.AsBoolean);
  331. end;
  332. function TBillsIDTreeNode.HasTotalPrice: Boolean;
  333. begin
  334. Result := False;
  335. if not Assigned(Rec) then Exit;
  336. Result := (Rec.OrgTotalPrice.AsFloat <> 0)
  337. or (Rec.MisTotalPrice.AsFloat <> 0)
  338. or (Rec.OthTotalPrice.AsFloat <> 0)
  339. or (Rec.AddDealTotalPrice.AsFloat <> 0)
  340. or (Rec.AddQcTotalPrice.AsFloat <> 0)
  341. or (Rec.AddPcTotalPrice.AsFloat <> 0);
  342. end;
  343. procedure TBillsIDTreeNode.RecodeChildrenB_Code(const AParentCode: string);
  344. var
  345. iChild: Integer;
  346. vChild: TBillsIDTreeNode;
  347. begin
  348. if (AParentCode = '') then Exit;
  349. for iChild := 0 to Self.ChildCount - 1 do
  350. begin
  351. vChild := TBillsIDTreeNode(Self.ChildNodes[iChild]);
  352. if vChild.Rec.B_Code.AsString <> '' then
  353. begin
  354. vChild.Rec.SetStrValue(vChild.Rec.B_Code, AParentCode + '-' + GetLastSetmentOfCode(AParentCode));
  355. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  356. end;
  357. end;
  358. end;
  359. procedure TBillsIDTreeNode.RecodeChildrenCode(const AParentCode: string);
  360. var
  361. iChild: Integer;
  362. vChild: TBillsIDTreeNode;
  363. begin
  364. if (AParentCode = '') then Exit;
  365. for iChild := 0 to Self.ChildCount - 1 do
  366. begin
  367. vChild := TBillsIDTreeNode(Self.ChildNodes[iChild]);
  368. if vChild.Rec.Code.AsString <> '' then
  369. begin
  370. vChild.Rec.SetStrValue(vChild.Rec.Code, AParentCode + '-' + GetLastSetmentOfCode(AParentCode));
  371. vChild.Rec.SetBoolValue(vChild.Rec.LockedInfo, False);
  372. end;
  373. end;
  374. end;
  375. function TBillsIDTreeNode.TotalPriceEnable: Boolean;
  376. begin
  377. Result := not HasCountPrice;
  378. end;
  379. function TBillsIDTreeNode.UpLevel: Boolean;
  380. var
  381. iOrgParentID: Integer;
  382. begin
  383. iOrgParentID := ParentID;
  384. Result := inherited UpLevel;
  385. if not Result then Exit;
  386. // 如升级后变为父项,则清空数量、单价
  387. if HasChildren then
  388. begin
  389. Rec.ValueByName('OrgQuantity').AsFloat := 0;
  390. Rec.ValueByName('MisQuantity').AsFloat := 0;
  391. Rec.ValueByName('OthQuantity').AsFloat := 0;
  392. Rec.ValueByName('Quantity').AsFloat := 0;
  393. Rec.ValueByName('Price').AsFloat := 0;
  394. end;
  395. TBillsIDTree(Owner).DoOnReCalcNode(iOrgParentID);
  396. TBillsIDTree(Owner).DoOnReCalcNode(ParentID);
  397. end;
  398. { TEstimateIDTreeNode }
  399. function TEstimateIDTreeNode.CanExpand: Boolean;
  400. var
  401. iChild: Integer;
  402. vChild: TsdIDTreeNode;
  403. begin
  404. Result := True;
  405. if HasChildren then
  406. for iChild := 0 to ChildCount - 1 do
  407. begin
  408. vChild := ChildNodes[iChild];
  409. if vChild.Rec.ValueByName('B_Code').AsString <> '' then
  410. begin
  411. Result := False;
  412. Break;
  413. end;
  414. end;
  415. end;
  416. { TEstimateIDTree }
  417. function TEstimateIDTree.CreateItem: TsdIDTreeNode;
  418. begin
  419. Result := TEstimateIDTreeNode.Create(Self);
  420. end;
  421. { TCompileBillsIDTree }
  422. procedure TCompileBillsIDTree.DoOnReCalcNode(AID: Integer);
  423. begin
  424. if (AID <> -1) and Assigned(FOnReCalcNode) then
  425. FOnReCalcNode(AID);
  426. end;
  427. procedure TCompileBillsIDTree.DoOnReCalcNode(ANode: TsdIDTreeNode);
  428. begin
  429. if Assigned(ANode) then
  430. DoOnReCalcNode(ANode.ID);
  431. end;
  432. { TMeasureBillsIDTree }
  433. procedure TMeasureBillsIDTree.DoOnReCalcNode(AID: Integer);
  434. begin
  435. if Assigned(FCompileTree) then
  436. FCompileTree.DoOnReCalcNode(AID);
  437. end;
  438. function TMeasureBillsIDTree.CreateItem: TsdIDTreeNode;
  439. begin
  440. Result := TMeasureBillsIDTreeNode.Create(Self);
  441. end;
  442. procedure TMeasureBillsIDTree.DoOnReCalcNode(ANode: TsdIDTreeNode);
  443. begin
  444. if Assigned(FCompileTree) then
  445. FCompileTree.DoOnReCalcNode(ANode);
  446. end;
  447. end.