tpGatherGcl.pas 4.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202
  1. unit tpGatherGcl;
  2. interface
  3. uses
  4. Classes, tpGatherTree;
  5. type
  6. TtpGatherGclRela = class
  7. private
  8. FRelaGcl: TtpGatherTreeNode;
  9. FRelaPegXmj: TtpGatherTreeNode;
  10. public
  11. constructor Create(AGcl, APegXmj: TtpGatherTreeNode);
  12. property RelaGcl: TtpGatherTreeNode read FRelaGcl;
  13. property RelaPegXmj: TtpGatherTreeNode read FRelaPegXmj;
  14. end;
  15. TtpGatherGcl = class
  16. private
  17. FID: Integer;
  18. FRelas: TList;
  19. FIndexCode: string;
  20. FB_Code: string;
  21. FName: string;
  22. FUnits: string;
  23. FPrice: Double;
  24. FQuantity: Double;
  25. FTotalPrice: Double;
  26. function GetRela(AIndex: Integer): TtpGatherGclRela;
  27. function GetRelaCount: Integer;
  28. public
  29. constructor Create(AID: Integer; AGcl, APegXmj: TtpGatherTreeNode);
  30. destructor Destroy; override;
  31. procedure GatherNode(AGcl, APegXmj: TtpGatherTreeNode);
  32. property ID: Integer read FID;
  33. property IndexCode: string read FIndexCode;
  34. property B_Code: string read FB_Code;
  35. property Name: string read FName;
  36. property Units: string read FUnits;
  37. property Price: Double read FPrice;
  38. property Quantity: Double read FQuantity;
  39. property TotalPrice: Double read FTotalPrice;
  40. property RelaCount: Integer read GetRelaCount;
  41. property Rela[AIndex: Integer]: TtpGatherGclRela read GetRela;
  42. end;
  43. TtpGatherGclList = class
  44. private
  45. FGcls: TList;
  46. FNewID: Integer;
  47. function FindGatherGcl(ANode: TtpGatherTreeNode): TtpGatherGcl;
  48. function NewGatherGcl(AGcl, APegXmj: TtpGatherTreeNode): TtpGatherGcl;
  49. function GetGcl(AIndex: Integer): TtpGatherGcl;
  50. function GetGclCount: Integer;
  51. public
  52. constructor Create;
  53. destructor Destroy; override;
  54. procedure GatherNode(AGcl, APegXmj: TtpGatherTreeNode);
  55. property GclCount: Integer read GetGclCount;
  56. property Gcl[AIndex: Integer]: TtpGatherGcl read GetGcl;
  57. end;
  58. implementation
  59. uses
  60. UtilMethods, SysUtils, ZhAPI;
  61. { TtpGatherGcl }
  62. constructor TtpGatherGcl.Create(AID: Integer; AGcl, APegXmj: TtpGatherTreeNode);
  63. var
  64. vRela: TtpGatherGclRela;
  65. begin
  66. FID := AID;
  67. FRelas := TList.Create;
  68. vRela := TtpGatherGclRela.Create(AGcl, APegXmj);
  69. FRelas.Add(vRela);
  70. FB_Code := AGcl.B_Code;
  71. FIndexCode := B_CodeToIndexCode(FB_Code);
  72. FName := AGcl.Name;
  73. FUnits := AGcl.Units;
  74. FPrice := AGcl.Price;
  75. FQuantity := AGcl.Quantity;
  76. FTotalPrice := AGcl.TotalPrice;
  77. end;
  78. destructor TtpGatherGcl.Destroy;
  79. begin
  80. ClearObjects(FRelas);
  81. FRelas.Free;
  82. inherited;
  83. end;
  84. procedure TtpGatherGcl.GatherNode(AGcl, APegXmj: TtpGatherTreeNode);
  85. var
  86. vRela: TtpGatherGclRela;
  87. begin
  88. vRela := TtpGatherGclRela.Create(AGcl, APegXmj);
  89. FRelas.Add(vRela);
  90. FQuantity := FQuantity + AGcl.Quantity;
  91. FTotalPrice := FTotalPrice + AGcl.TotalPrice;
  92. end;
  93. function TtpGatherGcl.GetRela(AIndex: Integer): TtpGatherGclRela;
  94. begin
  95. Result := TtpGatherGclRela(FRelas.Items[AIndex]);
  96. end;
  97. function TtpGatherGcl.GetRelaCount: Integer;
  98. begin
  99. Result := FRelas.Count;
  100. end;
  101. { TtpGatherGclList }
  102. constructor TtpGatherGclList.Create;
  103. begin
  104. FGcls := TList.Create;
  105. FNewID := 0;
  106. end;
  107. destructor TtpGatherGclList.Destroy;
  108. begin
  109. ClearObjects(FGcls);
  110. FGcls.Free;
  111. inherited;
  112. end;
  113. function TtpGatherGclList.FindGatherGcl(
  114. ANode: TtpGatherTreeNode): TtpGatherGcl;
  115. var
  116. iGcl: Integer;
  117. vGcl: TtpGatherGcl;
  118. begin
  119. Result := nil;
  120. for iGcl := 0 to FGcls.Count - 1 do
  121. begin
  122. vGcl := TtpGatherGcl(FGcls.Items[iGcl]);
  123. if SameText(vGcl.B_Code, ANode.B_Code) and
  124. SameText(vGcl.Name, ANode.Name) and
  125. SameText(vGcl.Units, ANode.Units) and
  126. (vGcl.Price - ANode.Price < 0.0001) then
  127. begin
  128. Result := vGcl;
  129. Break;
  130. end;
  131. end;
  132. end;
  133. procedure TtpGatherGclList.GatherNode(AGcl, APegXmj: TtpGatherTreeNode);
  134. var
  135. vGcl: TtpGatherGcl;
  136. begin
  137. vGcl := FindGatherGcl(AGcl);
  138. if Assigned(vGcl) then
  139. vGcl.GatherNode(AGcl, APegXmj)
  140. else
  141. vGcl := NewGatherGcl(AGcl, APegXmj);
  142. end;
  143. function TtpGatherGclList.GetGcl(AIndex: Integer): TtpGatherGcl;
  144. begin
  145. Result := TtpGatherGcl(FGcls.Items[AIndex]);
  146. end;
  147. function TtpGatherGclList.GetGclCount: Integer;
  148. begin
  149. Result := FGcls.Count;
  150. end;
  151. function TtpGatherGclList.NewGatherGcl(
  152. AGcl, APegXmj: TtpGatherTreeNode): TtpGatherGcl;
  153. begin
  154. Result := TtpGatherGcl.Create(FNewID, AGcl, APegXmj);
  155. FGcls.Add(Result);
  156. Inc(FNewID);
  157. end;
  158. { TtpGatherGclRela }
  159. constructor TtpGatherGclRela.Create(AGcl, APegXmj: TtpGatherTreeNode);
  160. begin
  161. FRelaGcl := AGcl;
  162. FRelaPegXmj := APegXmj;
  163. end;
  164. end.