ststrms.pas

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

  NewPos := FStream.Seek(FBufOfs, soFromBeginning);
  if (NewPos <> FBufOfs) then
    RaiseStError(EStBufStreamError, stscNoSeekForWrite);
  BytesWritten := FStream.Write(FBuffer^, FBufCount);
  if (BytesWritten <> FBufCount) then
    RaiseStError(EStBufStreamError, stscCannotWrite);
  FDirty := false;
end;

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

function TStBufferedStream.Read(var Buffer; Count : longint) : longint;
var
  BytesToGo   : longint;
  BytesToRead : longint;
//  BufAsBytes  : TByteArray absolute Buffer;                          {!!.02}
//  DestPos     : longint;                                             {!!.02}
  BufAsBytes  : PChar;                                                 {!!.02}
begin
  BufAsBytes := @Buffer;                                               {!!.02}

  if (FStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  {calculate the number of bytes we could read if possible}
  BytesToGo := MinLong(Count, FSize - (FBufOfs + FBufPos));
  {we will return this number of bytes or raise an exception}
  Result := BytesToGo;
  {are we going to read some data after all?}
  if (BytesToGo > 0) then begin
    {make sure that the buffer has some data in it}
    if (FBufCount = 0) then
      bsReadFromStream;
    {read as much as we can from the current buffer}
    BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
    {transfer that number of bytes}
//    Move(FBuffer[FBufPos], BufAsBytes[0], BytesToRead);              {!!.02}
    Move(FBuffer[FBufPos], BufAsBytes^, BytesToRead);                  {!!.02}
    {update our counters}
    inc(FBufPos, BytesToRead);
    dec(BytesToGo, BytesToRead);
    {if we have more bytes to read then we've reached the end of the
     buffer and so we need to read another, and another, etc}
//    DestPos := 0;                                                    {!!.02}
    while BytesToGo > 0 do begin
      {if the current buffer is dirty, write it out}
      if FDirty then
        bsWriteToStream;
      {position and read the next buffer}
      FBufPos := 0;
      inc(FBufOfs, FBufSize);
      bsReadFromStream;
      {calculate the new destination position, and the number of bytes
       to read from this buffer}
//      inc(DestPos, BytesToRead);                                     {!!.02}
      Inc(BufAsBytes, BytesToRead);                                    {!!.02}
      BytesToRead := MinLong(BytesToGo, FBufCount - FBufPos);
      {transfer that number of bytes}
//      Move(FBuffer[FBufPos], BufAsBytes[DestPos], BytesToRead);      {!!.02}
      Move(FBuffer[FBufPos], BufAsBytes^, BytesToRead);                {!!.02}

      {update our counters}
      inc(FBufPos, BytesToRead);
      dec(BytesToGo, BytesToRead);
    end;
  end;
end;

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

function TStBufferedStream.Seek(Offset : longint; Origin : word) : longint;
var
  NewPos : longint;
  NewOfs : longint;
begin
  if (FStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  {optimization: to help code that just wants the current stream
   position (ie, reading the Position property), check for this as a
   special case}
  if (Offset = 0) and (Origin = soFromCurrent) then begin
    Result := FBufOfs + FBufPos;
    Exit;
  end;
  {calculate the desired position}
  case Origin of
    soFromBeginning : NewPos := Offset;
    soFromCurrent   : NewPos := (FBufOfs + FBufPos) + Offset;
    soFromEnd       : NewPos := FSize + Offset;
  else
    RaiseStError(EStBufStreamError, stscBadOrigin);
    NewPos := 0; {to fool the compiler's warning--we never get here}
  end;
  {force the new position to be valid}
  if (NewPos < 0) then
    NewPos := 0
  else if (NewPos > FSize) then
    NewPos := FSize;
  {calculate the offset for the buffer}
  NewOfs := (NewPos div FBufSize) * FBufSize;
  {if the offset differs, we have to move the buffer window}
  if (NewOfs <> FBufOfs) then begin
    {check to see whether we have to write the current buffer to the
     original stream first}
    if FDirty then
      bsWriteToStream;
    {mark the buffer as empty}
    FBufOfs := NewOfs;
    FBufCount := 0;
  end;
  {set the position within the buffer}
  FBufPos := NewPos - FBufOfs;
  Result := NewPos;
end;

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

procedure TStBufferedStream.SetSize(NewSize : longint);
var
  NewPos : longint;
begin
  {get rid of the simple case first where the new size and the old
   size are the same}
  if (NewSize = FSize) then
    Exit;
  {if the buffer is dirty, write it out}
  if FDirty then
    bsWriteToStream;
  {now set the size of the underlying stream}
  FStream.Size := NewSize;
  {patch up the buffer fields so that the buffered stream points to
   somewhere in the newly resized stream}
  NewPos := FBufOfs + FBufPos;
  if (NewPos > NewSize) then
    NewPos := NewSize;
  bsInitForNewStream;
  Seek(NewPos, soFromBeginning);
end;

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

function TStBufferedStream.Write(const Buffer; Count : longint) : longint;
var
  BytesToGo   : longint;
  BytesToWrite: longint;
//  BufAsBytes  : TByteArray absolute Buffer;                          {!!.02}
//  DestPos     : longint;                                             {!!.02}
  BufAsBytes  : PChar;                                                 {!!.02}
begin
  BufAsBytes := @Buffer;                                               {!!.02}

  if (FStream = nil) then
    RaiseStError(EStBufStreamError, stscNilStream);
  {calculate the number of bytes we should be able to write}
  BytesToGo := Count;
  {we will return this number of bytes or raise an exception}
  Result := BytesToGo;
  {are we going to write some data?}
  if (BytesToGo > 0) then begin
    {try and make sure that the buffer has some data in it}
    if (FBufCount = 0) then
      bsReadFromStream;
    {write as much as we can to the current buffer}
    BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
    {transfer that number of bytes}
//    Move(BufAsBytes[0], FBuffer[FBufPos], BytesToWrite);             {!!.02}
    Move(BufAsBytes^, FBuffer[FBufPos], BytesToWrite);                 {!!.02}
    FDirty := true;
    {update our counters}
    inc(FBufPos, BytesToWrite);
    if (FBufCount < FBufPos) then begin
      FBufCount := FBufPos;
      FSize := FBufOfs + FBufPos;
    end;
    dec(BytesToGo, BytesToWrite);
    {if we have more bytes to write then we've reached the end of the
     buffer and so we need to write another, and another, etc}
//    DestPos := 0;                                                    {!!.02}
    while BytesToGo > 0 do begin
      {as the current buffer is dirty, write it out}
      bsWriteToStream;
      {position and read the next buffer, if required}
      FBufPos := 0;
      inc(FBufOfs, FBufSize);
      if (FBufOfs < FSize) then
        bsReadFromStream
      else
        FBufCount := 0;
      {calculate the new destination position, and the number of bytes
       to write to this buffer}
//      inc(DestPos, BytesToWrite);                                    {!!.02}
      Inc(BufAsBytes, BytesToWrite);                                   {!!.02}
      BytesToWrite := MinLong(BytesToGo, FBufSize - FBufPos);
      {transfer that number of bytes}
//      Move(BufAsBytes[DestPos], FBuffer[0], BytesToWrite);           {!!.02}
      Move(BufAsBytes^, FBuffer[0], BytesToWrite);                     {!!.02}
      FDirty := true;
      {update our counters}
      inc(FBufPos, BytesToWrite);
      if (FBufCount < FBufPos) then begin
        FBufCount := FBufPos;
        FSize := FBufOfs + FBufPos;
      end;
      dec(BytesToGo, BytesToWrite);
    end;
  end;
end;

{-----------------------------------------------------------------------------}
{                           TStAnsiTextStream                                 }
{-----------------------------------------------------------------------------}

constructor TStAnsiTextStream.Create(aStream : TStream);
begin
  inherited Create(aStream);

  {set up the line index variables}
  atsResetLineIndex;
end;

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

destructor TStAnsiTextStream.Destroy;
begin
  {if needed, free the fixed line buffer}
  if (FFixedLine <> nil) then
    FreeMem(FFixedLine, FixedLineLength);
  {free the line index}
  FLineIndex.Free;
  inherited Destroy;
end;

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

function TStAnsiTextStream.AtEndOfStream : boolean;
begin
  Result := FSize = (FBufOfs + FBufPos);
end;

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

procedure TStAnsiTextStream.atsGetLine(var aStartPos : longint;
                                       var aEndPos   : longint;
                                       var aLen      : longint);
var
  Done   : boolean;
  Ch     : AnsiChar;
  PrevCh : AnsiChar;
begin
  if (LineTerminator = ltNone) then begin
    aStartPos := FBufOfs + FBufPos;
    aEndPos := Seek(aStartPos + FixedLineLength, soFromBeginning);
    aLen := aEndPos - aStartPos;
  end
  else begin
    aStartPos := FBufOfs + FBufPos;
    Ch := #0;
    Done := false;
    while not Done do begin
      PrevCh := Ch;
      if not bsReadChar(Ch) then begin
        Done := true;
        aEndPos := FBufOfs + FBufPos;
        aLen := aEndPos - aStartPos;
      end
      else begin
        case LineTerminator of
          ltNone : {this'll never get hit};
          ltCR   : if (Ch = #13) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     aLen := aEndPos - aStartPos - 1;
                   end;
          ltLF   : if (Ch = #10) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     aLen := aEndPos - aStartPos - 1;
                   end;
          ltCRLF : if (Ch = #10) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     if PrevCh = #13 then
                       aLen := aEndPos - aStartPos - 2
                     else
                       aLen := aEndPos - aStartPos - 1;
                   end;
          ltOther: if (Ch = LineTermChar) then begin
                     Done := true;
                     aEndPos := FBufOfs + FBufPos;
                     aLen := aEndPos - aStartPos - 1;
                   end;
        else
          RaiseStError(EStBufStreamError, stscBadTerminator);
        end;
      end;
    end;
  end;
end;

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

function TStAnsiTextStream.atsGetLineCount : longint;
begin
  if FLineCount < 0 then
    Result := MaxLongInt
  else
    Result := FLineCount;
end;

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

procedure TStAnsiTextStream.atsResetLineIndex;
begin
  {make sure we have a line index}
  if (FLineIndex = nil) then begin
    FLineIndex := TList.Create;  {create the index: even elements are}
    FLineIndex.Count := LineIndexCount * 2; {linenums, odd are offsets}

    {if we didn't have a line index, set up some reasonable defaults}
    FLineTerm := ltCRLF;  {normal Windows text file terminator}
    FLineEndCh := #10;    {not used straight away}
    FLineLen := 80;       {not used straight away}
  end;
  FLineIndex[0] := pointer(0); {the first line is line 0 and...}
  FLineIndex[1] := pointer(0); {...it starts at position 0}
  FLineInxTop := 0;            {the top valid index}
  FLineInxStep := 1;           {step count before add a line to index}
  FLineCount := -1;            {number of lines (-1 = don't know)}
  FLineCurrent := 0;           {current line}
  FLineCurOfs := 0;            {current line offset}
end;

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

procedure TStAnsiTextStream.atsSetLineTerm(aValue : TStLineTerminator);
begin
  if (aValue <> LineTerminator) and ((FBufOfs + FBufPos) = 0) then begin
    {if there was no terminator, free the line buffer}
    if (LineTerminator = ltNone) then begin
      FreeMem(FFixedLine, FixedLineLength);
      FFixedLine := nil;
    end;
    {set the new value}
    FLineTerm := aValue;
    {if there is no terminator now, allocate the line buffer}
    if (LineTerminator = ltNone) then begin
      GetMem(FFixedLine, FixedLineLength);
    end;
    atsResetLineIndex;
  end;
end;

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