stcoll.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StColl.pas 4.03                             *}
{*********************************************************}
{* SysTools: Huge, sparse collection class               *}
{*********************************************************}

{$I StDefine.inc}

{Notes:
  - STCOLL generally follows the standards set by Borland's TP6
    TCollection. All elements in the collection are pointers. Elements can
    be inserted, deleted, and accessed by index number. The size of the
    collection grows dynamically as needed. However, STCOLL is implemented
    in a different fashion that gives it more capacity and higher
    efficiency in some ways.

  - STCOLL theoretically allows up to 2 billion elements. The collection
    is "sparse" in the sense that most of the memory is allocated only
    when a value is assigned to an element in the collection.

  - STCOLL is implemented as a linked list of pointers to pages. Each
    page can hold a fixed number of collection elements, the size
    being specified when the TStCollection is created. Only when an
    element with a given index is written to is a page descriptor and a
    page allocated for it.  However, the first page is allocated when the
    collection is created.

  - The larger the page size, the faster it is to access a given index
    and the less memory overhead is used for management of the collection.
    If the page size is at least as large as the number of elements added
    to the collection, TStCollection works just like Borland's old
    TCollection.  Inserting elements in the middle of very large pages can
    be slow, however, because lots of data must be shifted to make room
    for each new element. Conversely, if the page size is 1, TStCollection
    acts much like a traditional linked list.

  - The page size is limited to 16380 elements in 16-bit mode, or
    536 million elements in 32-bit mode.

  - STCOLL uses the DisposeData procedure of TStContainer to determine
    how to free elements in the collection. By default, it does nothing.

  - AtFree and Free do not exist in TStCollection. Instead the AtDelete
    and Delete methods will also dispose of the element if the DisposeData
    property of the class has been set.

  - The Count property returns the index (plus one) of the highest
    element inserted or put.

  - AtInsert can insert an item at any index, even larger than Count+1.
    AtPut also can put an item at any index.

  - If the At function is called for any non-negative index whose value
    has not been explicitly assigned using Insert or AtInsert, it returns
    nil.

  - For the non-sorted collection, IndexOf compares the data pointers
    directly, for exact equality, without using any Comparison function.

  - TStSortedCollection allows duplicate nodes only if its Duplicates
    property is set.

  - The Efficiency property returns a measure of how fully the collection
    is using the memory pages it has allocated. It returns a number in the
    range of 0 to 100 (percent). Calling TStSortedCollection.Insert,
    AtInsert, Delete, or AtDelete can result in a low efficiency. After a
    series of calls to these methods it is often worthwhile to call the
    Pack method to increase the efficiency as much as possible.
}

unit StColl;
{-}

interface

uses
  Windows, Classes,
  
  StConst, StBase, StList;

