stostr.pas

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

end;

procedure TStString.CursorNextWord;
{- Moves cursor to the beginning of the next word, or terminating null. }
var
  I : Cardinal;
begin
  for I := 1 to FRepeatValue do begin
    CursorNextWordPrim;
  end;
  if FResetRepeat then FRepeatValue := DefRepeatValue;
end;

procedure TStString.CursorNextWordPrim;
{- Moves cursor to the beginning of the next word, or terminating null. }
var
  Ch : AnsiChar;
begin
  Ch := FCursor^;
  while (Ch <> #0) and (not CharExistsZ(FDelimiters, Ch)) do begin
    Inc(FCursor);
    Ch := FCursor^;    
  end;
  while (Ch <> #0) and (CharExistsZ(FDelimiters, Ch)) do begin
    Inc(FCursor);
    Ch := FCursor^;
  end;
end;

procedure TStString.CursorPrevWord;
{- Move Cursor to beginning of prev word, or first word in string. }
var
  I : Cardinal;
begin
  for I := 1 to FRepeatValue do begin
    CursorPrevWordPrim;
  end;
  if FResetRepeat then FRepeatValue := DefRepeatValue;
end;


procedure TStString.CursorPrevWordPrim;
{- Move Cursor to beginning of prev word, or first word in string. }
var
  Ch : AnsiChar;
  i  : integer;
begin
  Ch := FCursor^;
  {go around twice to get to the previous word, not the current word}
  for i := 1 to 2 do begin
    while (FCursor <> FString) and (CharExistsZ(FDelimiters, Ch)) do begin
      Dec(FCursor);
      Ch := FCursor^;
    end;
    while (FCursor <> FString) and (not CharExistsZ(FDelimiters, Ch)) do begin
      Dec(FCursor);
      Ch := FCursor^;
    end;
  end;
  {now get off the delimiter }
  if (FCursor <> FString) then
    Inc(FCursor);
end;

procedure TStString.CursorToEnd;
{- Set cursor to null terminator at the end of string. }
begin
  FCursor := StrEnd(FString);
end;

procedure TStString.DeleteAsciiAtCursor;
{- Deletes word (and any trailing delimiters) at cursor following ASCII rules. }
var
  I : Cardinal;
begin
  for I := 1 to FRepeatValue do begin
    StrStDeletePrimZ(FCursor, 0, SizeAsciiAtCursor(True));
  end;
  if FResetRepeat then FRepeatValue := DefRepeatValue;
end;

procedure TStString.DeleteAtCursor(Length : Cardinal);
{- Deletes Length number of characters at cursor. }
begin
  StrStDeletePrimZ(FCursor, 0, Length);
end;

procedure TStString.DeleteWordAtCursor;
{- Deletes word (and any trailing delimiters) at cursor. }
var
  I : Cardinal;
begin
  for I := 1 to FRepeatValue do begin
    StrStDeletePrimZ(FCursor, 0, SizeWordAtCursor(True));
  end;
  if FResetRepeat then FRepeatValue := DefRepeatValue;
end;

procedure TStString.Detab;
{- Detabs string. }
begin
  AllocTemp(SuggestSize(FAlloc + (CharCountZ(FString, #9)*FTabSize)));
  if Assigned(FTemp) then begin
    DetabZ(FTemp, FString, FTabSize);
    TempToString;
  end;
  ResetCursor;
end;

procedure TStString.Entab;
{- Entabs string. }
begin
  AllocTemp(FAlloc);
  if Assigned(FTemp) then begin
    EntabZ(FTemp, FString, FTabsize);
    TempToString;
  end;
  ResetCursor;
end;

function TStString.ExtractAscii(N : Cardinal) : AnsiString;
{- Extracts the N'th word in string. }
var
  OldCursor : PAnsiChar;
  Position : Cardinal;
begin
  Result := '';
  OldCursor := FCursor;
  if AsciiPositionZ(N, FString, FDelimiters, FQuote, Position) then
    FCursor := FString + Position
  else Exit;
  Result := GetAsciiAtCursor;
  FCursor := OldCursor;
end;

function TStString.ExtractWord(N : Cardinal) : AnsiString;
{- Extracts the N'th word in string. }
var
  OldCursor : PAnsiChar;
  Position : Cardinal;
begin
  Result := '';
  OldCursor := FCursor;
  if WordPositionZ(N, FString, FDelimiters, Position) then
    FCursor := FString + Position
  else Exit;
  Result := GetWordAtCursor;
  FCursor := OldCursor;
end;

procedure TStString.Filter(const Filters : PAnsiChar);
{- Filters characters from string. }
begin
  AllocTemp(FAlloc);
  FilterZ(FTemp, DesiredCursor, Filters);
  TempToString;
  ResetCursor;
end;

procedure TStString.FixCursor(Pos, Size : Cardinal; Delete : Boolean);
{- Fixes cursor position following an insertion or deletion. }
begin
  if (FCursor - FString) < LongInt(Pos) then                           
    Exit;
  if Delete then begin
    FCursor := FCursor - Size;
    if (FCursor - FString) < LongInt(Pos) then                         
      FCursor := FString + Pos;
  end else begin
    if (FCursor - FString) = LongInt(Pos) then                         
      Exit;
    FCursor := FCursor + Size;
  end;
end;

function TStString.MakeLetterSet : LongInt;
{- Performs MakeLetterSetZ on the word at the Cursor. }
var
  Temp : PAnsiChar;
begin
  Temp := StrAlloc(Succ(SizeWordAtCursor(False)));
  try
    GetWordAtCursorZ(Temp);
    Result := MakeLetterSetZ(Temp);
  finally
    StrDispose(Temp);
  end;
end;

procedure TStString.MoveCursor(Delta : Integer);
{- Moves Cursor by Delta characters. }
begin
  Inc(FCursor, Delta);
  if FCursor < FString then
    FCursor := FString;
  if FCursor > (FString + Succ(GetLength)) then
    CursorToEnd;
end;

function TStString.GetAsciiAtCursor : AnsiString;
{- Gets the word that the Cursor is pointing to -- returns string. }
var
  I, Size : Longint;
begin
  Size := SizeAsciiAtCursor(False);
  SetLength(Result, Size);
  for I := 0 to Pred(Size) do
    Result[Succ(I)] := FCursor[I];
end;

function TStString.GetAsciiAtCursorZ(Dest : PAnsiChar) : PAnsiChar;
{- Gets the word that the Cursor is pointing to -- returns PChar. }
var
  I, Size : Longint;
begin
  Size := SizeAsciiAtCursor(False);
  Result := Dest;
  for I := 0 to Pred(Size) do
    Dest[I] := FCursor[I];
  Dest[Size] := #0;
end;

function TStString.GetAsPChar(Dest : PAnsiChar) : PAnsiChar;
{- Exports string as a null-terminated string. }
begin
  Result := Dest;
  StrCopy(Result, FString);
end;

function TStString.GetWordAtCursor : AnsiString;
{- Gets the word that the Cursor is pointing to -- returns string. }
var
  I, Size : Longint;
begin
  Size := SizeWordAtCursor(False);
  SetLength(Result, Size);
  for I := 0 to Pred(Size) do
    Result[Succ(I)] := FCursor[I];
end;

function TStString.GetWordAtCursorZ(Dest : PAnsiChar) : PAnsiChar;
{- Gets the word that the Cursor is pointing to -- returns PChar. }
var
  I, Size : Longint;
begin
  Size := SizeWordAtCursor(False);
  Result := Dest;
  for I := 0 to Pred(Size) do
    Dest[I] := FCursor[I];
  Dest[Size] := #0;
end;

procedure TStString.Pack;
{- Sets string allocation to minimum size. }
var
  StrLen : Cardinal;
begin
  StrLen := GetLength;
  if SuggestSize(StrLen) < FAlloc then
    SetAllocLength(StrLen);
end;

procedure TStString.Pad(Size : Cardinal);
{- Pads string. }
begin
  CheckAlloc(Size);
  PadPrimZ(FString, Size);
  ResetCursor;
end;


function TStString.MakeTerminator(var Terminator : PAnsiChar) : Integer; {!!.01}
begin
  Result := 0;
  case self.LineTerminator of
     ltNone :;
     ltCR, ltLF, ltOther :begin
       Result := 2;
       GetMem(Terminator, Result);
       case LineTerminator of
         ltCR    : StrCopy(Terminator, #13);
         ltLF    : StrCopy(Terminator, #10);
         ltOther : begin
           Terminator[0] := FLineTermChar;
           Terminator[1] := #0;
         end;
       end;
     end;
     ltCRLF : begin
       Result := 3;
       GetMem(Terminator, Result);
       StrCopy(Terminator, #13#10);
     end;
  end;
end;

procedure TStString.InsertLineTerminatorAtCursor;
{- Inserts line termintor at cursor position. }
var
  Pos : Cardinal;
  Terminator : PAnsiChar;
  TermSiz : Integer;
begin
  Terminator := nil;
  TermSiz := MakeTerminator(Terminator);
  CheckAlloc(GetLength + 2);
  Pos := FCursor - FString;
  StrStInsertPrimZ(FString, Terminator, Pos);
  FreeMem(Terminator, TermSiz);
end;

procedure TStString.InsertLineTerminator(Pos : Cardinal);
{- Inserts line terminator at given position. }
var
  AdjPos : Cardinal;
  Terminator : PAnsiChar;
  TermSiz : Integer;
begin
  Terminator := nil;
  TermSiz := MakeTerminator(Terminator);
  CheckAlloc(GetLength + 2);
  AdjPos := Pos;
  if FOneBased then Dec(AdjPos);
  StrStInsertPrimZ(FString, Terminator, AdjPos);
  FreeMem(Terminator, TermSiz);
end;


procedure TStString.InsertPCharAtCursor(S : PAnsiChar);
{- Inserts null-terminated string at cursor position. }
var
  Len, Pos : Cardinal;
begin
  Len := StrLen(S);
  Pos := FCursor - FString;
  CheckAlloc(GetLength + Len);
  StrStInsertPrimZ(FString, S, Pos);
end;

procedure TStString.InsertStringAtCursor(S : AnsiString);
{- Inserts string at cursor position. }
var
  Pos, Len : Cardinal;
  Temp : PAnsiChar;
begin
  Pos := FCursor - FString;
  Len := System.Length(S);
  Temp := StrAlloc(Succ(Len));
  try
    StrPCopy(Temp, S);
    CheckAlloc(GetLength + Len);
    StrStInsertPrimZ(FString, Temp, Pos);
  finally
    StrDispose(Temp);
  end;
end;

procedure TStString.ItemsToString;
{- Copies items strings to string. }
var                                                                    
  Temp : PAnsiChar;                                                    
begin
  Temp := FItems.GetText;                                              
  try                                                                  
    SetAsPChar(Temp);                                                  
  finally                                                              
    StrDispose(Temp);                                                  
  end;                                                                 
end;

procedure TStString.LeftPad(Size : Cardinal);
{- Left pad string. }
begin
  CheckAlloc(Size);
  LeftPadPrimZ(FString, Size);
  ResetCursor;
end;

procedure TStString.LeftPadCh(const C : AnsiChar; Size : Cardinal);
{- Left pad string with C. }
begin
  CheckAlloc(Size);
  LeftPadChPrimZ(FString, C, Size);
  ResetCursor;
end;

procedure TStString.PadCh(const C : AnsiChar; Size : Cardinal);
{- Pad string with C. }
begin
  CheckAlloc(Size);
  PadChPrimZ(FString, C, Size);
  ResetCursor;
end;

procedure TStString.ResetCursor;
{- Resets Cursor to beginning of string. }
begin
  FCursor := FString;
end;

procedure TStString.Scramble(const Key : AnsiString);
{- Encrypts / Decrypts string. }
var
  Temp : PAnsiChar;
begin
  Temp := StrAlloc(Succ(System.Length(Key)));
  try
    StrPCopy(Temp, Key);
    ScramblePrimZ(FString, Temp);
  finally
    StrDispose(Temp);
  end;
end;

procedure TStString.SetAsPChar(S : PAnsiChar);
{- Sets string to PChar. }
begin
  CheckAlloc(StrLen(S));
  StrCopy(FString, S);
  ResetCursor;
end;

function TStString.SizeAsciiAtCursor(InclTrailers : Boolean) : Cardinal;
{- Get the size of the word that the Cursor on (follows ASCII rules). }
var
  TempPtr : PAnsiChar;
  Ch : AnsiChar;
  InQuote : Boolean;
begin
  InQuote := False;
  TempPtr := FCursor;
  Ch := TempPtr^;
  while (Ch <> #0) and ((InQuote) or (not CharExistsZ(FDelimiters, Ch))) do begin
    if Ch = FQuote then
      InQuote := not InQuote;
    Inc(TempPtr);
    Ch := TempPtr^;
  end;
  if InclTrailers then begin
    while (Ch <> #0) and CharExistsZ(FDelimiters, Ch) do begin
      Inc(TempPtr);
      Ch := TempPtr^;
    end;
  end;
  Result := TempPtr - FCursor;
end;

function TStString.SizeWordAtCursor(InclTrailers : Boolean) : Cardinal;
{- Get the size of the word that the Cursor is pointing to. }
var
  TempPtr : PAnsiChar;
  Ch : AnsiChar;
begin
  TempPtr := FCursor;
  Ch := TempPtr^;
  while (Ch <> #0) and (not CharExistsZ(FDelimiters, Ch)) do begin
    Inc(TempPtr);
    Ch := TempPtr^;
  end;
  if InclTrailers then begin
    while (Ch <> #0) and CharExistsZ(FDelimiters, Ch) do begin
      Inc(TempPtr);
      Ch := TempPtr^;
    end;
  end;
  Result := TempPtr - FCursor;
end;

procedure TStString.StrChDelete(Pos : Cardinal);
{- Delete character at Pos. }
var
  AdjPos : Cardinal;
begin
  AdjPos := Pos;
  if FOneBased then Dec(AdjPos);
  StrChDeletePrimZ(FString, AdjPos);
  FixCursor(AdjPos, 1, True);
end;

procedure TStString.StrChInsert(const C : AnsiChar; Pos : Cardinal);
{- Insert character at Pos. }