ststrz.pas

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

function Str2Int16Z(S : PAnsiChar; var I : SmallInt) : Boolean;
  {-Convert a string to an integer, returning true if successful}

var
  ec : integer;
  SS : ShortString;
begin
  case ConvertToShortString(S, SS) of
    0 : begin {success}
          ValSmallint(SS, I, ec);
          if (ec = 0) then
            Result := true
          else begin
            Result := false;
            if (ec < 0) then
              I := StrLen(S)
            else
              I := pred(ec); {null terminated strings are zero-based}
          end;
        end;
    1 : begin {S is nil}
          Result := false;
          I := 0;
        end;
    2 : begin {S is more than 255 characters long}
          Result := false;
          I := 256;
        end;
  else
    Result := false;
  end;
end;

function Str2WordZ(S : PAnsiChar; var I : Word) : Boolean;
  {-Convert a string to a word, returning true if successful}

var
  ec : integer;
  SS : ShortString;
begin
  case ConvertToShortString(S, SS) of
    0 : begin {success}
          ValWord(SS, I, ec);
          if (ec = 0) then
            Result := true
          else begin
            Result := false;
            if (ec < 0) then
              I := StrLen(S)
            else
              I := pred(ec); {null terminated strings are zero-based}
          end;
        end;
    1 : begin {S is nil}
          Result := false;
          I := 0;
        end;
    2 : begin {S is more than 255 characters long}
          Result := false;
          I := 256;
        end;
  else
    Result := false;
  end;
end;

function Str2LongZ(S : PAnsiChar; var I : LongInt) : Boolean;
  {-Convert a string to a longint, returning true if successful}

var
  ec : integer;
  SS : ShortString;
begin
  case ConvertToShortString(S, SS) of
    0 : begin {success}
          ValLongint(SS, I, ec);
          if (ec = 0) then
            Result := true
          else begin
            Result := false;
            if (ec < 0) then
              I := StrLen(S)
            else
              I := pred(ec); {null terminated strings are zero-based}
          end;
        end;
    1 : begin {S is nil}
          Result := false;
          I := 0;
        end;
    2 : begin {S is more than 255 characters long}
          Result := false;
          I := 256;
        end;
  else
    Result := false;
  end;
end;

{$IFDEF VER93}
function Str2RealZ(S : PAnsiChar; var R : Double) : Boolean;
{$ELSE}
function Str2RealZ(S : PAnsiChar; var R : Real) : Boolean;
{$ENDIF}
  {-Convert a string to a real, returning true if successful}
var
  Code : Integer;
  P : TSmallArray;
begin
  if StrLen(S)+1 > SizeOf(P) then begin
    Result := False;
    R := -1;
    Exit;
  end;
  StrCopy(P, S);
  TrimTrailPrimZ(P);
  Val(ValPrepZ(P), R, Code);
  if Code <> 0 then begin
    R := Code - 1;
    Result := False;
  end else
    Result := True;
end;

function Str2ExtZ(S : PAnsiChar; var R : Extended) : Boolean;
  {-Convert a string to an extended, returning true if successful}
var
  Code : Integer;
  P : TSmallArray;
begin
  if StrLen(S)+1 > SizeOf(P) then begin
    Result := False;
    R := -1;
    Exit;
  end;
  StrCopy(P, S);
  TrimTrailPrimZ(P);
  Val(ValPrepZ(P), R, Code);
  if Code <> 0 then begin
    R := Code - 1;
    Result := False;
  end else
    Result := True;
end;

