stcoll.pas

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

  end;
{$ENDIF}
end;

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

    N := TPageDescriptor(colPageList.Head);
    while Assigned(N) do begin
      Start := N.pdStart;
      if Index < Start then begin
        {current page has indexes greater than the specified one}
        if Start-Index <= colPageElements-N.pdCount then begin
          {room to squeeze element into this page}
          NC := Start-Index;
          Move(N.pdPage^[0], N.pdPage^[NC], N.pdCount*SizeOf(Pointer));
          FillChar(N.pdPage^[1], (NC-1)*SizeOf(Pointer), 0);
          Inc(N.pdCount, NC);
        end else begin
          {insert on a new page before this one}
          N := TPageDescriptor(colPageList.PlaceBefore(Pointer(colPageElements), N));
          N.pdCount := 1;
        end;
        N.pdStart := Index;
        N.pdPage^[0] := Data;
        colAdjustPagesAfter(N, +1);
        Exit;
      end else if Index < Start+colPageElements then
        if (not Assigned(N.FNext)) or (Index < TPageDescriptor(N.FNext).pdStart) then begin
          {should be inserted on this page}
          colAtInsertInPage(N, Index-Start, Data);
          Exit;
        end;
      N := TPageDescriptor(N.FNext);
    end;

    {should be inserted after all existing pages}
    N := TPageDescriptor(colPageList.Append(Pointer(colPageElements)));
    N.pdStart := Index;
    N.pdCount := 1;
    N.pdPage^[0] := Data;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

    {special case for putting to end of collection}
    T := TPageDescriptor(colPageList.Tail);
    if Index = T.pdStart+T.pdCount then begin
      if T.pdCount >= colPageElements then begin
        {last page is full, add another}
        Start := T.pdStart+colPageElements;
        T := TPageDescriptor(colPageList.Append(Pointer(colPageElements)));
        T.pdStart := Start;
        {T.pdCount := 0;}
      end;
      T.pdPage^[T.pdCount] := Data;
      inc(T.pdCount);
      Exit;
    end;

    N := colCachePage;
    if Index >= N.pdStart then
      {search up}
      repeat
        Start := N.pdStart;
        if Index < Start then begin
          {element has not been set before}
          N := TPageDescriptor(colPageList.PlaceBefore(Pointer(colPageElements), N));
          N.pdStart := Index;
          N.pdCount := 1;
          N.pdPage^[0] := Data;
          colCachePage := N;
          Exit;
        end else if Index < Start+N.pdCount then begin
          {element fits in this page}
          colCachePage := N;
          N.pdPage^[Index-Start] := Data;
          Exit;
        end else if (N = T) and (Index < Start+colPageElements) then begin
          {element fits in last page}
          colCachePage := N;
          N.pdPage^[Index-Start] := Data;
          N.pdCount := Index-Start+1;
          Exit;
        end;
        N := TPageDescriptor(N.FNext);
      until not Assigned(N)

    else begin
      {search down}
      N := TPageDescriptor(N.FPrev);
      while Assigned(N) do begin
        Start := N.pdStart;
        if (Index >= Start+N.pdCount) then begin
          {element has not been set before}
          N := TPageDescriptor(colPageList.PlaceBefore(Pointer(colPageElements), N));
          N.pdStart := Index;
          N.pdCount := 1;
          N.pdPage^[0] := Data;
          colCachePage := N;
          Exit;
        end else if Index >= Start then begin
          {element is in this page}
          colCachePage := N;
          N.pdPage^[Index-Start] := Data;
          Exit;
        end;
        N := TPageDescriptor(N.FPrev);
      end;
    end;

    {an element after all existing ones}
    N := TPageDescriptor(colPageList.Append(Pointer(colPageElements)));
    colCachePage := N;
    N.pdStart := Index;
    N.pdCount := 1;
    N.pdPage^[0] := Data;
    Exit;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStCollection.Clear;
var
  I : Integer;
  N, P : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    N := TPageDescriptor(colPageList.Head);
    colCachePage := N;
    while Assigned(N) do begin
      for I := 0 to N.pdCount-1 do
        DoDisposeData(N.pdPage^[I]);
      P := TPageDescriptor(N.FNext);
      if N = colCachePage then begin
        {keep the first page, which is now empty}
        N.pdCount := 0;
        N.pdStart := 0;
      end else
        {delete all other pages}
        colPageList.Delete(N);
      N := P;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStCollection.colAdjustPagesAfter(N : TPageDescriptor; Delta : LongInt);
begin
  N := TPageDescriptor(N.FNext);
  while Assigned(N) do begin
    inc(N.pdStart, Delta);
    N := TPageDescriptor(N.FNext);
  end;
end;

