ststrw.pas

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

end;

function OctalBW(B : Byte) : WideString;
  {-Return an octal string for a byte.}
var
  I : Word;
begin
  SetLength(Result, 3);
  for I := 0 to 2 do begin
    Result[3-I] := WideChar(StHexDigits[B and 7]);
    B := B shr 3;
  end;
end;

function OctalWW(W : Word) : WideString;
  {-Return an octal string for a word.}
var
  I : Word;
begin
  SetLength(Result, 6);
  for I := 0 to 5 do begin
    Result[6-I] := WideChar(StHexDigits[W and 7]);
    W := W shr 3;
  end;
end;

function OctalLW(L : LongInt) : WideString;
  {-Return an octal string for a long integer.}
var
  I : Word;
begin
  SetLength(Result, 12);
  for I := 0 to 11 do begin
    Result[12-I] := WideChar(StHexDigits[L and 7]);
    L := L shr 3;
  end;
end;

function Str2Int16W(const S : WideString; var I : SmallInt) : Boolean;
  {-Convert a string to an SmallInt.}

var
  ec : Integer;
begin
  if (length(S) > 255) then begin
    Result := false;
    I := 256;
  end
  else begin
    {note the automatic string conversion}
    ValSmallint(S, I, ec);
    if (ec = 0) then
      Result := true
    else begin
      Result := false;
      if (ec < 0) then
        I := succ(length(S))
      else
        I := ec;
    end;
  end;
end;

function Str2WordW(const S : WideString; var I : Word) : Boolean;
  {-Convert a string to a word.}

var
  ec : Integer;
begin
  if (length(S) > 255) then begin
    Result := false;
    I := 256;
  end
  else begin
    {note the automatic string conversion}
    ValWord(S, I, ec);
    if (ec = 0) then
      Result := true
    else begin
      Result := false;
      if (ec < 0) then
        I := succ(length(S))
      else
        I := ec;
    end;
  end;
end;

function Str2LongW(const S : WideString; var I : LongInt) : Boolean;
  {-Convert a string to a long integer.}

var
  ec : Integer;
begin
  if (length(S) > 255) then begin
    Result := false;
    I := 256;
  end
  else begin
    {note the automatic string conversion}
    ValLongint(S, I, ec);
    if (ec = 0) then
      Result := true
    else begin
      Result := false;
      if (ec < 0) then
        I := succ(length(S))
      else
        I := ec;
    end;
  end;
end;

function Str2RealW(const S : WideString; var R : Double) : Boolean;
  {-Convert a string to a real.}
var
  Code : Integer;
  St   : AnsiString;
begin
  Result := False;
  if S = '' then Exit;
  St := TrimTrailW(S);
  if St = '' then Exit;
  Val(ValPrepW(St), R, Code);
  if Code <> 0 then begin
    R := Code;
  end else
    Result := True;
end;

function Str2ExtW(const S : WideString; var R : Extended) : Boolean;
  {-Convert a string to an extended.}
var
  Code : Integer;
  P    : WideString;
begin
  Result := False;
  if S = '' then Exit;
  P := TrimTrailW(S);
  if P = '' then Exit;
  Val(ValPrepW(P), R, Code);
  if Code <> 0 then begin
    R := Code - 1;
  end else
    Result := True;
end;

function Long2StrW(L : LongInt) : WideString;
  {-Convert an integer type to a string.}
begin
  Str(L, Result);
end;

function Real2StrW(R : Double; Width : Byte; Places : ShortInt) : WideString;
  {-Convert a real to a string.}
begin
  Str(R:Width:Places, Result);
end;

function Ext2StrW(R : Extended; Width : Byte; Places : ShortInt) : WideString;
  {-Convert an extended to a string.}
begin
  Str(R:Width:Places, Result);
end;

function ValPrepW(const S : WideString) : WideString;
  {-Prepares a string for calling Val.}
var
  P : Cardinal;
  C : Longint;
