home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue69 / Alfresco / AAIntLst.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-04-01  |  4.4 KB  |  173 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.       function Last : integer;
  45.  
  46.       property AllowDups : boolean
  47.                   read FAllowDups write FAllowDups;
  48.       property Capacity : integer
  49.                   read ilGetCapacity write ilSetCapacity;
  50.       property Count : integer
  51.                   read FCount write ilSetCount;
  52.       property IsSorted : boolean
  53.                   read FIsSorted write ilSetIsSorted;
  54.       property Items[aInx  : integer] : integer
  55.                   read ilGetItem write ilSetItem; default;
  56.   end;
  57.  
  58. implementation
  59.  
  60. uses
  61.   SysUtils;
  62.  
  63. {====================================================================}
  64. constructor TaaIntList.Create;
  65. begin
  66.   inherited Create;
  67.   FList := TList.Create;
  68.   FIsSorted := true;
  69.   FAllowDups := false;
  70. end;
  71. {--------}
  72. destructor TaaIntList.Destroy;
  73. begin
  74.   FList.Free;
  75.   inherited Destroy;
  76. end;
  77. {--------}
  78. function TaaIntList.Add(aItem : integer) : integer;
  79. var
  80.   L, R, M : integer;
  81. begin
  82.   if (not IsSorted) or (Count = 0) then
  83.     Result := FList.Add(pointer(aItem))
  84.   else begin
  85.     Result := -1;
  86.     L := 0;
  87.     R := pred(Count);
  88.     while (L <= R) do begin
  89.       M := (L + R) div 2;
  90.       if (integer(FList.List^[M]) = aItem) then begin
  91.         if AllowDups then begin
  92.           FList.Insert(M, pointer(aItem));
  93.           Result := M;
  94.         end;
  95.         Exit;
  96.       end;
  97.       if (integer(FList.List^[M]) < aItem) then
  98.         L := M + 1
  99.       else
  100.         R := M - 1;
  101.     end;
  102.     FList.Insert(L, pointer(aItem));
  103.     Result := L;
  104.   end;
  105.   inc(FCount);
  106. end;
  107. {--------}
  108. procedure TaaIntList.Clear;
  109. begin
  110.   FList.Clear;
  111.   FCount := 0;
  112.   FIsSorted := true;
  113. end;
  114. {--------}
  115. function TaaIntList.ilGetCapacity : integer;
  116. begin
  117.   Result := FList.Capacity;
  118. end;
  119. {--------}
  120. function TaaIntList.ilGetItem(aInx : integer) : integer;
  121. begin
  122.   Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
  123.   Result := integer(FList.List^[aInx]);
  124. end;
  125. {--------}
  126. procedure TaaIntList.ilSetCapacity(aValue : integer);
  127. begin
  128.   FList.Capacity := aValue;
  129. end;
  130. {--------}
  131. procedure TaaIntList.ilSetCount(aValue : integer);
  132. begin
  133.   FList.Count := aValue;
  134.   FCount := FList.Count;
  135. end;
  136. {--------}
  137. procedure TaaIntList.ilSetIsSorted(aValue : boolean);
  138. begin
  139.   if (aValue <> FIsSorted) then begin
  140.     FIsSOrted := aValue;
  141.     if FIsSorted then
  142.       ilSort;
  143.   end;
  144. end;
  145. {--------}
  146. procedure TaaIntList.ilSetItem(aInx : integer; aValue : integer);
  147. begin
  148.   Assert((0 <= aInx) and (aInx < Count), 'Index out of bounds');
  149.   FList.List^[aInx] := pointer(aValue);
  150. end;
  151. {--------}
  152. procedure TaaIntList.ilSort;
  153. begin
  154.   Assert(false, 'TaaIntList.ilSort has not been implemented yet');
  155. end;
  156. {--------}
  157. procedure TaaIntList.Insert(aInx : Integer; aItem : Pointer);
  158. begin
  159.   FIsSorted := false;
  160.   FList.Insert(aInx, pointer(aItem));
  161.   inc(FCount);
  162. end;
  163. {--------}
  164. function TaaIntList.Last : integer;
  165. begin
  166.   Assert(Count <> 0,
  167.          'TaaIntList.Last: the integer list is empty');
  168.   Result := integer(FList.List^[pred(Count)]);
  169. end;
  170. {====================================================================}
  171.  
  172. end.
  173.