Home page > Delphi, tips bulk > List classes > ByteList: "Byte" list class

ByteList: "Byte" list class

Wednesday 7 September 2011, by CapJack

TByteList, a list of integers of type "Byte".

For Delphi and Lazarus, all versions including Delphi XE2.

Platforms : all.

Detailed info and other classes : click here.

  1. (*********************************************************)
  2. (***)                                                 (***)
  3. (***)              UNIT ByteList;                     (***)
  4. (***)                                                 (***)
  5. (*********************************************************)
  6.  
  7. (*********************************************************)
  8. (* Feel free to use it, but at your own risk!            *)
  9. (* À utiliser librement, mais à vos risques et périls !  *)
  10. (* CapJack.                                              *)
  11. (*********************************************************)
  12.  
  13.  
  14. (*********************************************************)
  15. (***)                                                 (***)
  16. (***)                  INTERFACE                      (***)
  17. (***)                                                 (***)
  18. (*********************************************************)
  19.  
  20.  
  21. (*********************************************************)
  22. (* TByteList (v1.31)                                     *)
  23. (* ----------------------------------------------------- *)
  24. (* Implements a powerful class encapsulating a list      *)
  25. (* of "Byte", with additional features compared to       *)
  26. (* conventional TList.                                   *)
  27. (* Study the source code for the complete list           *)
  28. (* of features.                                          *)
  29. (* Compilable with any version of Delphi 32/64-bit,      *)
  30. (* and also with Lazarus / Free Pascal.                  *)
  31. (* ----------------------------------------------------- *)
  32. (* Implémente une puissante classe encapsulant une liste *)
  33. (* d'éléments "Byte", avec des fonctionnalités           *)
  34. (* supplémentaires par rapport au classique TList.       *)
  35. (* Étudiez le code source pour la liste complète         *)
  36. (* des fonctionnalités.                                  *)
  37. (* Compilable avec toute version de Delphi 32/64 bits,   *)
  38. (* ainsi qu'avec Lazarus / Free Pascal.                  *)
  39. (*********************************************************)
  40.  
  41.  
  42. {$IFDEF VER80 }{$DEFINE VERYOLDVERSION}{$ENDIF D1    }
  43. {$IFDEF VER90 }{$DEFINE VERYOLDVERSION}{$ENDIF D2    }
  44. {$IFDEF VER93 }{$DEFINE VERYOLDVERSION}{$ENDIF BCB++1}
  45. {$IFDEF VER100}{$DEFINE VERYOLDVERSION}{$ENDIF D3    }
  46. {$IFDEF VER110}{$DEFINE VERYOLDVERSION}{$ENDIF BCB++3}
  47. {$IFDEF VER120}{$DEFINE VERYOLDVERSION}{$ENDIF D4    }
  48. {$IFDEF VER125}{$DEFINE VERYOLDVERSION}{$ENDIF BCB++4}
  49. {$IFDEF VER130}{$DEFINE VERYOLDVERSION}{$ENDIF D5    }
  50. {$IFDEF VER140}{$DEFINE OLDVERSION}{$ENDIF D6,CB++6,Kylix 1&2}
  51. {$IFDEF VER150}{$DEFINE OLDVERSION}{$ENDIF D7, Kylix 3}
  52. {$IFDEF VER160}{$DEFINE OLDVERSION}{$ENDIF D8 for .NET}
  53. {$IFDEF VER170}{$DEFINE OLDVERSION}{$ENDIF D2005}
  54. {$IFDEF VER180}{$DEFINE OLDVERSION}{$ENDIF D2006, D2007 Win32}
  55. {$IFDEF VER180}{$DEFINE OLDVERSION}{$ENDIF D2007 Win32}
  56. {$IFDEF VER185}{$DEFINE OLDVERSION}{$ENDIF D2007 Win32}
  57. {$IFDEF VER190}{$DEFINE OLDVERSION}{$ENDIF D2007 .NET}
  58. {$IFDEF VER200}{$DEFINE OLDVERSION}{$ENDIF D2009, CB++ 2009}
  59. {$IFDEF VER210}{$DEFINE OLDVERSION}{$ENDIF Delphi 2010}
  60. {$IFDEF VER220}{$DEFINE OLDVERSION}{$ENDIF Delphi XE}
  61.  
  62. {$IFDEF FPC} // Lazarus / Free Pascal
  63.  uses SysUtils, Classes, RTLConsts;
  64.  {$HINTS OFF} // Solve useless "local variable not initialized"
  65. {$ELSE} // Delphi
  66.  {$IFDEF VERYOLDVERSION} // Delphi 1 -> 5
  67.   uses SysUtils, Classes, Consts;
  68.  {$ELSE}
  69.   {$IFDEF OLDVERSION} // Delphi 6 -> XE
  70.    uses SysUtils, Classes, RTLConsts;
  71.   {$ELSE} // Delphi XE2 Win 32/64 + MacOS
  72.    uses System.SysUtils, System.Classes,
  73.         System.RTLConsts;
  74.   {$ENDIF OLDVERSION}
  75.  {$ENDIF VERYOLDVERSION}
  76. {$ENDIF FPC}
  77.  
  78. const
  79.  MaxByteListSize = Maxint div SizeOf(Byte);
  80.  
  81.  SByteListVoidError='Invalid method call (empty list)!';
  82.  SByteListSortError='Invalid method call (sorted list)!';
  83.  
  84. type
  85.   PBytePtrList
  86.    = ^TBytePtrList;
  87.  
  88.   TBytePtrList
  89.    = array[0..MaxByteListSize - 1] of Byte;
  90.  
  91.   TByteListSortCompare
  92.    = function (Item1, Item2: Byte): Integer;
  93.  
  94.   TByteDescriptor
  95.    = function (Index:Integer;Item : Byte) : string;
  96.  
  97.   TByteSortOption
  98.    = (
  99.       ByteSortNone,
  100.       ByteSortUpWithDup,
  101.       ByteSortUpNoDup,
  102.       ByteSortDownWithDup,
  103.       ByteSortDownNoDup      
  104.      );
  105.  
  106.   TByteList = class(TObject)
  107.   private
  108.     FList       : PBytePtrList;
  109.     FCount      : Integer;
  110.     FCapacity   : Integer;
  111.     FSortType   : TByteSortOption;
  112.   protected
  113.     function  Get(Index: Integer): Byte;
  114.     procedure Grow; virtual;
  115.     procedure Put(Index: Integer; Item: Byte);
  116.     procedure SetCapacity(AValue: Integer);
  117.     procedure SetCount(AValue: Integer);
  118.     procedure SetSortType
  119.                   (NewSortType: TByteSortOption);
  120.     procedure EliminateDups;
  121.     function  NormalFind(Value: Byte): Integer;
  122.     function  FastFindUp(Value:Byte;
  123.                   var Position:Integer):Integer;
  124.     function  FastFindDown(Value:Byte;
  125.                   var Position:Integer):Integer;
  126.     procedure ForceInsert(Index: Integer; Item: Byte);
  127.     function  NormalAdd(Item: Byte): Integer;
  128.  
  129.   public
  130.     constructor Create;
  131.     destructor Destroy; override;
  132.     function  Add(Item: Byte): Integer;
  133.     procedure Clear;
  134.     procedure SaveToStream(const S:TStream);
  135.     procedure LoadFromStream(const S:TStream;
  136.                   const KeepCurrentSortType:Boolean=false);
  137.     procedure SaveToFile(FileName:string);
  138.     procedure LoadFromFile(FileName:string;
  139.                   const KeepCurrentSortType:Boolean=false);
  140.     procedure Delete(Index: Integer);
  141.     function  ErrMsg(const Msg:string;Data:Integer):string;
  142.     procedure Exchange(Index1, Index2: Integer);
  143.     function  Expand: TByteList;
  144.     function  First: Byte;
  145.     function  IndexOf(Value: Byte): Integer;
  146.     procedure Insert(Index: Integer; Item: Byte);
  147.     function  Last: Byte;
  148.     procedure Move(CurIndex, NewIndex: Integer);
  149.     function  Remove(Item: Byte): Integer;
  150.     procedure Pack(NilValue:Byte);
  151.     procedure Sort(Compare: TByteListSortCompare);
  152.     procedure SortUp;
  153.     procedure SortDown;
  154.     procedure ShowList(StringList:TStrings;
  155.                   Descriptor:TByteDescriptor=nil;
  156.                   ClearIt:Boolean=true);
  157.  
  158.     function  Minimum:Byte;
  159.     function  Maximum:Byte;
  160.     function  Range:Byte;
  161.     function  Sum:Extended;
  162.     function  SumSqr:Extended;
  163.     function  Average:Extended;
  164.     procedure CopyFrom(List:TByteList;
  165.                   const KeepCurrentSortType:Boolean=false);
  166.     procedure CopyTo(List:TByteList;
  167.                   const KeepDestSortType:Boolean=false);
  168.  
  169.     procedure Push(Value:Byte);
  170.     function  LifoPop(DefValue:Byte):Byte;
  171.     function  FifoPop(DefValue:Byte):Byte;
  172.  
  173.     property  List: PBytePtrList read FList;
  174.     property  Capacity: Integer
  175.                   read FCapacity
  176.                   write SetCapacity;
  177.     property  Count: Integer
  178.                   read FCount
  179.                   write SetCount;
  180.     property  Items[Index: Integer]: Byte
  181.                   read Get
  182.                   write Put; default;
  183.     property  SortType:TByteSortOption
  184.                   read FSortType
  185.                   write SetSortType;
  186.   end;
  187.  
  188.  
  189. // Default descriptor - Descripteur par défaut (ShowList)
  190. function DefDesc(Index: Integer;Item: Byte) : string;
  191.  
  192.  
  193. (*********************************************************)
  194. (***)                                                 (***)
  195. (***)                IMPLEMENTATION                   (***)
  196. (***)                                                 (***)
  197. (*********************************************************)
  198.  
  199. {$IFNDEF FPC}
  200.  {$IFDEF OLDVERSION}
  201.   uses Consts;
  202.  {$ENDIF}
  203. {$ENDIF}
  204.  
  205. {---------------------------------------------------------}
  206.  
  207. function DefDesc(Index: Integer;Item: Byte) : string;
  208.  begin
  209.   Result:=Format('Items[%d] = %d',[Index,Item]);
  210.  end;
  211.  
  212. {---------------------------------------------------------}
  213.  
  214. constructor TByteList.Create;
  215. begin
  216.   inherited Create;
  217.   FSortType := ByteSortNone;
  218. end;
  219.  
  220. {---------------------------------------------------------}
  221.  
  222. destructor TByteList.Destroy;
  223. begin
  224.   Clear;
  225.   inherited Destroy;
  226. end;
  227.  
  228. {---------------------------------------------------------}
  229.  
  230. function  TByteList.NormalAdd
  231.                              (Item: Byte): Integer;
  232. begin
  233.   Result := FCount;
  234.   if Result = FCapacity then Grow;
  235.   FList^[Result] := Item;
  236.   Inc(FCount);
  237. end;
  238.  
  239. {---------------------------------------------------------}
  240.  
  241. procedure TByteList.Clear;
  242. begin
  243.   SetCount(0);
  244.   SetCapacity(0);
  245. end;
  246.  
  247. {---------------------------------------------------------}
  248.  
  249. procedure TByteList.SaveToStream(const S:TStream);
  250.  var T : Integer;
  251.  begin
  252.   T := Integer(FSortType);
  253.   S.Write(FCount,SizeOf(FCount));
  254.   S.Write(T,SizeOf(T));
  255.   S.Write(FList^,FCount * SizeOf(Byte));
  256.  end;
  257.  
  258. {---------------------------------------------------------}
  259.  
  260. procedure TByteList.SaveToFile(FileName:string);
  261.  var Stream:TFileStream;
  262.  begin
  263.   Stream:=nil;
  264.   try
  265.    Stream := TFileStream.Create(FileName, fmCreate
  266.                                 or fmShareExclusive);
  267.    SaveToStream(Stream);
  268.   finally
  269.    if assigned(Stream) then Stream.Free;
  270.   end;
  271.  end;
  272.  
  273. {---------------------------------------------------------}
  274.  
  275. procedure TByteList.LoadFromStream(const S:TStream;
  276.                   const KeepCurrentSortType:Boolean=false);
  277.  var N, T    : Integer;
  278.      Current : TByteSortOption;
  279.      Saved   : TByteSortOption;
  280.  begin
  281.   S.Read(N,SizeOf(N));
  282.   S.Read(T,SizeOf(T));
  283.   Saved   := TByteSortOption(T);
  284.   Current := FSortType;
  285.   Clear;
  286.   SetSortType(ByteSortNone);
  287.   SetCount(N);
  288.   S.Read(FList^,N * SizeOf(Byte));
  289.   if KeepCurrentSortType and (Current <> Saved)
  290.      then SetSortType(Current)
  291.      else FSortType := Saved;
  292.  end;
  293.  
  294. {---------------------------------------------------------}
  295.  
  296. procedure TByteList.LoadFromFile(FileName:string;
  297.                 const KeepCurrentSortType:Boolean=false);
  298.  var Stream:TFileStream;
  299.  begin
  300.   Stream:=nil;
  301.   try
  302.    Stream := TFileStream.Create(FileName,fmOpenRead
  303.                                 or fmShareDenyWrite);
  304.    LoadFromStream(Stream,KeepCurrentSortType);
  305.   finally
  306.    if assigned(Stream) then Stream.Free;
  307.   end;
  308.  end;
  309.  
  310. {---------------------------------------------------------}
  311.  
  312. procedure TByteList.Delete(Index: Integer);
  313. begin
  314.   if (Index < 0) or (Index >= FCount)
  315.    then raise EListError.Create(
  316.                    ErrMsg(SListIndexError, Index));
  317.   Dec(FCount);
  318.   if Index < FCount then
  319.     System.Move(FList^[Index + 1], FList^[Index],
  320.       (FCount - Index) * SizeOf(Byte));
  321. end;
  322.  
  323. {---------------------------------------------------------}
  324.  
  325. function  TByteList.ErrMsg(const Msg:string;
  326.                                    Data:Integer):string;
  327. begin
  328.   Result := Format(Msg,[Data]);
  329. end;                                  
  330.  
  331. {---------------------------------------------------------}
  332.  
  333. procedure TByteList.Exchange
  334.                                  (Index1, Index2: Integer);
  335. var
  336.   Item: Byte;
  337. begin
  338.   if FSortType <> ByteSortNone
  339.      then raise EListError.Create(
  340.                      ErrMsg(SByteListSortError,0));
  341.   if (Index1 < 0) or (Index1 >= FCount)
  342.      then raise EListError.Create(
  343.                      ErrMsg(SListIndexError, Index1));
  344.   if (Index2 < 0) or (Index2 >= FCount)
  345.      then raise EListError.Create(
  346.                      ErrMsg(SListIndexError, Index2));
  347.   Item := FList^[Index1];
  348.   FList^[Index1] := FList^[Index2];
  349.   FList^[Index2] := Item;
  350. end;
  351.  
  352. {---------------------------------------------------------}
  353.  
  354. function  TByteList.Expand: TByteList;
  355. begin
  356.   if FCount = FCapacity then Grow;
  357.   Result := Self;
  358. end;
  359.  
  360. {---------------------------------------------------------}
  361.  
  362. function  TByteList.First: Byte;
  363. begin
  364.   Result := Get(0);
  365. end;
  366.  
  367. {---------------------------------------------------------}
  368.  
  369. function  TByteList.Get
  370.                             (Index: Integer): Byte;
  371. begin
  372.   if (Index < 0) or (Index >= FCount)
  373.      then raise EListError.Create(
  374.                      ErrMsg(SListIndexError, Index));
  375.   Result := FList^[Index];
  376. end;
  377.  
  378. {---------------------------------------------------------}
  379.  
  380. procedure TByteList.Grow;
  381. var
  382.   Delta: Integer;
  383. begin
  384.   if FCapacity > 64
  385.      then Delta := FCapacity div 4
  386.      else if FCapacity > 8
  387.           then Delta := 16
  388.           else Delta := 4;
  389.   SetCapacity(FCapacity + Delta);
  390. end;
  391.  
  392. {---------------------------------------------------------}
  393.  
  394. procedure TByteList.ForceInsert(Index: Integer;
  395.                                         Item: Byte);
  396. begin
  397.   if FCount = FCapacity then Grow;
  398.   if Index < FCount then
  399.     System.Move(FList^[Index], FList^[Index + 1],
  400.       (FCount - Index) * SizeOf(Byte));
  401.   FList^[Index] := Item;
  402.   Inc(FCount);
  403. end;
  404.  
  405. {---------------------------------------------------------}
  406.  
  407. procedure TByteList.Insert(Index: Integer;
  408.                                    Item: Byte);
  409. begin
  410.   if FSortType <> ByteSortNone
  411.      then raise EListError.Create(
  412.                      ErrMsg(SByteListSortError,0));
  413.   if (Index < 0) or (Index > FCount)
  414.      then raise EListError.Create(
  415.                      ErrMsg(SListIndexError, Index));
  416.   ForceInsert(Index,Item);
  417. end;
  418.  
  419. {---------------------------------------------------------}
  420.  
  421. function  TByteList.Last: Byte;
  422. begin
  423.   Result := Get(FCount - 1);
  424. end;
  425.  
  426. {---------------------------------------------------------}
  427.  
  428. procedure TByteList.Move(CurIndex,
  429.                                  NewIndex: Integer);
  430. var
  431.   Item: Byte;
  432. begin
  433.   if FSortType <> ByteSortNone
  434.      then raise EListError.Create(
  435.                      ErrMsg(SByteListSortError,0));
  436.   if CurIndex <> NewIndex then
  437.   begin
  438.     if (NewIndex < 0) or (NewIndex >= FCount)
  439.        then raise EListError.Create(
  440.                      ErrMsg(SListIndexError, NewIndex));
  441.     Item := Get(CurIndex);
  442.     Delete(CurIndex);
  443.     Insert(NewIndex, Item);
  444.   end;
  445. end;
  446.  
  447. {---------------------------------------------------------}
  448.  
  449. procedure TByteList.Put(Index: Integer;
  450.                                 Item: Byte);
  451. begin
  452.   if (Index < 0) or (Index >= FCount)
  453.      then raise EListError.Create(
  454.                      ErrMsg(SListIndexError, Index));
  455.   FList^[Index] := Item;
  456. end;
  457.  
  458. {---------------------------------------------------------}
  459.  
  460. function  TByteList.Remove
  461.                              (Item: Byte): Integer;
  462. begin
  463.   Result := IndexOf(Item);
  464.   if Result <> -1 then Delete(Result);
  465. end;
  466.  
  467. {---------------------------------------------------------}
  468.  
  469. procedure TByteList.Pack(NilValue:Byte);
  470. var
  471.   I: Integer;
  472. begin
  473.   for I := FCount - 1 downto 0
  474.       do if Items[I] = NilValue
  475.             then Delete(I);
  476. end;
  477.  
  478. {---------------------------------------------------------}
  479.  
  480. procedure TByteList.SetCapacity(AValue: Integer);
  481. begin
  482.   if (AValue < FCount)
  483.   // SizeOf(Byte)=1 - no other test needed
  484.      then raise EListError.Create(
  485.                   ErrMsg(SListCapacityError, AValue));
  486.   if AValue <> FCapacity
  487.      then begin
  488.            ReallocMem(FList,
  489.                       AValue * SizeOf(Byte));
  490.            FCapacity := AValue;
  491.           end;
  492. end;
  493.  
  494. {---------------------------------------------------------}
  495.  
  496. procedure TByteList.SetCount(AValue: Integer);
  497. begin
  498.   if (AValue < 0)
  499.   // SizeOf(Byte)=1 - no other test needed
  500.      then raise EListError.Create(
  501.                      ErrMsg(SListCountError, AValue));
  502.   if AValue > FCapacity
  503.      then SetCapacity(AValue);
  504.   if AValue > FCount
  505.      then FillChar((@FList^[FCount])^,
  506.             (AValue - FCount) * SizeOf(Byte), 0);
  507.   FCount := AValue;
  508. end;
  509.  
  510. {---------------------------------------------------------}
  511.  
  512. procedure QuickSort(SortList: PBytePtrList;
  513.                     L, R: Integer;
  514.   SCompare: TByteListSortCompare);
  515. var
  516.   I, J: Integer;
  517.   P, T: Byte;
  518. begin
  519.   repeat
  520.     I := L;
  521.     J := R;
  522.     P := SortList^[(L + R) shr 1];
  523.     repeat
  524.       while SCompare(SortList^[I], P) < 0 do Inc(I);
  525.       while SCompare(SortList^[J], P) > 0 do Dec(J);
  526.       if I <= J then
  527.       begin
  528.         T := SortList^[I];
  529.         SortList^[I] := SortList^[J];
  530.         SortList^[J] := T;
  531.         Inc(I);
  532.         Dec(J);
  533.       end;
  534.     until I > J;
  535.     if L < J then QuickSort(SortList, L, J, SCompare);
  536.     L := I;
  537.   until I >= R;
  538. end;
  539.  
  540. {---------------------------------------------------------}
  541.  
  542. procedure TByteList.Sort
  543.                    (Compare: TByteListSortCompare);
  544. begin
  545.   if (FList <> nil) and (Count > 0)
  546.      then QuickSort(FList, 0, Count - 1, Compare);
  547. end;
  548.  
  549. {---------------------------------------------------------}
  550.  
  551. procedure QuickSortUp(SortList: PBytePtrList;
  552.                       L, R: Integer);
  553. var
  554.   I, J: Integer;
  555.   P, T: Byte;
  556. begin
  557.   repeat
  558.     I := L;
  559.     J := R;
  560.     P := SortList^[(L + R) shr 1];
  561.     repeat
  562.       while SortList^[I] < P do Inc(I);
  563.       while SortList^[J] > P do Dec(J);
  564.       if I <= J then
  565.       begin
  566.         T := SortList^[I];
  567.         SortList^[I] := SortList^[J];
  568.         SortList^[J] := T;
  569.         Inc(I);
  570.         Dec(J);
  571.       end;
  572.     until I > J;
  573.     if L < J then QuickSortUp(SortList, L, J);
  574.     L := I;
  575.   until I >= R;
  576. end;
  577.  
  578. procedure TByteList.SortUp;
  579. begin
  580.   if (FList <> nil) and (Count > 0) then
  581.    begin
  582.     QuickSortUp(FList, 0, Count - 1);
  583.     FSortType := ByteSortNone
  584.    end;
  585. end;
  586.  
  587. {---------------------------------------------------------}
  588.  
  589. procedure QuickSortDown(SortList: PBytePtrList;
  590.                         L, R: Integer);
  591. var
  592.   I, J: Integer;
  593.   P, T: Byte;
  594. begin
  595.   repeat
  596.     I := L;
  597.     J := R;
  598.     P := SortList^[(L + R) shr 1];
  599.     repeat
  600.       while SortList^[I] > P do Inc(I);
  601.       while SortList^[J] < P do Dec(J);
  602.       if I <= J then
  603.       begin
  604.         T := SortList^[I];
  605.         SortList^[I] := SortList^[J];
  606.         SortList^[J] := T;
  607.         Inc(I);
  608.         Dec(J);
  609.       end;
  610.     until I > J;
  611.     if L < J then QuickSortDown(SortList, L, J);
  612.     L := I;
  613.   until I >= R;
  614. end;
  615.  
  616. procedure TByteList.SortDown;
  617. begin
  618.   if (FList <> nil) and (Count > 0) then
  619.    begin
  620.     QuickSortDown(FList, 0, Count - 1);
  621.     FSortType := ByteSortNone
  622.    end;
  623. end;
  624.  
  625. {---------------------------------------------------------}
  626.  
  627. procedure TByteList.ShowList(StringList:TStrings;
  628.                   Descriptor:TByteDescriptor=nil;
  629.                   ClearIt:boolean=true);
  630. var I:integer;
  631. begin
  632.  if not assigned(StringList) then exit;
  633.  with StringList do
  634.   begin
  635.    BeginUpdate;
  636.    if ClearIt then Clear;
  637.    if assigned(Descriptor)
  638.       then for I := 0 to FCount -1
  639.            do Add(Descriptor(I,FList^[I]))
  640.       else for I := 0 to FCount -1
  641.            do Add(DefDesc(I,FList^[I]));
  642.    EndUpdate;
  643.   end;
  644. end;
  645.  
  646. {---------------------------------------------------------}
  647.  
  648. procedure TByteList.Push(Value:Byte);
  649.  begin
  650.   Add(Value);
  651.  end;
  652.  
  653. {---------------------------------------------------------}
  654.  
  655. function  TByteList.LifoPop
  656.                       (DefValue:Byte):Byte;
  657.  begin
  658.   if Count=0 then Result := DefValue
  659.              else begin
  660.                    Result := Last;
  661.                    Delete(Count - 1);
  662.                   end;
  663.  end;
  664.  
  665. {---------------------------------------------------------}
  666.  
  667. function  TByteList.FifoPop
  668.                       (DefValue:Byte):Byte;
  669.  begin
  670.   if Count=0 then Result := DefValue
  671.              else begin
  672.                    Result := First;
  673.                    Delete(0);
  674.                   end;
  675.  end;
  676.  
  677. {---------------------------------------------------------}
  678.  
  679. function  TByteList.Minimum:Byte;
  680.  var I:Integer;
  681.  begin
  682.   Result := 0;
  683.   if FCount=0
  684.      then raise EListError.Create(
  685.                      ErrMsg(SByteListVoidError,0));
  686.   case FSortType of
  687.  
  688.        ByteSortNone:
  689.          begin
  690.            Result := FList^[0];
  691.            for I:=1 to FCount-1 do
  692.                if FList^[I]<Result
  693.                   then Result := FList^[I];
  694.          end;
  695.          
  696.        ByteSortUpWithDup,
  697.        ByteSortUpNoDup:
  698.          begin
  699.            Result := FList^[0];
  700.          end;
  701.            
  702.        BytesortDownWithDup,
  703.        BytesortDownNoDup:
  704.          begin
  705.            Result := FList^[FCount - 1];
  706.          end;
  707.            
  708.       end;
  709.  end;
  710.  
  711. {---------------------------------------------------------}
  712.  
  713. function  TByteList.Maximum:Byte;
  714.  var I:Integer;
  715.  begin
  716.   Result := 0;
  717.   if FCount=0
  718.      then raise EListError.Create(
  719.                      ErrMsg(SByteListVoidError,0));
  720.   case FSortType of
  721.  
  722.        ByteSortNone:
  723.          begin
  724.            Result := FList^[0];
  725.            for I:=1 to FCount-1
  726.                do if FList^[I]>Result
  727.                   then Result := FList^[I];
  728.          end;
  729.  
  730.        ByteSortUpWithDup,
  731.        ByteSortUpNoDup:
  732.          Result := FList^[FCount - 1];
  733.  
  734.        BytesortDownWithDup,
  735.        BytesortDownNoDup:
  736.          Result := FList^[0];
  737.          
  738.       end;
  739.  end;
  740.  
  741. {---------------------------------------------------------}
  742.  
  743. function  TByteList.Range:Byte;
  744.  var I:Integer;Min,Max,Item:Byte;
  745.  begin
  746.   if FCount=0
  747.      then raise EListError.Create(
  748.                      ErrMsg(SByteListVoidError,0));
  749.   if FSortType = ByteSortNone
  750.    then
  751.      begin
  752.       Min := FList^[0];
  753.       Max:=Min;
  754.       for I:=1 to FCount-1 do
  755.           begin
  756.            Item:=FList^[I];
  757.            if Item > Max then Max := Item;
  758.            if Item < Min then Min := Item;
  759.           end;
  760.       Result := Max - Min;
  761.      end
  762.    else Result := Maximum - Minimum;
  763.  end;
  764.  
  765. {---------------------------------------------------------}
  766.  
  767. function  TByteList.Sum:Extended;
  768.  var I:Integer;
  769.  begin
  770.   Result:=0;
  771.   for I:=0 to FCount-1
  772.       do Result := Result + FList^[I];
  773.  end;
  774.  
  775. {---------------------------------------------------------}
  776.  
  777. function  TByteList.SumSqr:Extended;
  778.  var I:Integer;Dummy:Extended;
  779.  begin
  780.   Result:=0;
  781.   for I:=0 to FCount-1
  782.       do begin
  783.           Dummy := FList^[I];
  784.           Result := Result + ( Dummy * Dummy );
  785.          end;
  786.  end;
  787.  
  788. {---------------------------------------------------------}
  789.  
  790. function  TByteList.Average:Extended;
  791.  begin
  792.   if FCount=0
  793.      then raise EListError.Create(
  794.                      ErrMsg(SByteListVoidError,0));
  795.   Result := (Sum / FCount);
  796.  end;
  797.  
  798. {---------------------------------------------------------}
  799.  
  800. procedure TByteList.CopyFrom(List:TByteList;
  801.                    const KeepCurrentSortType:Boolean=false);
  802.  var Current : TByteSortOption;
  803.  begin
  804.   Current := FSortType;
  805.   Clear;
  806.   SetSortType(ByteSortNone);
  807.   SetCount(List.Count);
  808.   System.Move(List.List^, FList^,
  809.               List.Count*SizeOf(Byte));
  810.   if KeepCurrentSortType and (Current <> List.SortType)
  811.      then SetSortType(Current)
  812.      else FSortType := List.SortType;
  813.  end;
  814.  
  815. {---------------------------------------------------------}
  816.  
  817. procedure TByteList.CopyTo(List:TByteList;
  818.                     const KeepDestSortType:Boolean=false);
  819.  begin
  820.   List.CopyFrom(Self,KeepDestSortType);
  821.  end;
  822.  
  823. {---------------------------------------------------------}
  824.  
  825. function  TByteList.NormalFind
  826.                            (Value: Byte): Integer;
  827. begin
  828.   Result := 0;
  829.   while (Result < FCount) and (FList^[Result] <> Value)
  830.         do Inc(Result);
  831.   if Result = FCount then Result := -1;
  832. end;
  833.  
  834. {---------------------------------------------------------}
  835.  
  836. function  TByteList.FastFindUp(Value:Byte;
  837.                            var Position:Integer):Integer;
  838.  var A,B:Integer;
  839.  begin
  840.   if Count = 0
  841.      then begin Position := 0; Result := -1; exit end;
  842.   if Value = FList^[0]
  843.      then begin Position := 0; Result :=  0; exit end;
  844.   if Value < FList^[0]
  845.      then begin Position := 0; Result := -1; exit end;
  846.   A := 0;
  847.   B := Count;
  848.   repeat
  849.    Position:=(A + B) div 2;
  850.    if Value = FList^[Position]
  851.       then begin Result := Position;exit end
  852.       else if Value < FList^[Position]
  853.            then B := Position
  854.            else A := Position
  855.   until B - A <= 1;
  856.   Result := -1;
  857.   if Value > FList^[Position] then inc(Position);
  858.  end;
  859.  
  860. {---------------------------------------------------------}
  861.  
  862. function  TByteList.FastFindDown(Value:Byte;
  863.                              var Position:Integer):Integer;
  864.  var A,B:Integer;
  865.  begin
  866.   if Count = 0
  867.      then begin Position := 0; Result := -1; exit end;
  868.   if Value = FList^[0]
  869.      then begin Position := 0; Result :=  0; exit end;
  870.   if Value > FList^[0]
  871.      then begin Position := 0; Result := -1; exit end;
  872.   A := 0;
  873.   B := Count;
  874.   repeat
  875.    Position:=(A + B) div 2;
  876.    if Value = FList^[Position]
  877.       then begin Result := Position;exit end
  878.       else if Value > FList^[Position]
  879.               then B := Position
  880.               else A := Position
  881.   until B - A <= 1;
  882.   Result := -1;
  883.   if Value < FList^[Position] then inc(Position);
  884.  end;
  885.  
  886. {---------------------------------------------------------}
  887.  
  888. function  TByteList.IndexOf
  889.                             (Value: Byte): Integer;
  890.  var P:Integer;
  891.  begin
  892.   Result := -1;
  893.   case FSortType of
  894.        ByteSortNone:
  895.          Result := NormalFind(Value);
  896.  
  897.        ByteSortUpWithDup,
  898.        ByteSortUpNoDup:
  899.          Result := FastFindUp(Value,P);
  900.  
  901.        BytesortDownWithDup,
  902.        BytesortDownNoDup:
  903.          Result := FastFindDown(Value,P);
  904.       end;
  905.  end;
  906.  
  907. {---------------------------------------------------------}
  908.  
  909. function  TByteList.Add
  910.                              (Item: Byte): Integer;
  911.  var P:Integer;
  912.  begin
  913.   Result := -1;
  914.   case FSortType of
  915.        ByteSortNone:
  916.                          begin
  917.                           Result := NormalAdd(Item);
  918.                          end;
  919.        ByteSortUpWithDup:
  920.                          begin
  921.                           FastFindUp(Item,P);
  922.                           ForceInsert(P,Item);
  923.                           Result := P;
  924.                          end;
  925.        ByteSortUpNoDup:
  926.                          begin
  927.                           if FastFindUp(Item,P) = -1
  928.                              then begin
  929.                                    ForceInsert(P,Item);
  930.                                    Result:=P
  931.                                   end;
  932.                          end;
  933.        ByteSortDownWithDup:
  934.                          begin
  935.                           FastFindDown(Item,P);
  936.                           ForceInsert(P,Item);
  937.                           Result := P;
  938.                          end;
  939.        ByteSortDownNoDup:
  940.                          begin
  941.                           if FastFindDown(Item,P) = -1
  942.                              then begin
  943.                                    ForceInsert(P,Item);
  944.                                    Result:=P
  945.                                   end;
  946.                          end;
  947.       end;
  948.  end;
  949.  
  950. {---------------------------------------------------------}
  951.  
  952. procedure TByteList.EliminateDups;
  953.  var I:Integer;
  954.  begin
  955.   I:=0;
  956.   while I < Count - 1 do
  957.     if FList^[I + 1] = FList^[I]
  958.          then Delete(I) else Inc(I);
  959.  end;
  960.  
  961. {---------------------------------------------------------}
  962.  
  963. procedure TByteList.SetSortType
  964.                      (NewSortType:TByteSortOption);
  965.  begin
  966.   if NewSortType = FSortType then exit;
  967.   case NewSortType of
  968.  
  969.        ByteSortNone:
  970.          begin
  971.          end;
  972.  
  973.        ByteSortUpWithDup:
  974.          begin
  975.            if FSortType <> ByteSortUpNoDup
  976.               then SortUp;
  977.          end;
  978.  
  979.        ByteSortUpNoDup:
  980.          begin
  981.            if FSortType <> ByteSortUpWithDup
  982.               then SortUp;
  983.            EliminateDups;
  984.          end;
  985.  
  986.        ByteSortDownWithDup:
  987.          begin
  988.            if FSortType <> ByteSortDownNoDup
  989.               then SortDown;
  990.          end;
  991.  
  992.        ByteSortDownNoDup:
  993.          begin
  994.            if FSortType <> ByteSortDownWithDup
  995.               then SortDown;
  996.            EliminateDups;
  997.          end;
  998.  
  999.       end;
  1000.   FSortType := NewSortType;
  1001.  end;
  1002.  
  1003. {---------------------------------------------------------}
  1004.  
  1005. END.