begin
  Result := TrimSpacesW(S);
  if Result <> '' then begin
    if StrChPosW(Result, WideChar(DecimalSeparator), P) then begin
      C := P;
      Result[C] := '.';
      if C = Length(Result) then
        SetLength(Result, Pred(C));
    end;
  end else
    Result := '0';
end;

  {-------- General purpose string manipulation --------}

function CharStrW(C : WideChar; Len : Cardinal) : WideString;
  {-Return a string filled with the specified character.}
var
  I : Longint;
begin
  SetLength(Result, Len);
  if Len <> 0 then begin
    {FillChar does not work for widestring}
    for I := 1 to Len do
      Result[I] := C;
  end;
end;

function PadChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
  {-Pad a string on the right with a specified character.}
var
  J,
  R  : Longint;
begin
  if Length(S) >= LongInt(Len) then
    Result := S
  else begin
    SetLength(Result, Len);

    { copy current contents (if any) of S to Result }
    if (Length(S) > 0) and (Length(Result) > 0) then                     {!!.01}
      Move(S[1], Result[1], Length(S)*SizeOf(WideChar));                 {!!.01}

    R := longint(Len) - Length(S);
    J := Succ(Length(S));
    while (R > 0) do begin
      Result[J] := C;
      Inc(J);
      Dec(R);
    end;
  end;
end;

function PadW(const S : WideString; Len : Cardinal) : WideString;
  {-Pad a string on the right with spaces.}
begin
  Result := PadChW(S, ' ', Len);
end;

function LeftPadChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
  {-Pad a string on the left with a specified character.}
var
  J,
  R  : Longint;
begin
  if Length(S) >= LongInt(Len) then
    Result := S
  else if Length(S) < MaxLongInt then begin
    SetLength(Result, Len);
    if (Length(S) > 0) and (Length(Result) > 0) then                     {!!.01}
      Move(S[1], Result[Succ(Word(Len))-Length(S)],                      {!!.01}
        Length(S)*SizeOf(WideChar));                                     {!!.01}
    R := longint(Len) - Length(S);
    J := 1;
    while (R > 0) do begin
      Result[J] := C;
      Inc(J);
      Dec(R);
    end;
  end;
end;

function LeftPadW(const S : WideString; Len : Cardinal) : WideString;
  {-Pad a string on the left with spaces.}
begin
  Result := LeftPadChW(S, ' ', Len);
end;

function TrimLeadW(const S : WideString) : WideString;
  {-Return a string with leading white space removed}
var
  I : Longint;
begin
  I := 1;
  while (I <= Length(S)) and (S[I] <= ' ') do
    Inc(I);
  SetLength(Result, Length(S)-Pred(I));
  if Length(Result) > 0 then                                             {!!.01}
    Move(S[I], Result[1], Length(S)-Pred(I)*SizeOf(WideChar));           {!!.01}
end;

function TrimTrailW(const S : WideString) : WideString;
  {-Return a string with trailing white space removed.}
var
  L : Longint;
begin
  Result := S;
  L := Length(Result);
  while (L > 0) and (Result[L] <= ' ') do
    Dec(L);
  SetLength(Result, L);
end;

function TrimW(const S : WideString) : WideString;
  {-Return a string with leading and trailing white space removed.}
var
  I : Longint;
begin
  Result := S;
  I := Length(Result);
  while (I > 0) and (Result[I] <= ' ') do
    Dec(I);
  SetLength(Result, I);

  I := 1;
  while (I <= Length(Result)) and (Result[I] <= ' ') do
    Inc(I);
  Dec(I);
  if (I > 0) then
    System.Delete(Result, 1, I);
end;

function TrimSpacesW(const S : WideString) : WideString;
  {-Return a string with leading and trailing spaces removed.}
var
  I : Longint;
begin
  Result := S;
  I := Length(Result);
  while (I > 0) and (Result[I] = ' ') do
    Dec(I);
  SetLength(Result, I);

  I := 1;
  while (I <= Length(Result)) and (S[I] = ' ') do
    Inc(I);
  Dec(I);
  if (I > 0) then
    System.Delete(Result, 1, I);
end;

function CenterChW(const S : WideString; C : WideChar; Len : Cardinal) : WideString;
  {-Pad a string on the left and right with a specified character.}
