ststrz.pas

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

                  N : Cardinal; var Position : Cardinal) : Boolean;
  {-returns the Occurrence instance of a word within a string}



implementation


function HexBZ(Dest : PAnsiChar; B : Byte) : PAnsiChar;
    {-Return hex string for byte}
begin
  Result := Dest;
  Dest^ := StHexDigits[B shr 4];
  Inc(Dest);
  Dest^ := StHexDigits[B and $F];
  Inc(Dest);
  Dest^ := #0;
end;

function HexWZ(Dest : PAnsiChar; W : Word) : PAnsiChar;
  {-Return hex string for word}
begin
  Result := Dest;
  Dest^ := StHexDigits[hi(W) shr 4];
  Inc(Dest);
  Dest^ := StHexDigits[hi(W) and $F];
  Inc(Dest);
  Dest^ := StHexDigits[lo(W) shr 4];
  Inc(Dest);
  Dest^ := StHexDigits[lo(W) and $F];
  Inc(Dest);
  Dest^ := #0;
end;

function HexLZ(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
  {-Return hex string for LongInt}
//type                                                                 {!!.02}
//  LH = record L, H : word; end;                                      {!!.02}
var
  T2 : Array[0..4] of AnsiChar;
begin
//  Result := StrCat(HexWZ(Dest, LH(L).H), HexWZ(T2, LH(L).L));        {!!.02}
  Result := StrCat(HexWZ(Dest, HiWord(DWORD(L))),                      {!!.02}
    HexWZ(T2, LoWord(DWORD(L))));                                      {!!.02}
end;

function HexPtrZ(Dest : PAnsiChar; P : Pointer) : PAnsiChar;
  {-Return hex string for pointer}
var
  T2 : array[0..8] of AnsiChar;
begin
  StrCopy(Dest, ':');
  Result := StrCat(Dest, HexLZ(T2, LongInt(P)));
end;

function BinaryBZ(Dest : PAnsiChar; B : Byte) : PAnsiChar;
  {-Return binary string for byte}
var
  I : Word;
begin
  Result := Dest;
  for I := 7 downto 0 do begin
    Dest^ := StHexDigits[Ord(B and (1 shl I) <> 0)]; {0 or 1}
    Inc(Dest);
  end;
  Dest^ := #0;
end;

function BinaryWZ(Dest : PAnsiChar; W : Word) : PAnsiChar;
  {-Return binary string for word}
var
  I : Word;
begin
  Result := Dest;
  for I := 15 downto 0 do begin
    Dest^ := StHexDigits[Ord(W and (1 shl I) <> 0)]; {0 or 1}
    Inc(Dest);
  end;
  Dest^ := #0;
end;

function BinaryLZ(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
  {-Return binary string for LongInt}
var
  I : Longint;
begin
  Result := Dest;
  for I := 31 downto 0 do begin
    Dest^ := StHexDigits[Ord(L and LongInt(1 shl I) <> 0)]; {0 or 1}
    Inc(Dest);
  end;
  Dest^ := #0;
end;

function OctalBZ(Dest : PAnsiChar; B : Byte) : PAnsiChar;
  {-Return octal string for byte}
var
  I : Word;
begin
  Result := Dest;
  for I := 0 to 2 do begin
    Dest[2-I] := StHexDigits[B and 7];
    B := B shr 3;
  end;
  Dest[3] := #0;
end;

function OctalWZ(Dest : PAnsiChar; W : Word) : PAnsiChar;
  {-Return octal string for word}
var
  I : Word;
begin
  Result := Dest;
  for I := 0 to 5 do begin
    Dest[5-I] := StHexDigits[W and 7];
    W := W shr 3;
  end;
  Dest[6] := #0;
end;

function OctalLZ(Dest : PAnsiChar; L : LongInt) : PAnsiChar;
  {-Return octal string for word}
var
  I : Word;
begin
  Result := Dest;
  for I := 0 to 11 do begin
    Dest[11-I] := StHexDigits[L and 7];
    L := L shr 3;
  end;
  Dest[12] := #0;
end;

function CharStrZ(Dest : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
register;
asm
  push    edi            { Save EDI-about to change it }
  push    eax            { Save Dest pointer for return }
  mov     edi, eax       { Point EDI to Dest }

  mov     dh, dl         { Dup character 4 times }
  mov     eax, edx
  shl     eax, $10
  mov     ax, dx

  mov     edx, ecx       { Save Len }

  shr     ecx, 2         { Store dword char chunks first }
  rep     stosd
  mov     ecx, edx       { Store remaining characters }
  and     ecx, 3
  rep     stosb

  xor     al,al          { Add null terminator }
  mov     [edi], al

  pop     eax            { Return Dest pointer }
  pop     edi            { Restore orig value of EDI }
end;

function PadChPrimZ(S : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
register;
asm
  push   eax
  push   ebx
  push   edi

  mov    edi, eax
  mov    ebx, ecx
  xor    eax, eax
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx
  dec    edi
  mov    eax, ebx
  sub    eax, ecx
  jbe    @@ExitPoint

  mov    ecx, eax
  mov    eax, edx
  rep    stosb

@@ExitPoint:
  xor    eax, eax
  mov    [edi], al

  pop    edi
  pop    ebx
  pop    eax
end;

function PadPrimZ(S : PAnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string right-padded to length len with blanks}
begin
  Result := PadChPrimZ(S, ' ', Len);
end;

function LeftPadChPrimZ(S : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string left-padded to length len with C}
register;
asm
  push   ebx
  push   edi
  push   esi

  mov    edi, eax
  mov    esi, edi
  mov    ebx, ecx

  xor    eax, eax
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx
  mov    eax, ebx
  mov    edi, esi
  add    edi, ebx
  mov    ebx, esi
  sub    eax, ecx
  jbe    @@ExitPoint

  add    esi, ecx
  inc    ecx
  std
  rep    movsb
  mov    ecx, eax
  mov    eax, edx
  rep    stosb

@@ExitPoint:
  cld
  mov    eax, ebx
  pop    esi
  pop    edi
  pop    ebx
end;

function LeftPadPrimZ(S : PAnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string left-padded to length len with blanks}
begin
  Result := LeftPadChPrimZ(S, ' ', Len);
end;

function PadChZ(Dest, S : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a PChar right-padded to length Len with C}
begin
  StrCopy(Dest, S);
  Result := PadChPrimZ(Dest, C, Len);
end;

function PadZ(Dest, S : PAnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string right-padded to length len with blanks}
begin
  StrCopy(Dest, S);
  Result := PadPrimZ(Dest, Len);
end;

function LeftPadChZ(Dest, S : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string left-padded to length len with C}
begin
  StrCopy(Dest, S);
  Result := LeftPadChPrimZ(Dest, C, Len);
end;

function LeftPadZ(Dest, S : PAnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string left-padded to length len with blanks}
begin
  StrCopy(Dest, S);
  Result := LeftPadPrimZ(Dest, Len);
end;

function TrimLeadPrimZ(S : PAnsiChar) : PAnsiChar;
  {-Return a string with leading white space removed}
register;
asm
  push   edi
  push   esi

  mov    edi, eax
  mov    esi, eax
  mov    edx, eax
  xor    eax, eax
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx
  mov    edi, edx
  jz     @@CopyRest

@@Lo:
  cmp    byte ptr [esi], ' '
  ja     @@CopyRest
  inc    esi
  dec    ecx
  jnz    @@Lo

@@CopyRest:
  inc    ecx
  rep    movsb
  mov    eax, edx

  pop    esi
  pop    edi
end;

function TrimLeadZ(Dest, S : PAnsiChar) : PAnsiChar;
  {-Return a string with leading white space removed}
begin
  StrCopy(Dest, S);
  Result := TrimLeadPrimZ(Dest);
end;

function TrimTrailPrimZ(S : PAnsiChar) : PAnsiChar;
  {-Return a string with trailing white space removed}
register;
asm
  push   edi

  mov    edi, eax
  mov    edx, eax
  xor    eax, eax
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx
  jz     @@ExitPoint
  dec    edi
  dec    edi

@@Lo:
  cmp    BYTE PTR [edi], ' '
  ja     @@AllDone
  dec    edi
  dec    ecx
  jnz    @@Lo

@@AllDone:
  inc    edi
  mov    byte ptr [edi], 0h

@@ExitPoint:
  mov    eax, edx
  pop    edi
end;

function TrimTrailZ(Dest, S : PAnsiChar) : PAnsiChar;
  {-Return a string with trailing white space removed}
begin
  StrCopy(Dest, S);
  Result := TrimTrailPrimZ(Dest);
end;

function TrimPrimZ(S : PAnsiChar) : PAnsiChar;
  {-Return a string with leading and trailing white space removed}
begin
  Result := TrimTrailPrimZ(TrimLeadPrimZ(S));
end;

function TrimZ(Dest, S : PAnsiChar) : PAnsiChar;
  {-Return a string with leading and trailing white space removed}
begin
  StrCopy(Dest, S);
  Result := TrimPrimZ(Dest);
end;

function TrimSpacesPrimZ(S : PAnsiChar) : PAnsiChar;
  {-Return a string with leading and trailing spaces removed}
var
  I, SLen : Cardinal;
begin
  Result := S;
  SLen := StrLen(S);
  while (SLen > 0) and (S[SLen-1] = ' ') do
    Dec(SLen);
  S[SLen] := #0;
  I := 0;
  while (I < SLen) and (S[I] = ' ') do
    Inc(I);
  if I > 0 then
    StrStDeletePrimZ(S, 0, I);
end;

function TrimSpacesZ(Dest, S : PAnsiChar) : PAnsiChar;
  {-Return a string with leading and trailing spaces removed}
begin
  StrCopy(Dest, S);
  Result := TrimSpacesPrimZ(Dest);
end;

function CenterChPrimZ(S : PAnsiChar; C : AnsiChar; Len : Cardinal) : PAnsiChar;
  {-Return a string centered in a string of C with specified width}
register;
asm
  push   eax                 { save registers }
  push   ebx
  push   edi
  push   esi

  mov    edi, eax            { set EDI and ESI to S }
  mov    esi, eax
  mov    ebx, ecx            { store Len in EBX }
  xor    eax, eax
  or     ecx, -1
  repne  scasb               { Find null terminator in S }
  not    ecx
  dec    ecx                 { ECX has length of S }
  jz     @@SpecialCase       { if zero, jump to special case }

  cmp    ecx, ebx
  jae    @@ExitPoint         { if Len >= Length(S), we're done }

  mov    eax, ebx            { copy Len to EAX }
  sub    ebx, ecx            { EBX = number of pad characters }
  inc    ebx
  shr    ebx, 1              { EBX = number of pad characters on one side }
  sub    eax, ebx
  sub    eax, ecx
  push   eax
  add    esi, ecx            { set ESI to end of text in S }
  mov    edi, esi
  add    edi, ebx            { set EDI to end of destination }
  dec    esi
  push   edi
  dec    edi
  std                        { Backward string ops }
  rep    movsb               { move string }
  mov    eax, edx            { copy pad character to EAX }
  mov    ecx, ebx
  rep    stosb               { pad to left of text }
  pop    edi
  pop    ecx
  cld                        { forward string ops }
  rep    stosb               { pad to right of text }
  jmp    @@AddNull           { add null terminator }

@@SpecialCase:
  mov    ecx, ebx            { fill string with C }
  mov    eax, edx
  mov    edi, esi
  rep    stosb

@@AddNull:
  mov    byte ptr [edi], 0h  { add null at end of string }

@@ExitPoint:
  pop    esi                 { restore registers }
  pop    edi
  pop    ebx
  pop    eax
end;