stostr.pas

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

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower SysTools
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1996-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{* SysTools: StOStr.pas 4.03                             *}
{*********************************************************}
{* SysTools: String class                                *}
{*********************************************************}

{$I StDefine.inc}

unit StOStr;

interface

uses
  Windows, SysUtils, Classes,
  StConst, StBase, StStrZ;

const
{.Z+}
  DefAllocSize = 8;
  DefDelimiters = ' ';
  DefQuote = '''';
  DefRepeatValue = 1;
  DefResetRepeat = True;
  DefTabSize = 8;
  DefWrap = 80;
{.Z-}

type

  TStString = class(TPersistent)
  private
{.Z+}
  protected {private}
    FAlloc : Cardinal;
    FBM : BTable;
    FBMString : PAnsiChar;
    FCursor : PAnsiChar;
    FDelimiters : PAnsiChar;
    FEnableCursor : Boolean;
    FItems : TStringList;
    FOneBased : Boolean;
    FRepeatValue : Cardinal;
    FResetRepeat : Boolean;
    FQuote : AnsiChar;
    FString : PAnsiChar;
    FTabSize : Byte;
    FTemp : PAnsiChar;
    FTempAlloc : Cardinal;
    FWrap : Cardinal;
    FLineTermChar: AnsiChar;
    FLineTerminator: TStLineTerminator;
  protected
    procedure SetLineTerm(const Value: TStLineTerminator);
    procedure SetLineTermChar(const Value: AnsiChar);
    procedure AddIntToList(Num : LongInt);
    procedure AllocTemp(Size : Cardinal);
    procedure BMMakeTable(S : PAnsiChar);
    procedure CheckAlloc(Size : Cardinal);
    function  DesiredCursor : PAnsiChar;
    procedure FixCursor(Pos, Size : Cardinal; Delete : Boolean);
    function  Get(Index : Cardinal) : AnsiChar;
    function  GetAsciiCount : Cardinal;
    function  GetAsShortStr : ShortString;
    function  GetCursorPos : Cardinal;
    function  GetDelimiters : AnsiString;
    function  GetLength : Cardinal;
    function  GetRelativePos(Pos : Cardinal) : Cardinal;
    function  GetSoundex : AnsiString;
    function  GetWordCount : Cardinal;
    procedure Put(Index : Cardinal; Item : AnsiChar);
    procedure SetAllocLength(Value : Cardinal);
    procedure SetAsShortStr(Value : ShortString);
    procedure SetCursorPos(Value : Cardinal);
    procedure SetDelimiters(Value : AnsiString);
    procedure SetItems(Value : TStringList);
    function  SuggestSize(Size : Cardinal) : Cardinal;
    procedure TempToString;
    procedure UpdateCursor(Pos : Cardinal);
    function  GetAsLongStr : AnsiString;
    procedure SetAsLongStr(Value : AnsiString);
    function  GetAsVariant : Variant;
    procedure SetAsVariant(Value : Variant);
    function MakeTerminator(var Terminator : PAnsiChar) : Integer;       {!!.01}

{.Z-}
  public
    constructor Create;
    constructor CreateAlloc(Size : Cardinal); virtual;
    constructor CreateS(const S : AnsiString); virtual;
    constructor CreateZ(const S : PAnsiChar); virtual;
    constructor CreateV(const S : Variant); virtual;
    destructor Destroy; override;
    procedure AppendPChar(S : PAnsiChar);
    procedure AppendString(S : AnsiString);
    function  AsciiPosition(N : Cardinal; var Pos : Cardinal) : Boolean;
    function  BMSearch(const S : AnsiString; var Pos : Cardinal) : Boolean;
    function  BMSearchUC(const S : AnsiString; var Pos : Cardinal) : Boolean;
    procedure Center(Size : Cardinal);
    procedure CenterCh(const C : AnsiChar; Size : Cardinal);
    function  CharCount(const C : AnsiChar) : Cardinal;
    function  CharExists(const C : AnsiChar) : boolean;
    procedure CharStr(const C : AnsiChar; Size : Cardinal);
    procedure ClearItems;
    procedure CursorNextWord;
    procedure CursorNextWordPrim;
    procedure CursorPrevWord;
    procedure CursorPrevWordPrim;
    procedure CursorToEnd;
    procedure DeleteAsciiAtCursor;
    procedure DeleteAtCursor(Length : Cardinal);
    procedure DeleteWordAtCursor;
    procedure Detab;
    procedure Entab;
    function  ExtractAscii(N : Cardinal) : AnsiString;
    function  ExtractWord(N : Cardinal) : AnsiString;
    procedure Filter(const Filters : PAnsiChar);
    function  GetAsciiAtCursor : AnsiString;
    function  GetAsciiAtCursorZ(Dest : PAnsiChar) : PAnsiChar;
    function  GetAsPChar(Dest : PAnsiChar) : PAnsiChar;
    function  GetWordAtCursor : AnsiString;
    function  GetWordAtCursorZ(Dest : PAnsiChar) : PAnsiChar;
    procedure InsertLineTerminatorAtCursor;
    procedure InsertLineTerminator(Pos : Cardinal);
    procedure InsertPCharAtCursor(S : PAnsiChar);
    procedure InsertStringAtCursor(S : AnsiString);
    procedure ItemsToString;
    procedure LeftPad(Size : Cardinal);
    procedure LeftPadCh(const C : AnsiChar; Size : Cardinal);
    function  MakeLetterSet : LongInt;
    procedure MoveCursor(Delta : Integer);
    procedure Pack;
    procedure Pad(Size : Cardinal);
    procedure PadCh(const C : AnsiChar; Size : Cardinal);
    procedure ResetCursor;
    procedure Scramble(const Key : AnsiString);
    procedure SetAsPChar(S : PAnsiChar);
    function  SizeAsciiAtCursor(InclTrailers : Boolean) : Cardinal;
    function  SizeWordAtCursor(InclTrailers : Boolean) : Cardinal;
    procedure StrChDelete(Pos : Cardinal);
    procedure StrChInsert(const C : AnsiChar; Pos : Cardinal);
    function  StrChPos(const C : AnsiChar; var Pos : Cardinal) : Boolean;
    procedure StringToItems;
    procedure StripLineTerminators;
    procedure StrStDelete(const Pos, Length : Cardinal);
    procedure StrStInsert(const S : AnsiString; Pos : Cardinal);
    function  StrStPos(const S : AnsiString; var Pos : Cardinal) : Boolean;
    procedure Substitute(FromStr, ToStr : PAnsiChar);
    procedure Trim;
    procedure TrimLead;
    procedure TrimSpaces;
    procedure TrimTrail;
    function  WordPosition(N : Cardinal; var Pos : Cardinal) : Boolean;
    procedure WrapToItems;

    property AllocLength : Cardinal
      read FAlloc write SetAllocLength;
    property AsciiCount : Cardinal
      read GetAsciiCount;
    property AsLongStr : AnsiString
      read GetAsLongStr write SetAsLongStr;
    property AsVariant : Variant
      read GetAsVariant write SetAsVariant;
    property AsShortStr : ShortString
      read GetAsShortStr write SetAsShortStr;
    property AtIndex[Index: Cardinal]: AnsiChar
      read Get write Put; default;
    property CursorPos : Cardinal
      read GetCursorPos write SetCursorPos;
    property Delimiters : AnsiString
      read GetDelimiters write SetDelimiters;
    property EnableCursor : Boolean
      read FEnableCursor write FEnableCursor;
    property Length : Cardinal
      read GetLength;
    property LineTermChar : AnsiChar
      read FLineTermChar write SetLineTermChar default #10;
    property LineTerminator : TStLineTerminator
      read FLineTerminator write SetLineTerm default ltCRLF;
    property Items : TStringList
      read FItems write SetItems;
    property OneBased : Boolean
      read FOneBased write FOneBased;
    property RepeatValue : Cardinal
      read FRepeatValue write FRepeatValue;
    property ResetRepeat : Boolean
      read FResetRepeat write FResetRepeat;
    property Soundex : AnsiString
      read GetSoundex;
    property Quote : AnsiChar
      read FQuote write FQuote;
    property TabSize : Byte
      read FTabSize write FTabSize;
    property WordCount : Cardinal
      read GetWordCount;
    property WrapColumn : Cardinal
      read FWrap write FWrap;
  end;

implementation

constructor TStString.Create;
{- Create nil string object. }
begin
  inherited Create;
  SetDelimiters(DefDelimiters);
  FItems := TStringList.Create;
  FTabSize := DefTabSize;
  FQuote := DefQuote;
  FRepeatValue := DefRepeatValue;
  FResetRepeat := DefResetRepeat;
  FWrap := DefWrap;

  FLineTerminator := ltCRLF;
  FLineTermChar   := #10;


end;

constructor TStString.CreateAlloc(Size : Cardinal);
{- Create string object allocated to given size. }
var
  AllocSize : Cardinal;
begin
  Create;
  AllocSize := SuggestSize(Size);
  FString := StrAlloc(AllocSize);
  FString[0] := #0;
  FAlloc := AllocSize;
  ResetCursor;
end;

constructor TStString.CreateV(const S : Variant);
{- Create string object and copy variant into it. }
var
  Len : Cardinal;
  Temp : AnsiString;
begin
  Create;
  Temp := S;
  Len := System.Length(Temp);
  FString := StrAlloc(SuggestSize(Len));
  if Assigned(FString) then begin
    FAlloc := SuggestSize(Len);
    StrCopy(FString, PAnsiChar(Temp));
  end;
  ResetCursor;
end;

constructor TStString.CreateS(const S : AnsiString);
{- Create string object and copy string into it. }
begin
  Create;
  FString := StrAlloc(SuggestSize(System.Length(S)));
  if Assigned(FString) then begin
    FAlloc := SuggestSize(System.Length(S));
    StrPCopy(FString, S);
  end;
  ResetCursor;
end;

constructor TStString.CreateZ(const S : PAnsiChar);
{- Create string object and copy PChar into it. }
begin
  Create;
  FString := StrAlloc(SuggestSize(StrLen(S)));
  if Assigned(FString) then begin
    StrCopy(FString, S);
    FAlloc := SuggestSize(StrLen(S));
  end;
  ResetCursor;
end;

destructor TStString.Destroy;
{- Dispose string object. }
begin
  FItems.Free;
  StrDispose(FBMString);
  StrDispose(FDelimiters);
  StrDispose(FString);
  inherited Destroy;
end;

procedure TStString.AppendPChar(S : PAnsiChar);
{- Appends PChar to end of string. }
var
  Temp : PAnsiChar;
begin
  CheckAlloc(StrLen(S) + GetLength);
  Temp := StrEnd(FString);
  StrCopy(Temp, S);
end;

procedure TStString.AppendString(S : AnsiString);
{- Appends string to end of string. }
var
  Temp : PAnsiChar;
begin
  CheckAlloc(System.Length(S) + LongInt(GetLength));                   
  Temp := StrEnd(FString);
  StrPCopy(Temp, S);
end;

function TStString.AsciiPosition(N : Cardinal; var Pos : Cardinal) : Boolean;
{- Returns the Pos of the Nth word using ASCII rules. }
var
  I, Num : Cardinal;
begin
  Result := False;
  Num := N;
  ClearItems;
  for I := 1 to FRepeatValue do begin
    if AsciiPositionZ(Num, DesiredCursor, FDelimiters, FQuote, Pos) then begin
      if Result = False then Inc(Num);
      Pos := GetRelativePos(Pos);
      Result := True;
      UpdateCursor(Pos);
      if FOneBased then Inc(Pos);
      AddIntToList(Pos);
    end
      else Break;                                                      
  end;
  if FResetRepeat then FRepeatValue := DefRepeatValue;
end;

function TStString.BMSearch(const S : AnsiString; var Pos : Cardinal) : Boolean;
{- Performs case sensitive BM search on string. }
var
  I : Cardinal;
  Temp : PAnsiChar;
begin
  Result := False;
  ClearItems;
  Temp := StrAlloc(Succ(System.Length(S)));
  try
    StrPCopy(Temp, S);
    BMMakeTable(Temp);
    for I := 1 to FRepeatValue do begin
      if BMSearchZ(DesiredCursor^, StrLen(DesiredCursor), FBM, 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;

function TStString.BMSearchUC(const S : AnsiString; var Pos : Cardinal) : Boolean;
{- Performs case insensitive BM search on string. }
var
  I : Cardinal;
  Temp : PAnsiChar;
begin
  Result := False;
  ClearItems;
  Temp := StrAlloc(Succ(System.Length(S)));
  try
    StrPCopy(Temp, S);
    StrUpper(Temp);
    BMMakeTable(Temp);
    for I := 1 to FRepeatValue do begin
      if BMSearchUCZ(DesiredCursor^, StrLen(DesiredCursor), FBM, 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.Center(Size : Cardinal);
{- Centers string to Size. }
begin
  CheckAlloc(Size);
  CenterPrimZ(FString, Size);
  ResetCursor;
end;

procedure TStString.CenterCh(const C : AnsiChar; Size : Cardinal);
{- Centers string with 'Ch' to Size. }
begin
  CheckAlloc(Size);
  CenterChPrimZ(FString, C, Size);
  ResetCursor;
end;

function TStString.CharExists(const C : AnsiChar) : boolean;
{- Determines whether C exists in string. }
begin
  Result := CharExistsZ(DesiredCursor, C);
end;

function TStString.CharCount(const C : AnsiChar) : Cardinal;
{- Counts C in string. }
begin
  Result := CharCountZ(DesiredCursor, C);
end;

procedure TStString.CharStr(const C : AnsiChar; Size : Cardinal);
{- Fills string to Size with C. }
begin
  CheckAlloc(Size);
  FString := CharStrZ(FString, C, Size);
  ResetCursor;
end;

procedure TStString.AddIntToList(Num : LongInt);
{- Adds integer value to Items -- as both numeric value and numeric string. }
begin
  FItems.AddObject(IntToStr(Num), TObject(Num));
end;

procedure TStString.AllocTemp(Size : Cardinal);
{- Allocates FTemp to Size. }
begin
  FTemp := StrAlloc(Size);
  FTempAlloc := Size;
end;

procedure TStString.BMMakeTable(S : PAnsiChar);
{- Checks whether table needs to be made -- and makes it. }
begin
  if Assigned(FBMString) then
    if StrComp(S, FBMString) = 0 then Exit;
  StrDispose(FBMString);
  FBMString := StrNew(S);
  BMMakeTableZ(FBMString, FBM);
end;

procedure TStString.CheckAlloc(Size : Cardinal);
{- Sets allocated length for string if needed size is > current size. }
begin
  if FAlloc = 0 then begin
    FString := StrAlloc(SuggestSize(Size));
    FAlloc := SuggestSize(Size);
    FString[0] := #0;
    ResetCursor;
  end else if Succ(Size) > FAlloc then
    SetAllocLength(Succ(Size));
end;

procedure TStString.ClearItems;
{- Clears Items list. }
begin
  FItems.Clear;