function Long2StrZ(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
  {-Convert a long/word/integer/byte/shortint to a string}
type
  PCharArray = ^TCharArray;
  TCharArray = array[0..99] of AnsiChar;
begin
  Str(L, PCharArray(Dest)^);
  Result := Dest;
end;

function Real2StrZ(Dest : PAnsiChar; R : Double; Width : Byte;
                  Places : ShortInt) : PAnsiChar;
  {-Convert a real to a string}
type
  PCharArray = ^TCharArray;
  TCharArray = array[0..99] of AnsiChar;
begin
  Str(R:Width:Places, PCharArray(Dest)^);
  Result := Dest;
end;

function Ext2StrZ(Dest : PAnsiChar; R : Extended; Width : Byte;
                 Places : ShortInt) : PAnsiChar;
  {-Convert an extended to a string}
type
  PCharArray = ^TCharArray;
  TCharArray = array[0..99] of AnsiChar;
begin
  Str(R:Width:Places, PCharArray(Dest)^);
  Result := Dest;
end;

function ValPrepZ(S : PAnsiChar) : PAnsiChar;
  {-Prepares a string for calling Val.}
var
  P : Cardinal;
begin
  Result := TrimSpacesPrimZ(S);
  if StrLen(Result) <> 0 then begin
    if StrChPosZ(Result, DecimalSeparator, P) then begin
      Result[P] := '.';
      if Succ(P) = StrLen(Result) then
        Result[P] := #0;
    end;
  end else begin
    Result := '0';
  end;
end;

function CharExistsZ(S : PAnsiChar; C : AnsiChar) : Boolean;
  {-Determine whether the given character exists in a string. }
register;
asm
  xor   dh, dh
  xor   ecx, ecx
@@Loop:
  cmp   dh, [eax+0]
  je    @@Done
  cmp   dl, [eax+0]
  jne   @@1
  inc   ecx
  jmp   @@Done
@@1:
  cmp   dh, [eax+1]
  je    @@Done
  cmp   dl, [eax+1]
  jne   @@2
  inc   ecx
  jmp   @@Done
@@2:
  cmp   dh, [eax+2]
  je    @@Done
  cmp   dl, [eax+2]
  jne   @@3
  inc   ecx
  jmp   @@Done
@@3:
  cmp   dh, [eax+3]
  je    @@Done
  cmp   dl, [eax+3]
  jne   @@4
  inc   ecx
  jmp   @@Done
@@4:
  add   eax, 4
  jmp   @@Loop
@@Done:
  mov   eax, ecx
end;

function CharCountZ(S : PAnsiChar; C : AnsiChar) : Cardinal;
  {-Count the number of a given character in a string. }
register;
asm
  xor   dh, dh
  xor   ecx, ecx
@@Loop:
  cmp   dh, [eax+0]
  je    @@Done
  cmp   dl, [eax+0]
  jne   @@1
  inc   ecx
@@1:
  cmp   dh, [eax+1]
  je    @@Done
  cmp   dl, [eax+1]
  jne   @@2
  inc   ecx
@@2:
  cmp   dh, [eax+2]
  je    @@Done
  cmp   dl, [eax+2]
  jne   @@3
  inc   ecx
@@3:
  cmp   dh, [eax+3]
  je    @@Done
  cmp   dl, [eax+3]
  jne   @@4
  inc   ecx
@@4:
  add   eax, 4
  jmp   @@Loop
@@Done:
  mov   eax, ecx
end;

function WordCountZ(S : PAnsiChar; WordDelims : PAnsiChar) : Cardinal;
  {-Given a set of word delimiters, return number of words in S}
var
  Count : Cardinal;
  I     : Cardinal;
  SLen  : Cardinal;

begin
  Count := 0;
  I := 0;
  SLen := StrLen(S);
  while I < SLen do begin
    {skip over delimiters}
    while (I < SLen) and (CharExistsZ(WordDelims, S^)) do begin
      Inc(I);
      Inc(S);
    end;
    {if we're not beyond end of S, we're at the start of a word}
    if I < SLen then
      Inc(Count);

   {find the end of the current word}
    while (I < SLen) and (not CharExistsZ(WordDelims, S^)) do begin
      Inc(I);
      Inc(S);
    end;
  end;

  Result := Count;
end;

function WordPositionZ(N : Cardinal; S : PAnsiChar; WordDelims : PAnsiChar;
                      var Pos : Cardinal) : Boolean;
  {-Given a set of word delimiters, return start position of N'th word in S}
var
  Count : Cardinal;
  SLen  : Cardinal;
begin
  Count := 0;
  Pos := 0;
  Result := False;
  SLen := StrLen(S);

  while (Pos < SLen) and (Count <> N) do begin
    {skip over delimiters}
    while (Pos < SLen) and (CharExistsZ(WordDelims, S^)) do begin
      Inc(Pos);
      Inc(S);
    end;
    {if we're not beyond end of S, we're at the start of a word}
    if Pos < SLen then
      Inc(Count);

    {if not finished, find the end of the current word}
    if Count <> N then begin
      while (Pos < SLen) and (not CharExistsZ(WordDelims, S^)) do begin
        Inc(Pos);
        Inc(S);
      end;
    end
    else
      Result := True;
  end;
end;

function ExtractWordZ(Dest : PAnsiChar; N : Cardinal; Src : PAnsiChar;
                     WordDelims : PAnsiChar) : PAnsiChar;
  {-Given a set of word delimiters, return in Dest the N'th word in Src}
var
  I : Cardinal;
  SLen : Cardinal;
begin
  Result := Dest;
  SLen := StrLen(Src);
  if WordPositionZ(N, Src, WordDelims, I) then begin
    Inc(Src, I);
    {find the end of the current word}
    while (I <= SLen) and (not CharExistsZ(WordDelims, Src^)) do begin
      {add the I'th character to result}
      Dest^ := Src^;
      Inc(Dest);
      Inc(Src);
      Inc(I);
    end;
  end;
  Dest^ := #0;
end;

function AsciiCountZ(S : PAnsiChar; WordDelims : PAnsiChar; Quote : AnsiChar) : Cardinal;
  {-Given a set of word delimiters, return number of words in S}
var
  Count : Cardinal;
  I     : Cardinal;
  SLen  : Cardinal;
  InQuote : Boolean;
begin
  Count := 0;
  I := 1;
  InQuote := False;
  SLen := StrLen(S);
  while I <= SLen do begin
    {skip over delimiters}
    while (I <= SLen) and (S^ <> Quote) and CharExistsZ(WordDelims, S^) do begin
      Inc(I);
      Inc(S);
    end;
    {if we're not beyond end of S, we're at the start of a word}
    if I <= SLen then
      Inc(Count);
    {find the end of the current word}
    while (I <= SLen) and ((InQuote) or (not CharExistsZ(WordDelims, S^))) do begin
      if S^ = Quote then
        InQuote := not(InQuote);
      Inc(I);
      Inc(S);
    end;
  end;

  Result := Count;
end;

function AsciiPositionZ(N : Cardinal; S : PAnsiChar; WordDelims : PAnsiChar;
                       Quote : AnsiChar; var Pos : Cardinal) : Boolean;
  {-Given a set of word delimiters, return start position of N'th word in S}
var
  Count : Cardinal;
  SLen  : Cardinal;
  InQuote : Boolean;
begin
  Count := 0;
  Pos := 0;
  InQuote := False;
  Result := False;
  SLen := StrLen(S);
  while (Pos < SLen) and (Count <= N) do begin
   {skip over delimiters}
    while (Pos < SLen) and (S^ <> Quote) and CharExistsZ(WordDelims, S^) do begin
      Inc(Pos);
      Inc(S);
    end;

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

    {if not finished, find the end of the current word}
    if Count <> N then
      while (Pos < SLen) and ((InQuote) or (not CharExistsZ(WordDelims, S^))) do begin
        if S^ = Quote then
          InQuote := not(InQuote);
        Inc(Pos);
        Inc(S);
      end
    else begin
      Result := True;
      Exit;
    end;
  end;
end;

function ExtractAsciiZ(Dest : PAnsiChar; N : Cardinal; Src : PAnsiChar;
                      WordDelims : PAnsiChar; Quote : AnsiChar) : PAnsiChar;
  {-Given a set of word delimiters, return in Dest the N'th word in Src}
var
  I : Cardinal;
  Len : Cardinal;
  SLen : Cardinal;
  InQuote : Boolean;
begin
  Len := 0;
  InQuote := False;
  Dest[0] := #0;
  Result := Dest;
  SLen := StrLen(Src);
  if AsciiPositionZ(N, Src, WordDelims, Quote, I) then
    {find the end of the current word}
    while (I < SLen) and ((InQuote) or (not CharExistsZ(WordDelims, Src[I]))) do begin
      {add the I'th character to result}
      if Src[I] = Quote then