strings.htm

对于学习很有帮助

begin
     StrLen := Length(aString);
     TNum   := 1;
     TEnd   := StrLen;
     while ((TNum <= TokenNum) and (TEnd <> 0)) do
     begin
          TEnd := Pos(SepChar,aString);
          if TEnd <> 0 then
          begin
               Token := Copy(aString,1,TEnd-1);
               Delete(aString,1,TEnd);
               Inc(TNum);
          end
          else
          begin
               Token := aString;
          end;
     end;
     if TNum >= TokenNum then
     begin
          GetToken1 := Token;
     end
     else
     begin
          GetToken1 := '';
     end;
end;

function NumToken(aString, SepChar: String):Byte;
{
parameters: aString : the complete string
            SepChar : a single character used as separator 
                      between the substrings
result    : the number of substrings
}

var
   RChar     : Char;
   StrLen    : Byte;
   TNum      : Byte;
   TEnd      : Byte;

begin
     if SepChar = '#' then
     begin
          RChar := '*'
     end
     else
     begin
         RChar := '#'
     end;
     StrLen := Length(aString);
     TNum   := 0;
     TEnd   := StrLen;
     while TEnd <> 0 do
     begin
          Inc(TNum);
          TEnd := Pos(SepChar,aString);
          if TEnd <> 0 then
          begin
               aString[TEnd] := RChar;
          end;
     end;
     NumToken1 := TNum;
end;
</PRE><HR>
<P><H1><A NAME="strings3">Replacing substrings</P></A></H1>
<P><I>From: [e-mail] (Michael Bialas)</I></P>

<PRE>
 Does anyone know a fast algorithm that replaces all occurences of any
substring sub1 to any string sub2 in any string str.
</PRE>

This should do the job: <P>

<HR><PRE>  function ReplaceSub(str, sub1, sub2: String): String;
  var
    aPos: Integer;
    rslt: String;
  begin
    aPos := Pos(sub1, str);
    rslt := '';
    while (aPos <> 0) do begin
      rslt := rslt + Copy(str, 1, aPos - 1) + sub2;
      Delete(str, 1, aPos + Length(sub1));
      aPos := Pos(sub1, str);
    end;
    Result := rslt + str;
  end;
</PRE><HR>

<P><H1><A NAME="strings4">Capitalize the first letter of each word in a string</P></A></H1>
<P><I>Erik Sperling Johansen &lt;[e-mail]&gt;</I></P>

<HR><PRE>
function LowCase(ch : CHAR) : CHAR;
begin
  case ch of
    'A'..'Z' : LowCase := CHR (ORD(ch)+31);
  else
    LowCase := ch;
  end;
end;

function Proper (source, separators : STRING) : STRING;
var
  LastWasSeparator : BOOLEAN;
  ndx              : INTEGER;
begin
  LastWasSeparator := TRUE;  
  ndx := 1;
  while (ndx&lt;=Length(source)) do begin
    if LastWasSeparator
    then source[ndx] := UpCase(source[ndx])
    else source[ndx] := LowCase(source[ndx]);
    LastWasSeparator := Pos(source[ndx], separators)&gt;0;
    inc(ndx);
  end;
  Result := source;
end;
</PRE><HR>

<P><I>From: "Cleon T. Bailey" &lt;[e-mail]&gt;</I></P>


