No puede seleccionar más de 25 temas Los temas deben comenzar con una letra o número, pueden incluir guiones ('-') y pueden tener hasta 35 caracteres de largo.
 
 

137 líneas
5.0 KiB

  1. unit uutlArrayContainer;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils,
  6. uutlCommon;
  7. type
  8. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  9. generic TutlArrayContainer<T> = class(TutlInterfaceNoRefCount)
  10. protected type
  11. PT = ^T;
  12. strict private
  13. fList: PT;
  14. fCapacity: Integer;
  15. fOwnsItems: Boolean;
  16. fCanShrink: Boolean;
  17. fCanExpand: Boolean;
  18. function GetIsEmpty: Boolean; inline;
  19. protected
  20. function GetCount: Integer; virtual; abstract;
  21. procedure SetCount (const aValue: Integer); virtual; abstract;
  22. function GetInternalItem (const aIndex: Integer): PT;
  23. procedure SetCapacity (const aValue: integer); virtual;
  24. procedure Release (var aItem: T; const aFreeItem: Boolean); virtual;
  25. procedure Shrink (const aExactFit: Boolean);
  26. procedure Expand;
  27. protected
  28. property Count: Integer read GetCount write SetCount;
  29. property IsEmpty: Boolean read GetIsEmpty;
  30. property Capacity: Integer read fCapacity write SetCapacity;
  31. property CanShrink: Boolean read fCanShrink write fCanShrink;
  32. property CanExpand: Boolean read fCanExpand write fCanExpand;
  33. property OwnsItems: Boolean read fOwnsItems write fOwnsItems;
  34. public
  35. constructor Create(const aOwnsItems: Boolean);
  36. destructor Destroy; override;
  37. end;
  38. implementation
  39. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  40. //TutlArrayContainer////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  41. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  42. function TutlArrayContainer.GetIsEmpty: Boolean;
  43. begin
  44. result := (Count = 0);
  45. end;
  46. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  47. function TutlArrayContainer.GetInternalItem(const aIndex: Integer): PT;
  48. begin
  49. if (aIndex < 0) or (aIndex >= fCapacity) then
  50. raise EOutOfRangeException.Create('capacity out of range', aIndex, 0, fCapacity-1);
  51. result := fList + aIndex;
  52. end;
  53. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  54. procedure TutlArrayContainer.SetCapacity(const aValue: integer);
  55. begin
  56. if (fCapacity = aValue) then
  57. exit;
  58. if (aValue < Count) then
  59. raise EArgumentException.Create('can not reduce capacity below count');
  60. ReAllocMem(fList, aValue * SizeOf(T));
  61. FillByte((fList + fCapacity)^, (aValue - fCapacity) * SizeOf(T), 0);
  62. fCapacity := aValue;
  63. end;
  64. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  65. procedure TutlArrayContainer.Release(var aItem: T; const aFreeItem: Boolean);
  66. begin
  67. if not utlFinalizeObject(aItem, TypeInfo(aItem), fOwnsItems and aFreeItem) then
  68. Finalize(aItem);
  69. FillByte(aItem, SizeOf(aItem), 0);
  70. end;
  71. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  72. procedure TutlArrayContainer.Shrink(const aExactFit: Boolean);
  73. begin
  74. if not fCanShrink then
  75. raise EInvalidOperation.Create('shrinking is not allowed');
  76. if (aExactFit) then
  77. SetCapacity(Count)
  78. else if (fCapacity > 128) and (Count < fCapacity shr 2) then // less than 25% used
  79. SetCapacity(fCapacity shr 1); // shrink to 50%
  80. end;
  81. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  82. procedure TutlArrayContainer.Expand;
  83. begin
  84. if (Count < fCapacity) then
  85. exit;
  86. if not fCanExpand then
  87. raise EInvalidOperation.Create('expanding is not allowed');
  88. if (fCapacity <= 0) then
  89. SetCapacity(4)
  90. else if (fCapacity < 128) then
  91. SetCapacity(fCapacity shl 1) // + 100%
  92. else
  93. SetCapacity(fCapacity + fCapacity shr 2); // + 25%
  94. end;
  95. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  96. constructor TutlArrayContainer.Create(const aOwnsItems: Boolean);
  97. begin
  98. inherited Create;
  99. fOwnsItems := aOwnsItems;
  100. fList := nil;
  101. fCapacity := 0;
  102. fCanExpand := true;
  103. fCanShrink := true;
  104. end;
  105. ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
  106. destructor TutlArrayContainer.Destroy;
  107. begin
  108. if Assigned(fList) then begin
  109. FreeMem(fList);
  110. fList := nil;
  111. end;
  112. inherited Destroy;
  113. end;
  114. end.