home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue68 / Alfresco / AAIntLst.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-03-04  |  4.2 KB  |  165 lines
  1. {*********************************************************}
  2. {* AAIntLst                                              *}
  3. {* Copyright (c) Julian M Bucknall 2001                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Algorithms Alfresco: An integer list                  *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAIntLst;
  14.  
  15. interface
  16.  
  17. uses
  18.   Classes;
  19.  
  20. type
  21.   TaaIntList = class
  22.     private
  23.       FAllowDups : boolean;
  24.       FCount     : integer;
  25.       FIsSorted  : boolean;
  26.       FList      : TList;
  27.     protected
  28.       function ilGetCapacity : integer;
  29.       function ilGetItem(aInx : integer) : integer;
  30.  
  31.       procedure ilSetCapacity(aValue : integer);
  32.       procedure ilSetCount(aValue : integer);
  33.       procedure ilSetIsSorted(aValue : boolean);
  34.       procedure ilSetItem(aInx : integer; aValue : integer);
  35.  
  36.       procedure ilSort;
  37.     public
  38.       constructor Create;
  39.       destructor Destroy; override;
  40.  
  41.       function Add(aItem : integer) : integer;
  42.       procedure Clear;
  43.       procedure Insert(aInx : Integer; aItem : Pointer);
  44.  
  45.       property AllowDups : boolean
  46.                   read FAllowDups write FAllowDups;
  47.       property Capacity : integer
  48.                   read ilGetCapacity write ilSetCapacity;
  49.       property Count : integer
  50.                   read FCount write ilSetCount;
  51.       property IsSorted : boolean
  52.                   read FIsSorted write ilSetIsSorted;
  53.       property Items[aInx  : integer] : integer
  54.                   read ilGetItem write ilSetItem; default;
  55.   end;
  56.  
  57. implementation
  58.  
  59. uses
  60.   SysUtils;
  61.  
  62. {====================================================================}
  63. constructor TaaIntList.Create;
  64. begin
  65.   inherited Create;
  66.   FList := TList.Create;
  67.   FIsSorted := true;
  68.   FAllowDups := false;
  69. end;
  70. {--------}
  71. destructor TaaIntList.Destroy;
  72. begin
  73.   FList.Free;
  74.   inherited Destroy;
  75. end;
  76. {--------}
  77. function TaaIntList.Add(aItem : integer) : integer;
  78. var
  79.   L, R, M : integer;
  80. begin
  81.   if (not IsSorted) or (Count = 0) then
  82.     Result := FList.Add(pointer(aItem))
  83.   else begin
  84.     Result := -1;
  85.     L := 0;
  86.     R := pred(Count);
  87.     while (L <= R) do begin
  88.       M := (L + R) div 2;
  89.       if (integer(FList.List^[M]) = aItem) then begin
  90.         if AllowDups then begin
  91.           FList.Insert(M, pointer(aItem));
  92.           Result := M;
  93.         end;
  94.         Exit;
  95.       end;
  96.       if (integer(FList.List^[M]) < aItem) then
  97.         L := M + 1
  98.       else
  99.         R := M - 1;
  100.     end;
  101.     FList.Insert(L, pointer(aItem));
  102.     Result := L;
  103.   end;
  104.   inc(FCount);
  105. end;
  106. {--------}
  107. procedure TaaIntList.Clear;
  108. begin
  109.   FList.Clear;
  110.   FCount := 0;
  111.   FIsSorted := true;
  112. end;
  113. {--------}
  114. function TaaIntList.ilGetCapacity : integer;
  115. begin
  116.   Result := FList.Capacity;
  117. end;
  118. {--------}
  119. function TaaIntList.ilGetItem(aInx : integer) : integer;
  120. begin
  121.   Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
  122.   Result := integer(FList.List^[aInx]);
  123. end;
  124. {--------}
  125. procedure TaaIntList.ilSetCapacity(aValue : integer);
  126. begin
  127.   FList.Capacity := aValue;
  128. end;
  129. {--------}
  130. procedure TaaIntList.ilSetCount(aValue : integer);
  131. begin
  132.   FList.Count := aValue;
  133.   FCount := FList.Count;
  134. end;
  135. {--------}
  136. procedure TaaIntList.ilSetIsSorted(aValue : boolean);
  137. begin
  138.   if (aValue <> FIsSorted) then begin
  139.     FIsSOrted := aValue;
  140.     if FIsSorted then
  141.       ilSort;
  142.   end;
  143. end;
  144. {--------}
  145. procedure TaaIntList.ilSetItem(aInx : integer; aValue : integer);
  146. begin
  147.   Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
  148.   FList.List^[aInx] := pointer(aValue);
  149. end;
  150. {--------}
  151. procedure TaaIntList.ilSort;
  152. begin
  153.   Assert(false, 'TaaIntList.ilSort has not been implemented yet');
  154. end;
  155. {--------}
  156. procedure TaaIntList.Insert(aInx : Integer; aItem : Pointer);
  157. begin
  158.   FIsSorted := false;
  159.   FList.Insert(aInx, pointer(aItem));
  160.   inc(FCount);
  161. end;
  162. {====================================================================}
  163.  
  164. end.
  165.