stostr.pas

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

var
  AdjPos : Cardinal;
begin
  AdjPos := Pos;
  CheckAlloc(Succ(GetLength));
  if FOneBased then Dec(AdjPos);
  StrChInsertPrimZ(FString, C, AdjPos);
  FixCursor(AdjPos, 1, False);
end;

function TStString.StrChPos(const C : AnsiChar; var Pos : Cardinal) : Boolean;
{- Search string for character. }
var
  I : Cardinal;
begin
  Result := False;
  ClearItems;
  for I := 1 to FRepeatValue do begin
    if StrChPosZ(DesiredCursor, C, Pos) then begin
      Result := True;
      Pos := GetRelativePos(Pos);
      UpdateCursor(Pos);
      if FOneBased then Inc(Pos);
      AddIntToList(Pos);
      Inc(FCursor);
    end else Break;                                                    
  end;
  if Result then Dec(FCursor);                                         
end;


procedure TStString.StripLineTerminators;
{- Strip all line terminators from string, replacing them with a space. }
var
  Terminator : PAnsiChar;
  TermSiz : Integer;
begin
  Terminator := nil;
  if self.FLineTerminator = ltCRLF then begin
    Filter(#13);
    Substitute(#10, ' ');
  end
  else begin
    TermSiz := MakeTerminator(Terminator);
    Substitute(Terminator, ' ');
    FreeMem(Terminator, TermSiz);
  end;
  ResetCursor;
end;


procedure TStString.StrStDelete(const Pos, Length : Cardinal);
{- Delete substring from string at Pos. }
var
  AdjPos : Cardinal;
begin
  AdjPos := Pos;
  if FOneBased then Dec(AdjPos);
  StrStDeletePrimZ(FString, AdjPos, Length);
  FixCursor(AdjPos, Length, True);
end;

procedure TStString.StrStInsert(const S : AnsiString; Pos : Cardinal);
{- Insert string at Pos. }
var
  AdjPos, Len : Cardinal;
  Temp : PAnsiChar;
begin
  AdjPos := Pos;
  Len := System.Length(S);
  Temp := StrAlloc(Succ(Len));
  try
    StrPCopy(Temp, S);
    if FOneBased then Dec(AdjPos);
    CheckAlloc(GetLength + Len);
    StrStInsertPrimZ(FString, Temp, AdjPos);
  finally
    StrDispose(Temp);
  end;
  FixCursor(AdjPos, Len, False);
end;

function TStString.StrStPos(const S : AnsiString; var Pos : Cardinal) : Boolean;
{- Search for substring in string. }
var
  I : Cardinal;
  Temp : PAnsiChar;
begin
  Result := False;
  ClearItems;
  Temp := StrAlloc(Succ(System.Length(S)));
  try
    StrPCopy(Temp, S);
    for I := 1 to FRepeatValue do begin
      if StrStPosZ(DesiredCursor, Temp, Pos) then begin
        Result := True;
        Pos := GetRelativePos(Pos);
        UpdateCursor(Pos);
        if FOneBased then inc(Pos);
        AddIntToList(Pos);
        Inc(FCursor);
      end else Break;                                                  
    end;
    if Result then Dec(FCursor);
  finally
    StrDispose(Temp);
  end;
end;

procedure TStString.Substitute(FromStr, ToStr : PAnsiChar);
{- Substitute characters in string. }
var
  CursorDelta : Cardinal;
begin
  AllocTemp(FAlloc);
  CursorDelta := FCursor - FString;
  if Assigned(FTemp) then begin
    SubstituteZ(FTemp, FString, FromStr, ToStr);
    TempToString;
  end;
  FCursor := FString + CursorDelta;
end;

procedure TStString.Trim;
{- Trim string. }
begin
  TrimPrimZ(FString);
  ResetCursor;
end;

procedure TStString.TrimLead;
{- Trim leading whitespace from string. }
begin
  TrimLeadPrimZ(FString);
  ResetCursor;
end;

procedure TStString.TrimSpaces;
{- Trim spaces from string. }
begin
  TrimSpacesPrimZ(FString);
  ResetCursor;
end;

procedure TStString.TrimTrail;
{- Trim trailing whitespace from string. }
begin
  TrimTrailPrimZ(FString);
  ResetCursor;
end;

function TStString.WordPosition(N : Cardinal; var Pos : Cardinal) : Boolean;
{- Return the position of the N'th word. }
var
  I, Temp, Num : Cardinal;
begin
  Result := False;
  Num := N;
  ClearItems;
  for I := 1 to FRepeatValue do begin
    if WordPositionZ(Num, DesiredCursor, FDelimiters, Temp) then begin
      if Result = False then Inc(Num);
      Pos := GetRelativePos(Temp);
      Result := True;
      UpdateCursor(Pos);
      if FOneBased then Inc(Pos);
      AddIntToList(Pos);
    end else                                                           
      Break;
  end;
  if FResetRepeat then FRepeatValue := DefRepeatValue;
end;


procedure TStString.WrapToItems;
{- Copy string to items with word wrap. }
var
  I, J : Cardinal;
  Anchor, Cur, EndTemp : PAnsiChar;
  InWord, EndFound : Boolean;

  Terminator, TermPlusSpace : PAnsiChar;
  TermSiz : Integer;
begin
  Terminator := nil;
  TermSiz := MakeTerminator(Terminator);
  GetMem(TermPlusSpace, TermSiz + 1);
  StrCopy(TermPlusSpace, Terminator);
  StrCat(TermPlusSpace, ' ');

  if GetLength > FWrap then begin
    EndFound := False;
    AllocTemp(SuggestSize(GetLength + (GetLength div FWrap * 2)));
    FTemp^ := #0;
    Anchor := FString;
    Cur := FString;
    repeat
      I := 0;
      J := 0;
      InWord := False;
      while (Cur^ <> #0) and (I < Succ(FWrap)) do begin
//        if CharExistsZ(' '#13#10, Cur^) then begin
        if CharExistsZ(TermPlusSpace, Cur^) then begin
          if InWord then begin
            InWord := False;
            J := I;
          end;
          if Cur^ <> ' ' then Break;
        end else begin
          InWord := True;
        end;
        Inc(I);
        Inc(Cur);
      end;
      if Cur^ = #0 then begin
        EndFound := True;
        J := I;
      end;
      EndTemp := StrEnd(FTemp);
      if InWord and (J = 0) then
        J := FWrap;
      StrLCopy(EndTemp, Anchor, J);
      if not EndFound then begin
//        StrCat(FTemp, #13#10);
        StrCat(FTemp, Terminator);
        Anchor := Anchor + J;
        while Anchor^ = ' ' do
          Inc(Anchor);
        if FLineTerminator = ltCRLF then begin
          if Anchor^ = #13 then Inc(Anchor);
          if Anchor^ = #10 then Inc(Anchor);
        end else begin
          if Anchor^ = Terminator[0] then Inc(Anchor);
        end;
        Cur := Anchor;
      end;
    until EndFound;
    FItems.SetText(FTemp);
    StrDispose(FTemp);
  end else begin
    StringToItems;
  end;
  FreeMem(Terminator, TermSiz);
  FreeMem(TermPlusSpace, TermSiz + 1);
end;


function TStString.DesiredCursor : PAnsiChar;
{- Returns FString or FCursor. }
begin
  if FEnableCursor then
    Result := FCursor
  else
    Result := FString;
end;

function TStString.Get(Index : Cardinal) : AnsiChar;
{- Get character from position Index within string. }
begin
  if FOneBased then begin
    if (Index = 0) or (Index > GetLength) then
      RaiseStError(EStStringError, stscOutOfBounds);
    Result := FString[Index - 1]
  end else begin
    if Index > (GetLength-1) then
      RaiseStError(EStStringError, stscOutOfBounds);
    Result := FString[Index];
  end;
end;

function TStString.GetAsciiCount : Cardinal;
{- Count words following ASCII rules. }
begin
  Result := AsciiCountZ(FString, FDelimiters, FQuote);
end;

function TStString.GetAsShortStr : ShortString;
{- Provide short string output. }
begin
  Result := StrPas(FString);
end;

function TStString.GetCursorPos : Cardinal;
{- Return the position of the Cursor relative to the beginning of the string. }
begin
  Result := FCursor - FString;
  if FOneBased then Inc(Result);
end;

function TStString.GetDelimiters : AnsiString;
{- Return string with current delimiters. }
begin
  Result := StrPas(FDelimiters);
end;

function TStString.GetLength : Cardinal;
{- Return the length of the string. }
begin
  if Assigned(FString) then
    Result := StrLen(FString)
  else
    Result := 0;
end;

function TStString.GetRelativePos(Pos : Cardinal) : Cardinal;
{- Return position relative to FString. }
begin
  if FEnableCursor then
    Result := Pos + FCursor - FString
  else
    Result := Pos;
end;

function TStString.GetSoundex : AnsiString;
{- Return Soundex for word at Cursor. }
var
  I : Integer;
  Temp, Dest : PAnsiChar;
begin
  ClearItems;
  Dest := StrAlloc(5);
  try
    for I := 1 to FRepeatValue do begin
      if FCursor^ = #0 then Exit;
      Temp := StrAlloc(Succ(SizeWordAtCursor(False)));
      try
        GetWordAtCursorZ(Temp);
        Result := StrPas(SoundexZ(Dest, Temp));
        FItems.Add(Result);
      finally
        StrDispose(Temp);
      end;
      if FRepeatValue > 1 then CursorNextWordPrim;
    end;
  finally
    StrDispose(Dest);
  end;
end;

function TStString.GetWordCount : Cardinal;
{- Count words in string. }
begin
  Result := WordCountZ(FString, FDelimiters);
end;

procedure TStString.Put(Index : Cardinal; Item : AnsiChar);
{- Put character at position Index within string. }
begin
  if FOneBased then begin
    if (Index = 0) or (Index > GetLength) then
      RaiseStError(EStStringError, stscOutOfBounds);
    FString[Index - 1] := Item;
  end else begin
    if Index > (GetLength-1) then
      RaiseStError(EStStringError, stscOutOfBounds);
    FString[Index] := Item;
  end;
end;

procedure TStString.SetAllocLength(Value : Cardinal);
{- Sets allocated length for string - including the terminating null. }
begin
  if Value <> FAlloc then begin
    AllocTemp(SuggestSize(Value));
    if Assigned(FTemp) then begin
      if Assigned(FString) then begin
        StrLCopy(FTemp, FString, Value);
      end;
      TempToString;
    end;
  end;
end;

procedure TStString.SetAsShortStr(Value : ShortString);
{- Copy short string into string object. }
begin
  CheckAlloc(Byte(Value[0]));
  StrPCopy(FString, Value);
  ResetCursor;
end;

procedure TStString.SetCursorPos(Value : Cardinal);
{- Sets the position of the cursor. }
begin
  FCursor := FString + Value;
  if FOneBased then Dec(FCursor);
end;

procedure TStString.SetDelimiters(Value : AnsiString);
{- Set the delimiters. }
begin
  StrDispose(FDelimiters);
  FDelimiters := StrAlloc(Succ(System.Length(Value)));
  if Assigned(FDelimiters) then
    StrPCopy(FDelimiters, Value);
end;

procedure TStString.SetItems(Value: TStringList);
{- Sets Items. }
begin
  FItems.Assign(Value);
end;

procedure TStString.StringToItems;
{- Copies string into items -- respects line terminators. }
begin
  FItems.SetText(FString);
end;

function TStString.SuggestSize(Size : Cardinal) : Cardinal;
{- Internal method -- returns recommended size for allocation. }
var
  AdjSize, Delta : Cardinal;
begin
  AdjSize := Succ(Size);
  Delta := AdjSize mod DefAllocSize;
  Result := AdjSize - Delta + DefAllocSize;
end;

procedure TStString.TempToString;
{- Internal method -- copys temp to string. }
begin
  FAlloc := FTempAlloc;
  FCursor := (FCursor - FString) + FTemp;
  StrDispose(FString);
  FString := FTemp;
  FTemp := nil;
end;

procedure TStString.UpdateCursor(Pos : Cardinal);
{- Internal method -- updates cursor position if necessary. }
begin
  if EnableCursor then
    FCursor := FString + Pos;
end;

function TStString.GetAsLongStr : AnsiString;
{- Provide output as long string. }
begin
  Result := FString;
end;

procedure TStString.SetAsLongStr(Value : AnsiString);
{- Copy long string into string object. }
begin
  CheckAlloc(System.Length(Value));
  StrCopy(FString, PAnsiChar(Value));
  ResetCursor;
end;

function TStString.GetAsVariant : Variant;
{- Provide output as variant. }
begin
  Result := StrPas(FString);
end;

procedure TStString.SetAsVariant(Value : Variant);
{- Copy variant into string object. }
var
  Temp : AnsiString;
begin
  Temp := Value;
  CheckAlloc(System.Length(Temp));
  StrCopy(FString, PAnsiChar(Temp));
  ResetCursor;
end;


procedure TStString.SetLineTerm(const Value: TStLineTerminator);
begin
  FLineTerminator := Value;
end;

procedure TStString.SetLineTermChar(const Value: AnsiChar);
begin
  FLineTermChar := Value;
end;


end.