stcoll.pas

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

    inc(N.pdCount);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStCollection.Iterate(Action : TCollIterateFunc; Up : Boolean;
                               OtherData : Pointer) : Pointer;
var
  I : Integer;
  N : TPageDescriptor;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if Up then begin
      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
                Result := pdPage^[I];
                Exit;
              end;
        N := TPageDescriptor(N.FNext);
      end;
    end else begin
      N := TPageDescriptor(colPageList.Tail);
      while Assigned(N) do begin
        with N do
          for I := pdCount-1 downto 0 do
            if (pdPage^[I] <> nil) then
              if not Action(Self, pdPage^[I], OtherData) then begin
                Result := pdPage^[I];
                Exit;
              end;
        N := TPageDescriptor(N.FPrev);
      end;
    end;

    Result := nil;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStCollection.Pack;
var
  N, P : TPageDescriptor;
  NC : Integer;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    colCachePage := TPageDescriptor(colPageList.Head);
    N := colCachePage;
    while Assigned(N) do begin
      while Assigned(N.FNext) and (N.pdCount < colPageElements) do begin
        {there is a page beyond this page and room to add to this page}
        P := TPageDescriptor(N.FNext);
        if N.pdStart+N.pdCount = P.pdStart then begin
          {next page has contiguous elements}
          NC := colPageElements-N.pdCount;
          if NC > P.pdCount then
            NC := P.pdCount;
          move(P.pdPage^[0], N.pdPage^[N.pdCount], NC*SizeOf(Pointer));
          move(P.pdPage^[NC], P.pdPage^[0], (P.pdCount-NC)*SizeOf(Pointer));
          inc(N.pdCount, NC);
          dec(P.pdCount, NC);
          if P.pdCount = 0 then
            colPageList.Delete(P)
          else
            inc(P.pdStart, NC);
        end else
          {pages aren't contiguous, can't merge}
          break;
      end;
      N := TPageDescriptor(N.FNext);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStCollection.LoadFromStream(S : TStream);
var
  Data         : pointer;
  Reader       : TReader;
  PageElements : integer;
  Index        : longint;
  StreamedClass : TPersistentClass;
  StreamedClassName : string;
begin
  Clear;
  Reader := TReader.Create(S, 1024);
  try
    with Reader do
      begin
        StreamedClassName := ReadString;
        StreamedClass := GetClass(StreamedClassName);
        if (StreamedClass = nil) then
          RaiseContainerErrorFmt(stscUnknownClass, [StreamedClassName]);
        if (not IsOrInheritsFrom(StreamedClass, Self.ClassType)) or
           (not IsOrInheritsFrom(TStCollection, StreamedClass)) then
          RaiseContainerError(stscWrongClass);
        PageElements := ReadInteger;
        if (PageElements <> colPageElements) then
          begin
            colPageList.Clear;
            colPageElements := PageElements;
            colPageList.Append(Pointer(colPageElements));
            colCachePage := TPageDescriptor(colPageList.Head);
          end;
        ReadListBegin;
        while not EndOfList do
          begin
            Index := ReadInteger;
            Data := DoLoadData(Reader);
            AtPut(Index, Data);
          end;
        ReadListEnd;
      end;
  finally
    Reader.Free;
  end;
end;

procedure TStCollection.StoreToStream(S : TStream);
var
  Writer : TWriter;
  N      : TPageDescriptor;
  i      : integer;
begin
  Writer := TWriter.Create(S, 1024);
  try
    with Writer do
      begin
        WriteString(Self.ClassName);
        WriteInteger(colPageElements);
        WriteListBegin;
        N := TPageDescriptor(colPageList.Head);
        while Assigned(N) do
          begin
            with N do
              for i := 0 to pdCount-1 do
                if (pdPage^[i] <> nil) then
                  begin
                    WriteInteger(pdStart + i);
                    DoStoreData(Writer, pdPage^[i]);
                  end;
            N := TPageDescriptor(N.FNext);
          end;
        WriteListEnd;
      end;
  finally
    Writer.Free;
  end;
end;

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