type
  {.Z+}
  PPointerArray = ^TPointerArray;
  TPointerArray = array[0..(StMaxBlockSize div SizeOf(Pointer))-1] of Pointer;

  TPageDescriptor = class(TStListNode)
  protected
    {PageElements count is stored in inherited Data field}
    pdPage  : PPointerArray; {Pointer to page data}
    pdStart : LongInt;       {Index of first element in page}
    pdCount : Integer;       {Number of elements used in page}

  public
    constructor Create(AData : Pointer); override;
    destructor Destroy; override;
  end;
  {.Z-}

  TCollIterateFunc = function (Container : TStContainer;
                               Data : Pointer;
                               OtherData : Pointer) : Boolean;

  TStCollection = class(TStContainer)
  {.Z+}
  protected
    colPageList : TStList;      {List of page descriptors}
    colPageElements : Integer;  {Number of elements in a page}
    colCachePage : TPageDescriptor; {Page last found by At}

    procedure colAdjustPagesAfter(N : TPageDescriptor; Delta : LongInt);
    procedure colAtInsertInPage(N : TPageDescriptor; PageIndex : Integer;
                                AData : Pointer);
    procedure colAtDeleteInPage(N : TPageDescriptor; PageIndex : Integer);
    function colGetCount : LongInt;
    function colGetEfficiency : Integer;

    procedure ForEachPointer(Action : TIteratePointerFunc; OtherData : pointer);
      override;
    function StoresPointers : boolean;
      override;
  {.Z-}
  public
    constructor Create(PageElements : Integer); virtual;
      {-Initialize a collection with given page size and allocate first page}
    destructor Destroy; override;
      {-Free a collection}

    procedure LoadFromStream(S : TStream); override;
      {-Load a collection's data from a stream}
    procedure StoreToStream(S : TStream); override;
      {-Write a collection and its data to a stream}

    procedure Clear; override;
      {-Deallocate all pages and free all items}
    procedure Assign(Source: TPersistent); override;
      {-Assign another container's contents to this one}
    procedure Pack;
      {-Squeeze collection elements into the least memory possible}

    function At(Index : LongInt) : Pointer;
      {-Return the element at a given index}
    function IndexOf(Data : Pointer) : LongInt; virtual;
      {-Return the index of the first item with given data}

    procedure AtInsert(Index : LongInt; Data : Pointer);
      {-Insert a new element at a given index and move following items down}
    procedure AtPut(Index : LongInt; Data : Pointer);
      {-Replace element at given index with new data}
    procedure Insert(Data : Pointer); virtual;
      {-Insert item at the end of the collection}

    procedure AtDelete(Index : LongInt);
      {-Remove element at a given index, move following items up, free element}
    procedure Delete(Data : Pointer);
      {-Delete the first item with the given data}

    function Iterate(Action : TCollIterateFunc; Up : Boolean;
                     OtherData : Pointer) : Pointer;
      {-Call Action for all the non-nil elements, returning the last data}

    property Count : LongInt
      {-Return the index of the highest assigned item, plus one}
      read colGetCount;

    property Efficiency : Integer
      {-Return the overall percent Efficiency of the pages}
      read colGetEfficiency;

    property Items[Index : LongInt] : Pointer
      {-Return the Index'th node, 0-based}
      read At
      write AtPut;
      default;
  end;

  {.Z+}
  TSCSearch = (SCSPageEmpty,
               SCSLessThanThisPage,
               SCSInThisPageRange,
               SCSFound,
               SCSGreaterThanThisPage);
  {.Z-}

  TStSortedCollection = class(TStCollection)
  {.Z+}
  protected
    FDuplicates : Boolean;

    function scSearchPage(AData : Pointer; N : TPageDescriptor;
                          var PageIndex : Integer) : TSCSearch;

    procedure scSetDuplicates(D : Boolean);
  {.Z-}
  public
    procedure LoadFromStream(S : TStream); override;
      {-Load a sorted collection's data from a stream}
    procedure StoreToStream(S : TStream); override;
     {-Write a collection and its data to a stream}

    function IndexOf(Data : Pointer) : LongInt; override;
      {-Return the index of the first item with given data}
    procedure Insert(Data : Pointer); override;
      {-Insert item in sorted position}
    property Duplicates : Boolean
      {-Determine whether sorted collection allows duplicate data}
    read FDuplicates
    write scSetDuplicates;
  end;

{======================================================================}

implementation

function AssignData(Container : TStContainer;
                    Data, OtherData : Pointer) : Boolean; far;
  var
    OurColl : TStCollection absolute OtherData;
  begin
    OurColl.Insert(Data);
    Result := true;
  end;

constructor TPageDescriptor.Create(AData : Pointer);
begin
  inherited Create(AData);
  GetMem(pdPage, LongInt(Data)*SizeOf(Pointer));
  FillChar(pdPage^, LongInt(Data)*SizeOf(Pointer), 0);
end;

destructor TPageDescriptor.Destroy;
begin
  if Assigned(pdPage) then
    FreeMem(pdPage, LongInt(Data)*SizeOf(Pointer));
  inherited Destroy;
end;

{----------------------------------------------------------------------}

procedure TStCollection.Assign(Source: TPersistent);
  begin
    {$IFDEF ThreadSafe}
    EnterCS;
    try
    {$ENDIF}
      {The only containers that we allow to be assigned to a collection are
         - a SysTools linked list (TStList)
         - a SysTools binary search tree (TStTree)
         - another SysTools collection (TStCollection, TStSortedCollection)}
      if not AssignPointers(Source, AssignData) then
        inherited Assign(Source);
    {$IFDEF ThreadSafe}
    finally
      LeaveCS;
    end;{try..finally}
    {$ENDIF}
  end;

function TStCollection.At(Index : LongInt) : Pointer;
var
  Start : LongInt;
  N : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if Index < 0 then
      RaiseContainerError(stscBadIndex);

    N := colCachePage;
    if Index >= N.pdStart then
      {search up}
      repeat
        with N do begin
          Start := pdStart;
          if Index < Start then begin
            {element has not been set}
            colCachePage := N;
            break;
          end else if Index < Start+pdCount then begin
            {element is in this page}
            colCachePage := N;
            Result := pdPage^[Index-Start];
            Exit;
          end;
        end;
        N := TPageDescriptor(N.FNext);
      until not Assigned(N)

    else begin
      {search down}
      N := TPageDescriptor(N.FPrev);
      while Assigned(N) do begin
        with N do begin
          Start := pdStart;
          if (Index >= Start+pdCount) then begin
            {element has not been set}
            colCachePage := N;
            break;
          end else if Index >= Start then begin
            {element is in this page}
            colCachePage := N;
            Result := pdPage^[Index-Start];
            Exit;
          end;
        end;
        N := TPageDescriptor(N.FPrev);
      end;
    end;

    {not found, leave cache page unchanged}
    Result := nil;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStCollection.AtDelete(Index : LongInt);
var
  Start : LongInt;
  N : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if Index < 0 then
      RaiseContainerError(stscBadIndex);

    N := colCachePage;
    if Index >= N.pdStart then
      repeat
        with N do begin
          Start := pdStart;
          if Index < Start then begin
            {element has not been set, nothing to free}
            Dec(pdStart);
            colAdjustPagesAfter(N, -1);
            colCachePage := N;
            Exit;
          end else if Index < Start+pdCount then begin
            {element is in this page}
            colCachePage := N;
            colAtDeleteInPage(N, Index-Start);
            Exit;
          end;
        end;
        N := TPageDescriptor(N.FNext);
      until not Assigned(N)

    else begin
      {search down}
      N := TPageDescriptor(N.FPrev);
      while Assigned(N) do begin
        with N do begin
          Start := pdStart;
          if Index >= Start+pdCount then begin
            {element has not been set, nothing to free}
            Dec(pdStart);
            colAdjustPagesAfter(N, -1);
            colCachePage := N;
            Exit;
          end else if Index >= Start then begin
            {element is in this page}
            colCachePage := N;
            colAtDeleteInPage(N, Index-Start);
            Exit;
          end;
        end;
        N := TPageDescriptor(N.FPrev);
      end;
    end;

    {index not found, nothing to delete}
{$IFDEF ThreadSafe}
  finally
    LeaveCS;