ststrz.pas

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

        InQuote := Not(InQuote);
      Dest[Len] := Src[I];
      Inc(Len);
      Inc(I);
    end;
  Dest[Len] := #0;
end;

procedure WordWrapZ(Dest : PAnsiChar; InSt, Overlap : PAnsiChar;
                   Margin : Cardinal;
                   PadToMargin : Boolean);
  {-Wrap InSt at Margin, storing the result in Dest and the remainder
    in Overlap}
var
  InStLen : Cardinal;
  OutStLen : Cardinal;
  OvrLen : Cardinal;
  EOS, BOS : Cardinal;
begin
  OutStLen := 0;
  InStLen := StrLen(InSt);

{!!.02 - Added }
  { handle empty string on input }                  
  if InStLen = 0 then begin                         
    if Assigned(Dest) then                          
      Dest[0] := #0;                                
    if Assigned(Overlap) then                       
      Overlap[0] := #0;                             
    Exit;                                           
  end;
{!!.02 - End Added }

  {find the end of the new output string}
  if InStLen > Margin then begin
    {assume this is a good break point}
    EOS := Margin-1;

    {is this the position of the last character of a word}
    if InSt[EOS+1] <> ' ' then begin  {check next char}
      {look for the space before the current word}
      while (EOS > 0) and (InSt[EOS] <> ' ') do
        Dec(EOS);
      {when done, EOS points to a space char or is zero}

      {if EOS = 0 then - can't wrap it properly}
      if EOS = 0 then
        EOS := Margin-1  {set up to break line at margin}
      else
        while (InSt[EOS] = ' ') and (EOS > 0) do  {trim trailing blanks}
          Dec(EOS);
    end else
      while (EOS > 0) and (InSt[EOS] = ' ') do  {trim trailing blanks}
        Dec(EOS);
  end
  else
    EOS := InStLen-1;

  {at this point EOS points to the break point, the end of the line,
   or is zero}

  {copy the unwrapped portion of the line}
  if (EOS = 0) and (InSt[EOS] = ' ') then
    Dest[0] := #0
  else begin
    OutStLen := EOS+1;
    Move(InSt^, Dest^, OutStLen);
    Dest[OutStLen] := #0;
  end;

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

  if BOS >= InStLen then begin
    OverLap[0] := #0;
  end else begin
    {copy from the start of the next word to the end of the line}
    OvrLen := InStLen-BOS;
    Move(InSt[BOS], Overlap^, OvrLen);
    Overlap[OvrLen] := #0;
  end;

  {pad the end of the output string if requested}
  if PadToMargin and (OutStLen < Margin) then begin
    FillChar(Dest[OutStLen], Margin-OutStLen, ' ');
    Dest[Margin] := #0;
  end;
end;

function CompStringZ(S1, S2 : PAnsiChar) : Integer;
  {-Return -1, 0, 1 if S1<S2, S1=S2, or S1>S2}
register;
asm
  push   ebx
  push   edi
  push   esi

  mov    edi, eax
  mov    esi, eax
  xor    eax, eax
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx

  mov    edi, edx
  mov    ebx, edx
  mov    edx, ecx
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx
  mov    edi, ebx
  or     ebx, -1
  cmp    edx, ecx
  je     @@EqLen
  jb     @@Comp

  inc    ebx
  mov    ecx, edx

@@EqLen:
  inc    ebx

@@Comp:
  or     ecx, ecx
  jz     @@Done

  repe   cmpsb
  je     @@Done

  mov    ebx, 1
  ja     @@Done
  or     ebx, -1

@@Done:
  mov    eax, ebx
  pop    esi
  pop    edi
  pop    ebx
end;


function CompUCStringZ(S1, S2 : PAnsiChar) : Integer;
  {-Return -1, 0, 1 if s1<s2, s1=s2, or s1>s2. Comparison is done in
    uppercase}
register;
asm
  push   ebx
  push   edi
  push   esi

  mov    edi, eax
  mov    esi, eax
  xor    eax, eax
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx

  mov    edi, edx
  mov    ebx, edx
  mov    edx, ecx
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx
  mov    edi, ebx
  or     ebx, -1
  cmp    edx, ecx
  je     @@EqLen
  jb     @@Comp

  inc    ebx
  mov    ecx, edx

@@EqLen:
  inc    ebx

@@Comp:
  or     ecx, ecx
  jz     @@Done             { Done if either is empty }

@@Start:
  mov    al, [esi]
  inc    esi
  push   ebx                { Save registers }
  push   ecx
  push   edx
  push   eax                { Push Char onto stack for CharUpper }
  call   CharUpper
  pop    edx                { Restore registers }
  pop    ecx
  pop    ebx

  mov    edx, eax
  mov    al, [edi]
  inc    edi

  push   ebx                { Save registers }
  push   ecx
  push   edx
  push   eax                { Push Char onto stack for CharUpper }
  call   CharUpper
  pop    edx                { Restore registers }
  pop    ecx
  pop    ebx

  cmp    edx, eax
  jne    @@Output
  dec    ecx
  jnz    @@Start
  je     @@Done

@@Output:
  mov    ebx, 1
  ja     @@Done
  or     ebx, -1

@@Done:
  mov    eax, ebx
  pop    esi
  pop    edi
  pop    ebx
end;

function SoundexZ(Dest : PAnsiChar; S : PAnsiChar) : PAnsiChar; assembler;
  {-Return 4 character soundex of input string}
register;
const
  SoundexTable : array[0..255] of AnsiChar =
    (#0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0,
    { A   B    C    D    E   F    G    H   I   J    K    L    M  }
     #0, '1', '2', '3', #0, '1', '2', #0, #0, '2', '2', '4', '5',
    { N    O   P    Q    R    S    T    U   V    W   X    Y   X  }
     '5', #0, '1', '2', '6', '2', '3', #0, '1', #0, '2', #0, '2',
     #0, #0, #0, #0, #0, #0,
    { a   b    c    d    e   f    g    h   i   j    k    l    m  }
     #0, '1', '2', '3', #0, '1', '2', #0, #0, '2', '2', '4', '5',
    { n    o   p    q    r    s    t    u   v    w   x    y   x  }
     '5', #0, '1', '2', '6', '2', '3', #0, '1', #0, '2', #0, '2',
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0, #0, #0, #0, #0, #0, #0, #0,
     #0, #0, #0);
asm
  push   eax                      { Save registers }
  push   ebx
  push   edi
  push   esi
  mov    edi, edx
  mov    ebx, eax
  mov    esi, edx

  mov    dword ptr [ebx], '0000'  { Initialize output string to '0000'. }
  xor    eax, eax
  mov    [ebx+4], al              { Set null at end of string. }

  or     ecx, -1                  { Set ECX to $FFFFFFFF }
  repne  scasb
  not    ecx
  dec    ecx                      { ECX has length of S }
  jz     @@Done                   { Exit if null string. }

  mov    edi, ebx
  mov    al, [esi]                { Get first character of input string. }
  inc    esi

  push   ecx                      { Save ECX across call to CharUpper. }
  push   eax                      { Push Char onto stack for CharUpper. }
  call   CharUpper                { Uppercase AL. }
  pop    ecx                      { Restore saved register. }

  mov    [edi], al                { Store first output character. }
  inc    edi

  dec    ecx                      { One input character used. }
  jz     @@Done                   { Was input string one char long?. }

  mov    bh, 03h                  { Output max 3 chars beyond first. }
  mov    edx, offset SoundexTable { EDX => Soundex table. }
  xor    eax, eax                 { Prepare for address calc. }
  xor    bl, bl                   { BL will be used to store 'previous char'. }

@@Next:
  mov    al, [esi]                { Get next char in AL. }
  inc    esi
  mov    al, [edx+eax]            { Get soundex code into AL. }
  or     al, al                   { Is AL zero? }
  jz     @@NoStore                { If yes, skip this char. }
  cmp    bl, al                   { Is it the same as the previous stored char? }
  je     @@NoStore                { If yes, skip this char. }
  mov    [edi], al                { Store char to Dest. }
  inc    edi
  dec    bh                       { Decrement output counter. }
  jz     @@Done                   { If zero, we're done. }
  mov    bl, al                   { New previous character. }

@@NoStore:
  dec    ecx                      { Decrement input counter. }
  jnz    @@Next

@@Done:                           { Restore registers }
  pop    esi
  pop    edi
  pop    ebx
  pop    eax
end;

function MakeLetterSetZ(S : PAnsiChar) : Longint;
  {-Return a bit-mapped long storing the individual letters contained in S.}
register;
asm
  push   ebx                    { Save registers }
  push   edi
  push   esi
  mov    esi, eax
  mov    edi, eax
  xor    edx, edx
  xor    eax, eax               { Measure S }
  or     ecx, -1
  repne  scasb
  not    ecx
  dec    ecx                    { ECX has length of S }
  jz     @@Exit

@@Next:
  mov    al, [esi]              { EAX has next char in S }
  inc    esi

  push   ecx                    { Save registers }
  push   edx
  push   eax                    { Push Char onto stack for CharUpper }
  call   CharUpper
  pop    edx                    { Restore registers }
  pop    ecx

  sub    eax, 'A'               { Convert to bit number }
  cmp    eax, 'Z'-'A'           { Was char in range 'A'..'Z'? }
  ja     @@Skip                 { Skip it if not }

  mov    ebx, eax               { Exchange EAX and ECX }
  mov    eax, ecx
  mov    ecx, ebx
  ror    edx, cl
  or     edx, 01h               { Set appropriate bit }
  rol    edx, cl
  mov    ebx, eax               { Exchange EAX and ECX }
  mov    eax, ecx
  mov    ecx, ebx

@@Skip:
  dec    ecx
  jnz    @@Next                 { Get next character }

@@Exit:
  mov    eax, edx               { Move EDX to result }
  pop    esi
  pop    edi                    { Restore registers }
  pop    ebx
end;

procedure BMMakeTableZ(MatchString : PAnsiChar; var BT : BTable);
  {Build Boyer-Moore link table}
register;
asm
  push  esi             { Save registers because they will be changed }
  push  edi
  push  ebx

  mov   edi, eax        { Move EAX to ESI & EDI }
  mov   esi, eax
  xor   eax, eax        { Zero EAX }
  or    ecx, -1
  repne scasb           { Search for null terminator }
  not   ecx
  dec   ecx             { ECX is length of search string }
  cmp   ecx, 0FFh       { If ECX > 255, force to 255 }
  jbe   @@1
  mov   ecx, 0FFh

@@1:
  mov   ch, cl          { Duplicate CL in CH }
  mov   eax, ecx        { Fill each byte in EAX with length }
  shl   eax, 16
  mov   ax, cx
  mov   edi, edx        { Point to the table }
  mov   ecx, 64         { Fill table bytes with length }
  rep   stosd
  cmp   al, 1           { If length <= 1, we're done }
  jbe   @@MTDone
  mov   edi, edx        { Reset EDI to beginning of table }
  xor   ebx, ebx        { Zero EBX }
  mov   cl, al          { Restore CL to length of string }
  dec   ecx

@@MTNext:
  mov   bl, [esi]       { Load table with positions of letters }
  inc   esi             { That exist in the search string }
  mov   [edi+ebx], cl
  dec   ecx
  jnz   @@MTNext

@@MTDone:
  pop   ebx             { Restore registers }
  pop   edi
  pop   esi
end;

function BMSearchZ(var Buffer; BufLength : Cardinal; var BT : BTable;
  MatchString : PAnsiChar; var Pos : Cardinal) : Boolean; assembler;
register;
var
  BufPtr : Pointer;
asm
  push  edi                 { Save registers since we will be changing }
  push  esi
  push  ebx
  push  edx

  mov   BufPtr, eax         { Copy Buffer to local variable and ESI }
  mov   esi, eax
  mov   ebx, ecx            { Copy BT ptr to EBX }

  xor   eax, eax            { Zero out EAX so we can search for null }
  mov   edi, MatchString    { Set EDI to beginning of MatchString }
  or    ecx, -1             { We will be counting down }
  repne scasb               { Find null }
  not   ecx                 { ECX = length of MatchString + null }
  dec   ecx                 { ECX = length of MatchString }
  mov   edx, ecx