function TStSortedCollection.IndexOf(Data : Pointer) : LongInt;
var
  N : TPageDescriptor;
  PageIndex : Integer;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (Count = 0) then begin
      Result := -1;
      Exit;
    end;
    N := colCachePage;
    if DoCompare(Data, N.pdPage^[0]) >= 0 then begin
      {search up}
      repeat
        case scSearchPage(Data, N, PageIndex) of
          SCSFound :
            begin
              colCachePage := N;
              Result := N.pdStart+PageIndex;
              Exit;
            end;
          SCSGreaterThanThisPage :
            {keep on searching} ;
        else
          {can't be anywhere else in the collection}
          break;
        end;
        N := TPageDescriptor(N.FNext);
      until not Assigned(N);

    end else begin
      {search down}
      N := TPageDescriptor(N.FPrev);
      while Assigned(N) do begin
        case scSearchPage(Data, N, PageIndex) of
          SCSFound :
            begin
              colCachePage := N;
              Result := N.pdStart+PageIndex;
              Exit;
            end;
          SCSLessThanThisPage :
            {keep on searching} ;
        else
          {can't be anywhere else in the collection}
          break;
        end;
        N := TPageDescriptor(N.FPrev);
      end;
    end;

    Result := -1;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

procedure TStSortedCollection.Insert(Data : Pointer);
var
  N : TPageDescriptor;
  PageIndex : Integer;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    N := TPageDescriptor(colPageList.Head);
    while Assigned(N) do begin
      case scSearchPage(Data, N, PageIndex) of
        SCSPageEmpty, SCSInThisPageRange, SCSLessThanThisPage :
          begin
            colAtInsertInPage(N, PageIndex, Data);
            Exit;
          end;
        SCSFound :
          if FDuplicates then begin
            colAtInsertInPage(N, PageIndex, Data);
            Exit;
          end else
          RaiseContainerError(stscDupNode);
      end;
      N := TPageDescriptor(N.FNext);
    end;

    {greater than all other items}
    inherited Insert(Data);
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

function TStSortedCollection.scSearchPage(AData : Pointer; N : TPageDescriptor;
                                          var PageIndex : Integer) : TSCSearch;
var
  L, R, M, Comp : Integer;
begin
  with N do
    if pdCount = 0 then begin
      Result := SCSPageEmpty;
      PageIndex := 0;
    end else if DoCompare(AData, pdPage^[0]) < 0 then begin
      Result := SCSLessThanThisPage;
      PageIndex := 0;
    end else if DoCompare(AData, pdPage^[pdCount-1]) > 0 then
      Result := SCSGreaterThanThisPage
    else begin
      {data might be in this page, check using binary search}
      Result := SCSInThisPageRange;
      L := 0;
      R := pdCount-1;
      repeat
        M := (L+R) div 2;
        Comp := DoCompare(AData, pdPage^[M]);
        if Comp > 0 then
          L := M+1
        else begin
          R := M-1;
        if Comp = 0 then begin
          PageIndex := M;
          Result := SCSFound;
            if not FDuplicates then
              {force exit from repeat loop}
              L := M;
            {else loop to find first of a group of duplicate nodes}
          end;
        end;
      until L > R;

      if Result = SCSInThisPageRange then begin
      {not found in page, return where it would be inserted}
      PageIndex := M;
      if Comp > 0 then
        inc(PageIndex);
    end;
end;
end;

procedure TStSortedCollection.scSetDuplicates(D : Boolean);
begin
  if FDuplicates <> D then
    if D then
      FDuplicates := True
    else if FCount <> 0 then
      RaiseContainerError(stscBadDups)
    else
      FDuplicates := False;
end;

procedure TStSortedCollection.LoadFromStream(S : TStream);
var
  Data         : pointer;
  Reader       : TReader;
  PageElements : integer;
  StreamedClass : TPersistentClass;
  StreamedClassName : string;
begin
  Clear;
  Reader := TReader.Create(S, 1024);
  try
    with Reader do
      begin
        StreamedClassName := ReadString;
        StreamedClass := GetClass(StreamedClassName);
        if (StreamedClass = nil) then
          RaiseContainerErrorFmt(stscUnknownClass, [StreamedClassName]);
        if (not IsOrInheritsFrom(StreamedClass, Self.ClassType)) or
           (not IsOrInheritsFrom(TStCollection, StreamedClass)) then
          RaiseContainerError(stscWrongClass);
        PageElements := ReadInteger;
        if (PageElements <> colPageElements) then
          begin
            colPageList.Clear;
            colPageElements := PageElements;
            colPageList.Append(Pointer(colPageElements));
            colCachePage := TPageDescriptor(colPageList.Head);
          end;
      FDuplicates := ReadBoolean;
        ReadListBegin;
        while not EndOfList do
          begin
            ReadInteger; {read & discard index number}
            Data := DoLoadData(Reader);
            Insert(Data);
          end;
        ReadListEnd;
      end;
  finally
    Reader.Free;
  end;
end;

procedure TStSortedCollection.StoreToStream(S : TStream);
var
  Writer : TWriter;
  N      : TPageDescriptor;
  i      : integer;
begin
  Writer := TWriter.Create(S, 1024);
  try
    with Writer do
      begin
        WriteString(Self.ClassName);
        WriteInteger(colPageElements);
        WriteBoolean(FDuplicates);
        WriteListBegin;
        N := TPageDescriptor(colPageList.Head);
        while Assigned(N) do
          begin
            with N do
              for i := 0 to pdCount-1 do
                if (pdPage^[i] <> nil) then
                  begin
                    WriteInteger(pdStart + i);
                    DoStoreData(Writer, pdPage^[i]);
                  end;
            N := TPageDescriptor(N.FNext);
          end;
        WriteListEnd;
      end;
  finally
    Writer.Free;
  end;
end;


end.