begin
  if Length(S) >= LongInt(Len) then
    Result := S
  else if Length(S) < MaxLongInt then begin
    SetLength(Result, Len);
    Result := CharStrW(C, Len);
    if Length(S) > 0 then                                                {!!.01}
      Move(S[1], Result[Succ((LongInt(Len)-Length(S)) shr 1)], Length(S));
  end;
end;

function CenterW(const S : WideString; Len : Cardinal) : WideString;
  {-Pad a string on the left and right with spaces.}
begin
  Result := CenterChW(S, ' ', Len);
end;


function EntabW(const S : WideString; TabSize : Byte) : WideString;
  {-Convert blanks in a string to tabs.}
const
  WSpace = WideChar(#32);
  {$IFNDEF VERSION4}
  WTab   = string(WideChar(#9));
  {$ELSE}
  WTab   = WideChar(#9);
  {$ENDIF}
var
  Col,
  CP,
  OP,
  Spaces  : Longint;
begin
  if (pos(' ', S) = 0) then begin
    Result := S;
    Exit;
  end;
  Result := '';
  Col := 1;
  repeat
     CP := Col;
     while ((S[CP] <> WSpace) and (CP <= Length(S))) do
       Inc(CP);
     if (CP <> Col) then begin
       OP := Length(Result) + 1;
       SetLength(Result, Length(Result) + (CP-Col));
       Move(S[Col], Result[OP], ((CP-Col) * SizeOf(WideChar)));
       Col := CP;
     end;

     while (S[CP] = WSpace) do begin
       Inc(CP);
       if ((CP mod TabSize) = 1) then begin
         Result := Result + WTab;
         Col := CP;
       end;
     end;
     Spaces := 0;
     while (Col < CP) do begin
       Inc(Spaces);
       Inc(Col);
     end;
     if (Spaces > 0) then
       Result := Result + PadW(WSpace, Spaces);
  until (Col > Length(S));
end;


function DetabW(const S : WideString; TabSize : Byte) : WideString;
  {-Expand tabs in a string to blanks.}
var
  Col,
  CP,
  OP,
  Spaces  : Longint;
begin
  if S = '' then begin
    Result := '';
    Exit;
  end else if (TabSize = 0) then begin
    Result := S;
    Exit;
  end;
  if (CharCountW(S, WideChar(#9)) = 0) then begin
    Result := S;
    Exit;
  end;
  Result := '';

  Col := 1;
  while (Col <= Length(S)) do begin
    if (S[Col] = WideChar(#9)) then begin
      Spaces := 0;
      repeat
        Inc(Spaces);
      until (((Col + Spaces) mod TabSize) = 1);
      Inc(Col);
      Result := PadW(Result, Length(Result) + Spaces);
    end else begin
      CP := Col;
      repeat
        Inc(Col);
      until (Col > Length(S)) or (S[Col] = WideChar(#9));
      OP := Length(Result) + 1;
      SetLength(Result, Length(Result) + (Col - CP));
      Move(S[CP], Result[OP], (Col-CP)*SizeOf(WideChar));
    end;
  end;
end;


function ScrambleW(const S, Key : WideString) : WideString;
  {-Encrypt / Decrypt string with enhanced XOR encryption.}
var
  I, J, LKey, LStr : Cardinal;
begin
  Result := S;
  if Key = '' then Exit;
  if S = '' then Exit;
  LKey := Length(Key);
  LStr := Length(S);
  I := 1;
  J := LKey;
  while I <= LStr do begin
    if J = 0 then
      J := LKey;
    if (S[I] <> Key[J]) then
      Result[I] := WideChar(Word(S[I]) xor Word(Key[J]));
    Inc(I);
    Dec(J);
  end;
end;

function SubstituteW(const S, FromStr, ToStr : WideString) : WideString;
  {-Map the characters found in FromStr to the corresponding ones in ToStr.}
var
  I : Cardinal;
  P : Cardinal;
begin
  Result := S;
  if Length(FromStr) = Length(ToStr) then