ststrw.pas

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

function HasExtensionW(const Name : WideString; var DotPos : Cardinal) : Boolean;
  {-Determine if a pathname contains an extension and, if so, return the
    position of the dot in front of the extension.}
var
  I : Cardinal;
begin
  DotPos := 0;
  for I := Length(Name) downto 1 do
    if (Name[I] = '.') and (DotPos = 0) then
      DotPos := I;
  Result := (DotPos > 0)
    and not CharExistsW(System.Copy(Name, Succ(DotPos), StMaxFileLen), '\');
end;

  {------------------ Formatting routines --------------------}


function CommaizeChW(L : Longint; Ch : WideChar) : WideString;
  {-Convert a long integer to a string with Ch in comma positions}
var
  Temp       : WideString;
  I,
  Len,
  NumCommas  : Cardinal;
  Neg        : Boolean;
begin
  SetLength(Temp, 1);
  Temp[1] := Ch;
  if (L < 0) then begin
    Neg := True;
    L := Abs(L);
  end else
    Neg := False;
  Result := Long2StrW(L);
  Len := Length(Result);
  NumCommas := (Pred(Len)) div 3;
  for I := 1 to NumCommas do
    System.Insert(Temp, Result, Succ(Len-(I * 3)));
  if Neg then
    System.Insert('-', Result, 1);
end;

function CommaizeW(L : LongInt) : WideString;
  {-Convert a long integer to a string with commas}
begin
  Result := CommaizeChW(L, ',');
end;

function FormPrimW(const Mask     : WideString;
                         R        : TstFloat;
                   const LtCurr,
                         RtCurr   : WideString;
                         Sep,
                         DecPt    : WideChar;
                         AssumeDP : Boolean) : WideString;
  {-Returns a formatted string with digits from R merged into the Mask}
const
  Blank = 0;
  Asterisk = 1;
  Zero = 2;
const
{$IFOPT N+}
  MaxPlaces = 18;
{$ELSE}
  MaxPlaces = 11;
{$ENDIF}
  FormChars  : string[8] = '#@*$-+,.';
  PlusArray  : array[Boolean] of WideChar = ('+', '-');
  MinusArray : array[Boolean] of WideChar = (' ', '-');
  FillArray  : array[Blank..Zero] of WideChar = (' ', '*', '0');
var
  S            : WideString; {temporary string}
  Filler       : Integer;    {char for unused digit slots: ' ', '*', '0'}
  WontFit,                   {true if number won't fit in the mask}
  AddMinus,                  {true if minus sign needs to be added}
  Dollar,                    {true if floating dollar sign is desired}
  Negative     : Boolean;    {true if B is negative}
  StartF,                    {starting point of the numeric field}
  EndF         : Longint;    {end of numeric field}
  RtChars,                   {# of chars to add to right}
  LtChars,                   {# of chars to add to left}
  DotPos,                    {position of '.' in Mask}
  Digits,                    {total # of digits}
  Blanks,                    {# of blanks returned by Str}
  Places,                    {# of digits after the '.'}
  FirstDigit,                {pos. of first digit returned by Str}
  Extras,                    {# of extra digits needed for special cases}
  DigitPtr     : Byte;       {pointer into temporary string of digits}
  I            : Cardinal;
label
  EndFound,
  RedoCase,
  Done;
begin
  {assume decimal point at end?}
  Result := Mask;
  if (not AssumeDP) and (not CharExistsW(Result, '.')) then
    AssumeDP := true;
  if AssumeDP and (Result <> '') then begin
    SetLength(Result, Succ(Length(Result)));
    Result[Length(Result)] := '.';
  end;

  RtChars := 0;
  LtChars := 0;

  {check for empty string}
  if Length(Result) = 0 then
    goto Done;

  {initialize variables}
  Filler := Blank;
  DotPos := 0;
  Places := 0;
  Digits := 0;
  Dollar := False;
  AddMinus := True;
  StartF := 1;

  {store the sign of the real and make it positive}
  Negative := (R < 0);
  R := Abs(R);

  {strip and count c's}
  for I := Length(Result) downto 1 do begin
    if Result[I] = 'C' then begin
      Inc(RtChars);
      System.Delete(Result, I, 1);
    end else if Result[I] = 'c' then begin
      Inc(LtChars);
      System.Delete(Result, I, 1);
    end;
  end;

  {find the starting point for the field}
  while (StartF <= Length(Result))
    {and (System.Pos(Result[StartF], FormChars) = 0) do}
    and not CharExistsW(FormChars, Result[StartF]) do
    Inc(StartF);
  if StartF > Length(Result) then
    goto Done;

  {find the end point for the field}
  EndF := StartF;
  for I := StartF to Length(Result) do begin
    EndF := I;
    case Result[EndF] of
      '*' : Filler := Asterisk;
      '@' : Filler := Zero;
      '$' : Dollar := True;
      '-',
      '+' : AddMinus := False;
      '#' : {ignore} ;
      ',',
      '.' : DotPos := EndF;
    else
      goto EndFound;
    end;
    {Inc(EndF);}
  end;

  {if we get here at all, the last char was part of the field}
  Inc(EndF);

EndFound:
  {if we jumped to here instead, it wasn't}
  Dec(EndF);

  {disallow Dollar if Filler is Zero}
  if Filler = Zero then
    Dollar := False;

  {we need an extra slot if Dollar is True}
  Extras := Ord(Dollar);

  {get total # of digits and # after the decimal point}
  for I := StartF to EndF do
    case Result[I] of
      '#', '@',
      '*', '$' :
        begin
          Inc(Digits);
          if (I > DotPos) and (DotPos <> 0) then
            Inc(Places);
        end;
    end;

  {need one more 'digit' if Places > 0}
  Inc(Digits, Ord(Places > 0));

  {also need an extra blank if (1) Negative is true, and (2) Filler is Blank,
   and (3) AddMinus is true}
  if Negative and AddMinus and (Filler = Blank) then
    Inc(Extras)
  else
    AddMinus := False;

  {translate the real to a string}
  Str(R:Digits:Places, S);

  {add zeros that Str may have left out}
  if Places > MaxPlaces then begin
    I := Length(S);
    SetLength(S, LongInt(I) + (Places-MaxPlaces));
    StUtils.FillWord(S[Succ(I)], Places-MaxPlaces, Word(WideChar('0')));
    while (Length(S) > Digits) and (S[1] = ' ') do
      System.Delete(S, 1, 1);
  end;

  {count number of initial blanks}
  Blanks := 1;
  while S[Blanks] = ' ' do
    Inc(Blanks);
  FirstDigit := Blanks;
  Dec(Blanks);

  {the number won't fit if (a) S is longer than Digits or (b) the number of
   initial blanks is less than Extras}
  WontFit := (Length(S) > Digits) or (Blanks < Extras);

  {if it won't fit, fill decimal slots with '*'}
  if WontFit then begin
    for I := StartF to EndF do
      case Result[I] of
        '#', '@', '*', '$' : Result[I] := '*';
        '+' : Result[I] := PlusArray[Negative];
        '-' : Result[I] := MinusArray[Negative];
      end;
    goto Done;
  end;

  {fill initial blanks in S with Filler; insert floating dollar sign}
  if Blanks > 0 then begin
    FillWord(S[1], Blanks, Word(FillArray[Filler]));

    {put floating dollar sign in last blank slot if necessary}
    if Dollar then begin
      S[Blanks] := LtCurr[1];
      Dec(Blanks);
    end;

    {insert a minus sign if necessary}
    if AddMinus then
      S[Blanks] := '-';
  end;

  {put in the digits / signs}
  DigitPtr := Length(S);
  for I := EndF downto StartF do begin
RedoCase:
    case Result[I] of
      '#', '@', '*', '$' :
        if DigitPtr <> 0 then begin
          Result[I] := S[DigitPtr];
          Dec(DigitPtr);
          if (DigitPtr <> 0) and (S[DigitPtr] = '.') then                {!!.01}
            Dec(DigitPtr);
        end
        else
          Result[I] := FillArray[Filler];
      ',' :
        begin
          Result[I] := Sep;
          if (I < DotPos) and (DigitPtr < FirstDigit) then begin
            Result[I] := '#';
            goto RedoCase;
          end;
        end;
      '.' :
        begin
          Result[I] := DecPt;
          if (I < DotPos) and (DigitPtr < FirstDigit) then begin
            Result[I] := '#';
            goto RedoCase;
          end;
        end;
      '+' : Result[I] := PlusArray[Negative];
      '-' : Result[I] := MinusArray[Negative];
    end;
  end;

Done:
  if AssumeDP then
    SetLength(Result, Pred(Length(Result)));
  if RtChars > 0 then begin
    S := RtCurr;
    if Length(S) > RtChars then
      SetLength(S, RtChars)
    else
      S := LeftPadW(S, RtChars);
    Result := Result + S;
  end;
  if LtChars > 0 then begin
    S := LtCurr;
    if Length(S) > LtChars then
      SetLength(S, LtChars)
    else
      S := PadW(S, LtChars);
    Result := S + Result;
  end;
end;

function FloatFormW(const Mask     : WideString;
                          R        : TstFloat ;
                    const LtCurr,
                          RtCurr   : WideString;
                          Sep,
                          DecPt    : WideChar) : WideString;
  {-Return a formatted string with digits from R merged into mask.}
begin
  Result := FormPrimW(Mask, R, LtCurr, RtCurr, Sep, DecPt, False);
end;

function LongIntFormW(const Mask    : WideString;
                            L       : Longint;
                      const LtCurr,
                            RtCurr  : WideString;
                            Sep     : WideChar) : WideString;
  {-Return a formatted string with digits from L merged into mask.}
begin
  Result := FormPrimW(Mask, L, LtCurr, RtCurr, Sep, '.', True);
end;

function StrChPosW(const P : WideString; C : WideChar; var Pos : Cardinal) : Boolean;
  {-Return the position of a specified character within a string.}
var
  i : integer;
begin
  Result := true;
  for i := 1 to length(P) do
    if (P[i] = C) then begin
      Pos := i;
      Exit;
    end;
  Result := false;
  Pos := 0;
end;

function StrStPosW(const P, S : WideString; var Pos : Cardinal) : Boolean;
  {-Return the position of a specified substring within a string.}
begin
  Pos := System.Pos(S, P);
  Result := Pos <> 0;
end;

function StrStCopyW(const S : WideString; Pos, Count : Cardinal) : WideString;
  {-Copy characters at a specified position in a string.}
begin
  Result := System.Copy(S, Pos, Count);
end;

function StrChInsertW(const S : WideString; C : WideChar; Pos : Cardinal) : WideString;
  {-Insert a character into a string at a specified position.}
var
  Temp : WideString;
begin
  SetLength(Temp, 1);
  Temp[1] := C;
  Result := S;
  System.Insert(Temp, Result, Pos);
end;

function StrStInsertW(const S1, S2 : WideString; Pos : Cardinal) : WideString;
  {-Insert a string into another string at a specified position.}
begin
  Result := S1;
  System.Insert(S2, Result, Pos);
end;

function StrChDeleteW(const S : WideString; Pos : Cardinal) : WideString;
  {-Delete the character at a specified position in a string.}
begin
  Result := S;
  System.Delete(Result, Pos, 1);
end;

function StrStDeleteW(const S : WideString; Pos, Count : Cardinal) : WideString;
  {-Delete characters at a specified position in a string.}
begin
  Result := S;
  System.Delete(Result, Pos, Count);
end;




function CopyLeftW(const S : WideString; Len : Cardinal) : WideString;
  {-Return the left Len characters of a string}
begin
  if (Len < 1) or (S = '') then
    Result := ''
  else
    Result := Copy(S, 1, Len);
end;



function CopyMidW(const S : WideString; First, Len : Cardinal) : WideString;
  {-Return the mid part of a string}
begin
  if (LongInt(First) > Length(S)) or (Len < 1) or (S = '') then
    Result := ''
  else
    Result := Copy(S, First, Len);
end;



function CopyRightW(const S : WideString; First : Cardinal) : WideString;
  {-Return the right Len characters of a string}
begin
  if (LongInt(First) > Length(S)) or (First < 1) or (S = '') then
    Result := ''
  else
    Result := Copy(S, First, Length(S));
end;


function CopyRightAbsW(const S : WideString; NumChars : Cardinal) : WideString;
  {-Return NumChar characters starting from end}
begin
  if (Cardinal(Length(S)) > NumChars) then
    Result := Copy(S, (Cardinal(Length(S)) - NumChars)+1, NumChars)
  else
    Result := S;
end;


function WordPosW(const S, WordDelims, AWord : WideString;
                  N : Cardinal; var Position : Cardinal) : Boolean;
  {-returns the Nth instance of a given word within a string}
var
  TmpStr : WideString;
  Len,
  I,
  P1,
  P2      : Cardinal;
begin
  if (S = '') or (AWord = '') or (pos(AWord, S) = 0) then begin
    Result := False;
    Position := 0;
    Exit;
  end;

  Result := False;
  Position := 0;

  TmpStr := S;
  I      := 0;
  Len    := Length(AWord);
  P1     := pos(AWord, TmpStr);

  while (P1 > 0) and (Length(TmpStr) > 0) do begin
    P2 := P1 + pred(Len);
    if (P1 = 1) then begin
      if (pos(TmpStr[P2+1], WordDelims) > 0) then begin
        Inc(I);
      end else
        System.Delete(TmpStr, 1, P2);
    end else if (pos(TmpStr[P1-1], WordDelims) > 0) and
                ((pos(TmpStr[P2+1], WordDelims) > 0) or
                 (LongInt(P2+1) = Length(TmpStr))) then begin
      Inc(I);
    end else if ((LongInt(P1) + LongInt(pred(Len))) = Length(TmpStr)) then begin