tpPegBlock.pas 3.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173
  1. unit tpPegBlock;
  2. interface
  3. uses
  4. Classes, tpPeg, Math;
  5. type
  6. TtpPegBlock = class
  7. private
  8. FPegs: TList;
  9. FBeginPeg: TtpPegNode;
  10. FEndPeg: TtpPegNode;
  11. FBeginNum: Double;
  12. FEndNum: Double;
  13. FTotalPrice: Double;
  14. function GetPeg(AIndex: Integer): TtpPegNode;
  15. function GetPegCount: Integer;
  16. function GetLength: Double;
  17. public
  18. constructor Create(APeg: TtpPegNode);
  19. destructor Destroy; override;
  20. procedure AddPeg(APeg: TtpPegNode);
  21. function IsRelaPeg(APeg: TtpPegNode; ARange: Double): Boolean;
  22. property BeginNum: Double read FBeginNum;
  23. property EndNum: Double read FEndNum;
  24. property BeginPeg: TtpPegNode read FBeginPeg;
  25. property EndPeg: TtpPegNode read FEndPeg;
  26. property Length: Double read GetLength;
  27. property TotalPrice: Double read FTotalPrice;
  28. property PegCount: Integer read GetPegCount;
  29. property Peg[AIndex: Integer]: TtpPegNode read GetPeg;
  30. end;
  31. TtpPegBlockList = class
  32. private
  33. FBlocks: TList;
  34. function GetBlockCount: Integer;
  35. function GetPegBlock(AIndex: Integer): TtpPegBlock;
  36. public
  37. constructor Create;
  38. destructor Destroy; override;
  39. procedure Clear;
  40. property BlockCount: Integer read GetBlockCount;
  41. property PegBlock[AIndex: Integer]: TtpPegBlock read GetPegBlock;
  42. end;
  43. implementation
  44. uses
  45. ZhAPI;
  46. { TtpPegBlock }
  47. procedure TtpPegBlock.AddPeg(APeg: TtpPegNode);
  48. begin
  49. FPegs.Add(APeg);
  50. if APeg.BeginPegNum < FBeginNum then
  51. begin
  52. FBeginNum := APeg.BeginPegNum;
  53. FBeginPeg := APeg
  54. end;
  55. if APeg.EndPegNum > FEndNum then
  56. begin
  57. FEndNum := APeg.EndPegNum;
  58. FEndPeg := APeg;
  59. end;
  60. FTotalPrice := FTotalPrice + APeg.RelaNode.TotalPrice;
  61. end;
  62. constructor TtpPegBlock.Create(APeg: TtpPegNode);
  63. begin
  64. FPegs := TList.Create;
  65. FPegs.Add(APeg);
  66. FBeginNum := APeg.BeginPegNum;
  67. FEndNum := APeg.EndPegNum;
  68. FBeginPeg := APeg;
  69. FEndPeg := APeg;
  70. FTotalPrice := APeg.RelaNode.TotalPrice;
  71. end;
  72. destructor TtpPegBlock.Destroy;
  73. begin
  74. FPegs.Free;
  75. inherited;
  76. end;
  77. function TtpPegBlock.GetLength: Double;
  78. begin
  79. Result := FEndNum - FBeginNum;
  80. end;
  81. function TtpPegBlock.GetPeg(AIndex: Integer): TtpPegNode;
  82. begin
  83. Result := TtpPegNode(FPegs.Items[AIndex]);
  84. end;
  85. function TtpPegBlock.GetPegCount: Integer;
  86. begin
  87. Result := FPegs.Count;
  88. end;
  89. function TtpPegBlock.IsRelaPeg(APeg: TtpPegNode; ARange: Double): Boolean;
  90. var
  91. fRela: Double;
  92. begin
  93. if APeg.PegLength > 0 then
  94. begin
  95. fRela := 0;
  96. if (APeg.BeginPegNum <= FBeginNum) then
  97. begin
  98. if (APeg.EndPegNum > FBeginNum) and (APeg.EndPegNum < FEndNum) then
  99. fRela := APeg.EndPegNum - FBeginNum
  100. else if APeg.EndPegNum >= FEndNum then
  101. fRela := Length;
  102. end
  103. else if (APeg.BeginPegNum > FBeginNum) and (APeg.BeginPegNum < FEndNum) then
  104. begin
  105. if (APeg.EndPegNum > FBeginNum) and (APeg.EndPegNum < FEndNum) then
  106. fRela := APeg.EndPegNum - APeg.BeginPegNum
  107. else if (APeg.EndPegNum >= FEndNum) then
  108. fRela := FEndNum - APeg.BeginPegNum;
  109. end
  110. else
  111. fRela := 0;
  112. Result := (fRela <> 0) and (fRela >= Min(Min(Length, APeg.PegLength), ARange));
  113. end
  114. else if APeg.PegLength = 0 then
  115. Result := (APeg.BeginPegNum > FBeginNum) and (APeg.BeginPegNum < FEndNum)
  116. else
  117. Result := False;
  118. end;
  119. { TtpPegBlockList }
  120. procedure TtpPegBlockList.Clear;
  121. begin
  122. ClearObjects(FBlocks);
  123. FBlocks.Free;
  124. end;
  125. constructor TtpPegBlockList.Create;
  126. begin
  127. FBlocks := TList.Create;
  128. end;
  129. destructor TtpPegBlockList.Destroy;
  130. begin
  131. Clear;
  132. FBlocks.Free;
  133. inherited;
  134. end;
  135. function TtpPegBlockList.GetBlockCount: Integer;
  136. begin
  137. Result := FBlocks.Count;
  138. end;
  139. function TtpPegBlockList.GetPegBlock(AIndex: Integer): TtpPegBlock;
  140. begin
  141. Result := TtpPegBlock(FBlocks.Items[AIndex]);
  142. end;
  143. end.