procedure TStCollection.colAtDeleteInPage(N : TPageDescriptor; PageIndex : Integer);
begin
  with N do begin
    {free the element}
    DoDisposeData(pdPage^[PageIndex]);
    Move(pdPage^[PageIndex+1], pdPage^[PageIndex],
         (colPageElements-PageIndex-1)*SizeOf(Pointer));
    Dec(pdCount);
    colAdjustPagesAfter(N, -1);
    if (pdCount = 0) and (colPageList.Count > 1) then begin
      {delete page if at least one page will remain}
      if N = colCachePage then begin                           
        colCachePage := TPageDescriptor(colPageList.Head);
        if N = colCachePage then                               
          colCachePage := TPageDescriptor(N.FNext);            
      end;
      colPageList.Delete(N);
    end;
  end;
end;

procedure TStCollection.colAtInsertInPage(N : TPageDescriptor; PageIndex : Integer;
                                       AData : Pointer);
var
  P : TPageDescriptor;
  PC : Integer;
begin
  with N do
    if pdCount >= colPageElements then begin
      {page is full, add another}
      P := TPageDescriptor(colPageList.Place(Pointer(colPageElements), N));
      {new page starts with element after the new one}
      P.pdStart := pdStart+PageIndex+1;
      PC := colPageElements-PageIndex;
      Move(pdPage^[PageIndex], P.pdPage^[0], PC*SizeOf(Pointer));
      pdPage^[PageIndex] := AData;
      pdCount := PageIndex+1;
      P.pdCount := PC;
      colAdjustPagesAfter(P, +1);
    end else begin
      {room to add on this page}
      if pdCount > PageIndex then begin
        Move(pdPage^[PageIndex], pdPage^[PageIndex+1], (pdCount-PageIndex)*SizeOf(Pointer));
        colAdjustPagesAfter(N, +1);
        inc(pdCount);
      end else begin
        FillChar(pdPage^[pdCount], (PageIndex-pdCount)*SizeOf(Pointer), 0);
        colAdjustPagesAfter(N, PageIndex+1-pdCount);
        pdCount := PageIndex+1;
      end;
      pdPage^[PageIndex] := AData;
    end;
end;

function TStCollection.colGetCount : LongInt;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    with TPageDescriptor(colPageList.Tail) do
      Result := pdStart+pdCount;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStCollection.colGetEfficiency : Integer;
var
  Pages, ECount : LongInt;
  N : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    ECount := 0;
    Pages := 0;
    N := TPageDescriptor(colPageList.Head);
    while Assigned(N) do begin
      with N do begin
        inc(Pages);
        inc(ECount, N.pdCount);
      end;
      N := TPageDescriptor(N.FNext);
    end;
    Result := (100*ECount) div (Pages*colPageElements);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStCollection.ForEachPointer(Action : TIteratePointerFunc;
                                       OtherData : pointer);
var
  I : Integer;
  N : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    N := TPageDescriptor(colPageList.Head);
    while Assigned(N) do begin
      with N do
        for I := 0 to pdCount-1 do
          if (pdPage^[I] <> nil) then
            if not Action(Self, pdPage^[I], OtherData) then begin
              Exit;
            end;
      N := TPageDescriptor(N.FNext);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStCollection.StoresPointers : boolean;
begin
  Result := true;
end;

constructor TStCollection.Create(PageElements : Integer);
begin
  CreateContainer(TStNode, 0);

  if (PageElements = 0) then
    RaiseContainerError(stscBadSize);

  colPageList := TStList.Create(TPageDescriptor);
  colPageElements := PageElements;

  {start with one empty page}
  colPageList.Append(Pointer(colPageElements));
  colCachePage := TPageDescriptor(colPageList.Head);
end;

procedure TStCollection.Delete(Data : Pointer);
var
  Index : LongInt;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    Index := IndexOf(Data);
    if Index >= 0 then
      AtDelete(Index);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

destructor TStCollection.Destroy;
begin
  Clear;
  colPageList.Free;
  IncNodeProtection;
  inherited Destroy;
end;

function TStCollection.IndexOf(Data : Pointer) : LongInt;
var
  I : LongInt;
  N : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    N := TPageDescriptor(colPageList.Head);
    while Assigned(N) do begin
      for I := 0 to N.pdCount-1 do
        if N.pdPage^[I] = Data then begin
          colCachePage := N;
          Result := N.pdStart+I;
          Exit;
        end;
      N := TPageDescriptor(N.FNext);
    end;
    IndexOf := -1;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStCollection.Insert(Data : Pointer);
var
  Start : LongInt;
  N : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    N := TPageDescriptor(colPageList.Tail);
    if N.pdCount >= colPageElements then begin
      {last page is full, add another}
      Start := N.pdStart+colPageElements;
      N := TPageDescriptor(colPageList.Append(Pointer(colPageElements)));
      N.pdStart := Start;
      {N.pdCount := 0;}
    end;
    N.pdPage^[N.pdCount] := Data;