ststrw.pas

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

    for I := 1 to Length(Result) do begin
      if StrChPosW(FromStr, S[I], P) then
        Result[I] := ToStr[P];
    end;
end;

function FilterW(const S, Filters : WideString) : WideString;
  {-Remove characters from a string. The characters to remove are specified in
    ChSet.}
var
  I : Cardinal;
  Len : Cardinal;
begin
  Len := 0;
  SetLength(Result, Length(S));
  for I := 1 to Length(S) do
    if not CharExistsW(Filters, S[I]) then begin
      Inc(Len);
      Result[Len] := S[I];
    end;
  SetLength(Result, Len);
end;

  {--------------- Word / Char manipulation -------------------------}

function CharExistsW(const S : WideString; C : WideChar) : Boolean;
  {-see if character exists at least once in a string}
var
  i : integer;
begin
  Result := true;
  for i := 1 to length(S) do
    if (S[i] = C) then
      Exit;
  Result := false;
end;

function CharCountW(const S : WideString; C : WideChar) : Cardinal;
  {-Count the number of a given character in a string. }
var
  i : integer;
begin
  Result := 0;
  for i := 1 to length(S) do
    if (S[i] = C) then
      inc(Result);
end;

function WordCountW(const S, WordDelims : WideString) : Cardinal;
  {-Given an array of word delimiters, return the number of words in a string.}
var
  I    : Cardinal;
  SLen : Cardinal;
begin
  Result := 0;
  I := 1;
  SLen := Length(S);

  while I <= SLen do begin
    {skip over delimiters}
    while (I <= SLen) and CharExistsW(WordDelims, S[I]) do
      Inc(I);

    {if we're not beyond end of S, we're at the start of a word}
    if I <= SLen then
      Inc(Result);

    {find the end of the current word}
    while (I <= SLen) and not CharExistsW(WordDelims, S[I]) do
      Inc(I);
  end;
end;