<HR><PRE>
Function  TfrmLoadProtocolTable.ToMixCase(InString: String): String;
Var I: Integer;
Begin
  Result := LowerCase(InString);
  Result[1] := UpCase(Result[1]);
  For I := 1 To Length(InString) - 1 Do Begin
    If (Result[I] = ' ') Or (Result[I] = '''') Or (Result[I] = '"')
    Or (Result[I] = '-') Or (Result[I] = '.')  Or (Result[I] = '(') Then
      Result[I + 1] := UpCase(Result[I + 1]);
  End;
End;
</PRE><HR>

<P><I>From: "Paul Motyer" &lt;[e-mail]&gt;</I></P>

Both Tim Stannard's and Cleon T. Bailey's functions will bomb in D2 if sent
an empty string (where accessing InString[1] causes an access violation,
the second attempt will do the same if the last character is in the set.<p>

try this instead:

<HR><PRE>
function proper(s:string):string;
var t:string;
    i:integer;
    newWord:boolean;
begin
if s='' then exit;
s:=lowercase(s);
t:=uppercase(s);
newWord:=true;
for i:=1 to length(s) do
    begin
    if newWord and (s[i] in ['a'..'z']) then
       begin s[i]:=t[i]; newWord:=false; continue; end;
    if s[i] in ['a'..'z',''''] then continue;
    newWord:=true;
    end;
result:=s;
end;
</PRE><HR>

<P><H1><A NAME="strings5">How do I determine if two strings sound alike?</P></A></H1>
<P><I>{ This code came from Lloyd's help file! }</I></P>

Soundex function--determines whether two words sound alike. 
Written after reading an article in PC Magazine about the Soundex algorithm.  
Pass the function a string.  It returns a Soundex value string.  
This value can be saved in a database or compared to another Soundex value.  If two words have the same Soundex value, then they sound alike (more or less). <p>

 Note that the Soundex algorithm ignores the first letter of a word.  
Thus, "won" and "one" will have different Soundex values, but "Won" and "Wunn" will have the same values.<P>

 Soundex is especially useful in databases when one does not know how to spell a last name.<P>

<HR><PRE>Function Soundex(OriginalWord: string): string;
var
  Tempstring1, Tempstring2: string;
  Count: integer;
begin
  Tempstring1 := '';
  Tempstring2 := '';
  OriginalWord := Uppercase(OriginalWord); {Make original word uppercase}
  Appendstr(Tempstring1, OriginalWord[1]); {Use the first letter of the word}
  for Count := 2 to length(OriginalWord) do
    {Assign a numeric value to each letter, except the first}

    case OriginalWord[Count] of
      'B','F','P','V': Appendstr(Tempstring1, '1');
      'C','G','J','K','Q','S','X','Z': Appendstr(Tempstring1, '2');
      'D','T': Appendstr(Tempstring1, '3');
      'L': Appendstr(Tempstring1, '4');
      'M','N': Appendstr(Tempstring1, '5');
      'R': Appendstr(Tempstring1, '6');
      {All other letters, punctuation and numbers are ignored}
    end;
  Appendstr(Tempstring2, OriginalWord[1]);
  {Go through the result removing any consecutive duplicate numeric values.}

  for Count:=2 to length(Tempstring1) do
    if Tempstring1[Count-1]<>Tempstring1[Count] then
        Appendstr(Tempstring2,Tempstring1[Count]);
  Soundex:=Tempstring2; {This is the soundex value}
end;
</PRE><HR>
SoundAlike--pass two strings to this function.  It returns True if they sound alike, False if they don't.  Simply calls the Soundex function. <p>

<HR><PRE>Function SoundAlike(Word1, Word2: string): boolean;
begin
  if (Word1 = '') and (Word2 = '') then result := True
  else
  if (Word1 = '') or (Word2 = '') then result := False
  else
  if (Soundex(Word1) = Soundex(Word2)) then result := True
  else result := False;
end;

</PRE><HR>

<P><H1><A NAME="strings6">What are the values for the virtual keys?</P></A></H1>

<PRE>
  vk_LButton   = $01;
  vk_RButton   = $02;
  vk_Cancel    = $03;
  vk_MButton   = $04;   { NOT contiguous with L & RBUTTON }
  vk_Back      = $08;
  vk_Tab       = $09;
  vk_Clear     = $0C;
  vk_Return    = $0D;
  vk_Shift     = $10;
  vk_Control   = $11;
  vk_Menu      = $12;
  vk_Pause     = $13;
  vk_Capital   = $14;
  vk_Escape    = $1B;
  vk_Space     = $20;
  vk_Prior     = $21;
  vk_Next      = $22;

  vk_End       = $23;
  vk_Home      = $24;
  vk_Left      = $25;
  vk_Up        = $26;
  vk_Right     = $27;
  vk_Down      = $28;
  vk_Select    = $29;
  vk_Print     = $2A;
  vk_Execute   = $2B;
  vk_SnapShot  = $2C;
{ vk_Copy      = $2C not used by keyboards }
  vk_Insert    = $2D;
  vk_Delete    = $2E;
  vk_Help      = $2F;
{ vk_A thru vk_Z are the same as their ASCII equivalents: 'A' thru 'Z' }
{ vk_0 thru vk_9 are the same as their ASCII equivalents: '0' thru '9' }

  vk_NumPad0   = $60;
  vk_NumPad1   = $61;
  vk_NumPad2   = $62;
  vk_NumPad3   = $63;
  vk_NumPad4   = $64;
  vk_NumPad5   = $65;
  vk_NumPad6   = $66;
  vk_NumPad7   = $67;
  vk_NumPad8   = $68;
  vk_NumPad9   = $69;
  vk_Multiply  = $6A;
  vk_Add       = $6B;
  vk_Separator = $6C;
  vk_Subtract  = $6D;
  vk_Decimal   = $6E;
  vk_Divide    = $6F;
  vk_F1        = $70;
  vk_F2        = $71;
  vk_F3        = $72;
  vk_F4        = $73;
  vk_F5        = $74;

  vk_F6        = $75;
  vk_F7        = $76;
  vk_F8        = $77;
  vk_F9        = $78;
  vk_F10       = $79;
  vk_F11       = $7A;
  vk_F12       = $7B;
  vk_F13       = $7C;
  vk_F14       = $7D;
  vk_F15       = $7E;
  vk_F16       = $7F;
  vk_F17       = $80;
  vk_F18       = $81;
  vk_F19       = $82;
  vk_F20       = $83;
  vk_F21       = $84;
  vk_F22       = $85;
  vk_F23       = $86;
  vk_F24       = $87;
  vk_NumLock   = $90;
  vk_Scroll    = $91;
</PRE>

<P><I>{ This code came from Lloyd's help file! }</I></P>



<HR SIZE="6" COLOR="#00FF00">
<FONT SIZE="2">
<a href="mailto:[e-mail]">Please email me</a> and tell me if you liked this page.<BR>
<SCRIPT LANGUAGE="JavaScript">
<!--
	document.write("Last modified " + document.lastModified);
// -->
</SCRIPT><P>
<TABLE BORDER=0 ALIGN="CENTER">
<TR>
	<TD>This page has been created with </TD>
	<TD> <A HREF="http://www.dexnet.com./homesite.html"><IMG SRC="../images/hs25ani.gif" WIDTH=88 HEIGHT=31 BORDER=0 ALT="HomeSite 2.5b">
</A></TD>
</TR>
</TABLE>

</FONT>


</BODY>
</HTML>