function WordPositionW(N : Cardinal; const S, WordDelims : WideString;
                       var Pos : Cardinal) : Boolean;
  {-Given an array of word delimiters, set Pos to the start position of the
    N'th word in a string.  Result indicates success/failure.}
var
  Count : Longint;
  I     : Longint;
begin
  Count := 0;
  I := 1;
  Result := False;

  while (I <= Length(S)) and (Count <> LongInt(N)) do begin
    {skip over delimiters}
    while (I <= Length(S)) and CharExistsW(WordDelims, S[I]) do
      Inc(I);

    {if we're not beyond end of S, we're at the start of a word}
    if I <= Length(S) then
      Inc(Count);

    {if not finished, find the end of the current word}
    if Count <> LongInt(N) then
      while (I <= Length(S)) and not CharExistsW(WordDelims, S[I]) do
        Inc(I)
    else begin
      Pos := I;
      Result := True;
    end;
  end;
end;

function ExtractWordW(N : Cardinal; const S, WordDelims : WideString) : WideString;
  {-Given an array of word delimiters, return the N'th word in a string.}
var
  C   : Cardinal;
  I,
  J   : Longint;
begin
  Result := '';
  if WordPositionW(N, S, WordDelims, C) then begin
    I := C;
    {find the end of the current word}
    J := I;
    while (I <= Length(S)) and not
           CharExistsW(WordDelims, S[I]) do
      Inc(I);
    SetLength(Result, I-J);
    Move(S[J], Result[1], (I-J) * SizeOf(WideChar));
  end;
end;

function AsciiCountW(const S, WordDelims : WideString; Quote : WideChar) : Cardinal;
  {-Return the number of words in a string.}
var
  I       : Longint;
  InQuote : Boolean;
begin
  Result := 0;
  I := 1;
  InQuote := False;
  while I <= Length(S) do begin
    {skip over delimiters}
    while (I <= Length(S)) and (S[I] <> Quote)
      and CharExistsW(WordDelims, S[I]) do
      Inc(I);
    {if we're not beyond end of S, we're at the start of a word}
    if I <= Length(S) then
      Inc(Result);
    {find the end of the current word}
    while (I <= Length(S)) and
          (InQuote or not CharExistsW(WordDelims, S[I])) do begin
      if S[I] = Quote then
        InQuote := not InQuote;
      Inc(I);
    end;
  end;
end;

function AsciiPositionW(N : Cardinal; const S, WordDelims : WideString;
                        Quote : WideChar; var Pos : Cardinal) : Boolean;
  {-Return the position of the N'th word in a string.}
var
  I,
  Count    : Longint;
  InQuote  : Boolean;
begin
  Count := 0;
  InQuote := False;
  Result := False;
  I := 1;
  while (I <= Length(S)) and (Count <> LongInt(N)) do begin
    {skip over delimiters}
    while (I <= Length(S)) and (S[I] <> Quote) and
          CharExistsW(WordDelims, S[I]) do
      Inc(I);
    {if we're not beyond end of S, we're at the start of a word}
    if I <= Length(S) then
      Inc(Count);
    {if not finished, find the end of the current word}
    if Count <> LongInt(N) then
      while (I <= Length(S)) and
            (InQuote or not CharExistsW(WordDelims, S[I])) do begin
        if S[I] = Quote then
          InQuote := not InQuote;
        Inc(I);
      end
    else begin
      Pos := I;
      Result := True;
    end;
  end;
end;

function ExtractAsciiW(N : Cardinal; const S, WordDelims : WideString;
                       Quote : WideChar) : WideString;
  {-Given an array of word delimiters, return the N'th word in a string. Any
    text within Quote characters is counted as one word.}
var
  C       : Cardinal;
  I, J    : Longint;
  InQuote : Boolean;
begin
  InQuote := False;
  if AsciiPositionW(N, S, WordDelims, Quote, C) then begin
    I := C;
    J := I;
    {find the end of the current word}
    while (I <= Length(S)) and ((InQuote)
      or not CharExistsW(WordDelims, S[I])) do begin
      if S[I] = Quote then
        InQuote := not(InQuote);
      Inc(I);
    end;
    SetLength(Result, I-J);
    Move(S[J], Result[1], (I-J) * SizeOf(WideChar));
  end;
end;

procedure WordWrapW(const InSt : WideString; var OutSt, Overlap : WideString;
                   Margin : Cardinal; PadToMargin : Boolean);
  {-Wrap a text string at a specified margin.}
var
  InStLen  : Cardinal;
  EOS,
  BOS      : Cardinal;
  ASpace   : WideChar;
begin
  InStLen := Length(InSt);

{!!.02 - Added }
  { handle empty string on input }         
  if InStLen = 0 then begin                
    OutSt := '';                           
    Overlap := '';                         
    Exit;                                  
  end;                                     
{!!.02 - Added }

  {find the end of the output string}
  if InStLen > Margin then begin
    {find the end of the word at the margin, if any}
    EOS := Margin;
    while (EOS <= InStLen) and (InSt[EOS] <> ' ') do
      Inc(EOS);
    if EOS > InStLen then
      EOS := InStLen;

    {trim trailing blanks}
    while (InSt[EOS] = ' ') and (EOS > 0) do
      Dec(EOS);

    if EOS > Margin then begin
      {look for the space before the current word}
      while (EOS > 0) and (InSt[EOS] <> ' ') do
        Dec(EOS);

      {if EOS = 0 then we can't wrap it}
      if EOS = 0 then
        EOS := Margin
      else
        {trim trailing blanks}
        while (InSt[EOS] = ' ') and (EOS > 0) do
          Dec(EOS);
    end;
  end else
    EOS := InStLen;

  {copy the unwrapped portion of the line}
  SetLength(OutSt, EOS);
  Move(InSt[1], OutSt[1], Length(OutSt) * SizeOf(WideChar));

  {find the start of the next word in the line}
  BOS := Succ(EOS);
  while (BOS <= InStLen) and (InSt[BOS] = ' ') do
    Inc(BOS);

  if BOS > InStLen then
    SetLength(OverLap, 0)
  else begin
    {copy from the start of the next word to the end of the line}

    SetLength(OverLap, InStLen);
    Move(InSt[BOS], Overlap[1], Succ(InStLen-BOS) * SizeOf(WideChar));
    SetLength(OverLap, Succ(InStLen-BOS));
  end;

  {pad the end of the output string if requested}
  if PadToMargin and (Length(OutSt) < LongInt(Margin)) then begin
    SetLength(OutSt, Margin);
    ASpace := ' ';
    StUtils.FillWord(OutSt[Succ(Length(OutSt))],
                     LongInt(Margin)-Length(OutSt), Word(ASpace));
  end;
end;

  {--------------- String comparison and searching -----------------}

function CompStringW(const S1, S2 : WideString) : Integer;
  {-Compare two strings.}
begin
  Result := CompareStr(S1, S2);
end;

function CompUCStringW(const S1, S2 : WideString) : Integer;
  {-Compare two strings. This compare is not case sensitive.}
begin
  Result := CompareText(S1, S2);
end;

  {--------------- DOS pathname parsing -----------------}

function DefaultExtensionW(const Name, Ext : WideString) : WideString;
  {-Return a file name with a default extension attached.}
var
  DotPos : Cardinal;
begin
  if HasExtensionW(Name, DotPos) then
    Result := Name
  else if Name = '' then
    Result := ''
  else
    Result := Name + '.' + Ext;
end;

function ForceExtensionW(const Name, Ext : WideString) : WideString;
  {-Force the specified extension onto the file name.}
var
  DotPos : Cardinal;
begin
  if HasExtensionW(Name, DotPos) then
    Result := System.Copy(Name, 1, DotPos) + Ext
  else if Name = '' then
    Result := ''
  else
    Result := Name + '.' + Ext;
end;

function JustFilenameW(const PathName : WideString) : WideString;
  {-Return just the filename and extension of a pathname.}
var
  I : Cardinal;
begin
  Result := '';
  if PathName = '' then Exit;
  I := Succ(Word(Length(PathName)));
  repeat
    Dec(I);
  until (I = 0) or (pos(PathName[I], DosDelimSetW) > 0)                  {!!.01}
    or (PathName[I] = #0);                                               {!!.01}
  Result := System.Copy(PathName, Succ(I), StMaxFileLen);
end;

function JustNameW(const PathName : WideString) : WideString;
  {-Return just the filename (no extension, path, or drive) of a pathname.}
var
  DotPos : Cardinal;
  S      : WideString;
begin
  S := JustFileNameW(PathName);
  if HasExtensionW(S, DotPos) then
    S := System.Copy(S, 1, DotPos-1);
  Result := S;
end;

function JustExtensionW(const Name : WideString) : WideString;
  {-Return just the extension of a pathname.}
var
  DotPos : Cardinal;
begin
  if HasExtensionW(Name, DotPos) then
    Result := System.Copy(Name, Succ(DotPos), StMaxFileLen)
  else
    Result := '';
end;

function JustPathnameW(const PathName : WideString) : WideString;
  {-Return just the drive and directory portion of a pathname.}
var
  I : Cardinal;
begin
  if PathName = '' then Exit;

  I := Succ(Word(Length(PathName)));
  repeat
    Dec(I);
  until (I = 0) or (pos(PathName[I], DosDelimSetW) > 0)                  {!!.01}
    or (PathName[I] = #0);                                               {!!.01}

  if I = 0 then
    {Had no drive or directory name}
    SetLength(Result, 0)
  else if I = 1 then
    {Either the root directory of default drive or invalid pathname}
    Result := PathName[1]
  else if (PathName[I] = '\') then begin
    if PathName[Pred(I)] = ':' then
      {Root directory of a drive, leave trailing backslash}
      Result := System.Copy(PathName, 1, I)
    else
      {Subdirectory, remove the trailing backslash}
      Result := System.Copy(PathName, 1, Pred(I));
  end else
    {Either the default directory of a drive or invalid pathname}
    Result := System.Copy(PathName, 1, I);
end;


function AddBackSlashW(const DirName : WideString) : WideString;
  {-Add a default backslash to a directory name}
begin
  Result := DirName;
  if (Length(Result) = 0) then
    Exit;
  if ((Length(Result) = 2) and (Result[2] = ':')) or
     ((Length(Result) > 2) and (Result[Length(Result)] <> '\')) then
    Result := Result + '\';
end;

function CleanFileNameW(const FileName : WideString) : WideString;
  {-Return filename with at most 8 chars of name and 3 of extension}
var
  DotPos : Cardinal;
  NameLen : Word;
begin
  if HasExtensionW(FileName, DotPos) then begin
    {Take the first 8 chars of name and first 3 chars of extension}
    NameLen := Pred(DotPos);
    if NameLen > 8 then
      NameLen := 8;
    Result := System.Copy(FileName, 1, NameLen)+System.Copy(FileName, DotPos, 4);
  end else
    {Take the first 8 chars of name}
    Result := System.Copy(FileName, 1, 8);
end;

function CleanPathNameW(const PathName : WideString) : WideString;
  {-Return a pathname cleaned up as DOS does it.}
var
  I : Cardinal;
  S : AnsiString;
begin
  SetLength(Result, 0);
  S := PathName;

  I := Succ(Word(Length(S)));
  repeat
    dec(I);
    if I > 2 then
      if (S[I] = '\') and (S[I-1] = '\') then
        if (S[I-2] <> ':') then
          System.Delete(S, I, 1);
  until I <= 0;

  I := Succ(Word(Length(S)));
  repeat
    {Get the next directory or drive portion of pathname}
    repeat
      Dec(I);
    until (I = 0) or (S[I] in DosDelimSet);                            {!!.02}

    {Clean it up and prepend it to output string}
    Result := CleanFileNameW(System.Copy(S, Succ(I), StMaxFileLen)) + Result;
    if I > 0 then begin
      Result := S[I] + Result;
      System.Delete(S, I, 255);
    end;
  until I <= 0;

end;