home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / PAS_0493.ZIP / INTCHAR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-15  |  3.6 KB  |  123 lines
  1. {─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 299 of 318                                                               
  3. From : Bo Bendtsen                         2:231/111.0          09 Apr 93  12:28 
  4. To   : All                                                                       
  5. Subj : International characters                                               
  6. ────────────────────────────────────────────────────────────────────────────────
  7. Hello All!          
  8.  
  9.  
  10.   Upper/lower changing of strings are always a difficult problem,
  11.   but as a person living in Denmark i must normally care about
  12.   danish characters, i know a lot of developers does not care about
  13.   international character and just use the normal UPCASE routines.
  14.   I advise you to use these routines or make some that has the
  15.   same effect, so we will not have any problems when searching for
  16.   uppercased strings.
  17.  
  18.   Made available to everyone 1993 by Bo Bendtsen 2:231/111 +4542643827
  19.  
  20.      Lowcase   Upper/high/capital letters
  21.      æ         Æ
  22.      ¢         ¥
  23.      å         Å
  24.      ä         Ä
  25.      ç         Ç
  26.      é         É
  27.      ö         Ö
  28.      ñ         Ñ
  29.      ü         Ü
  30.  
  31. }
  32. Unit IntChar;
  33. (**) INTERFACE (**)
  34. Function UpChar(Ch : Char) : Char;
  35. Function StUpCase(S : String) : String;
  36. Function LowChar(Ch : Char) : Char;
  37. Function StLowCase(S : String) : String;
  38. Function StToggleCase(S : String) : String;
  39. Function StSmartCase(S : String) : String;
  40.  
  41. (**) IMPLEMENTATION (**)
  42. Function UpChar(Ch : Char) : Char;
  43. { Uppercase a char }
  44. Begin
  45.   If Ord(Ch) In [97..122] Then Ch := Chr(Ord(Ch) - 32)
  46.   Else If Ord(Ch) > 90 Then
  47.     If Ch='æ' Then Ch:='Æ'
  48.     Else If Ch='¢' Then Ch:='¥' Else If Ch='å' Then Ch:='Å'
  49.     Else If Ch='ä' Then Ch:='Ä' Else If Ch='ç' Then Ch:='Ç'
  50.     Else If Ch='é' Then Ch:='É' Else If Ch='ö' Then Ch:='Ö'
  51.     Else If Ch='ñ' Then Ch:='Ñ' Else If Ch='ü' Then Ch:='Ü';
  52.   UpChar:=Ch;
  53. End;
  54.  
  55. Function StUpCase(S : String) : String;
  56. { Uppercase a string }
  57. Var
  58.   SLen : Byte Absolute S;
  59.   x    : Integer;
  60. Begin
  61.   For x := 1 To SLen Do S[x]:=UpChar(S[x]);
  62.   StUpCase := S;
  63. End;
  64.  
  65. Function LowChar(Ch : Char) : Char;
  66. { lowercase a char }
  67. Begin
  68.   If Ord(Ch) In [65..90] Then Ch := Chr(Ord(Ch) + 32)
  69.   Else If Ord(Ch) > 122 Then
  70.     If Ch='Æ' Then Ch:='æ'
  71.     Else If Ch='¥' Then Ch:='¢' Else If Ch='Å' Then Ch:='å'
  72.     Else If Ch='Ä' Then Ch:='ä' Else If Ch='Ç' Then Ch:='ç'
  73.     Else If Ch='É' Then Ch:='é' Else If Ch='Ö' Then Ch:='ö'
  74.     Else If Ch='Ñ' Then Ch:='ñ' Else If Ch='Ü' Then Ch:='ü';
  75.   LowChar := Ch;
  76. End;
  77.  
  78. Function StLowCase(S : String) : String;
  79. { Lowercase a string }
  80. Var
  81.   SLen : Byte Absolute S;
  82.   i    : Integer;
  83. Begin
  84.   For i := 1 To SLen Do S[i]:=LowChar(S[i]);
  85.   StLowCase := S;
  86. End;
  87.  
  88. Function StToggleCase(S : String) : String;
  89. { lower = upper and upper = lower }
  90. Var
  91.   SLen : Byte Absolute S;
  92.   i    : Integer;
  93. Begin
  94.   For i := 1 To SLen Do
  95.   Begin
  96.     If Ord(S[i]) In [65..90] Then S[i] := Chr(Ord(S[i]) + 32)
  97.     Else If Ord(S[i]) In [97..122] Then S[i] := Chr(Ord(S[i]) - 32)
  98.     Else If Pos(S[i],'æ¢åäçéöñü') <> 0 Then S[i]:=UpChar(S[i])
  99.     Else If Pos(S[i],'ÆÅ¥ÇÄÖÉÜÑ')<> 0 Then S[i]:=LowChar(S[i]);
  100.   End;
  101.   StToggleCase := S;
  102. End;
  103.  
  104. Function StSmartCase(S : String) : String;
  105. { bO bEnDTSen will be converted into : Bo Bendtsen }
  106. Var
  107.   SLen : Byte Absolute S;
  108.   i    : Integer;
  109. Begin
  110.   s:=StLowCase(s);
  111.   For i := 1 To SLen Do
  112.   Begin
  113.     If i=1 Then S[1]:=UpChar(S[1])
  114.     Else if S[i-1]=' ' Then S[i]:=UpChar(S[i])
  115.     Else if (Ord(S[i-1]) In [32..64]) And (S[i-1]<>'''') Then
  116. S[i]:=UpChar(S[i]);
  117.   End;
  118.   StSmartCase := S;
  119. End;
  120.  
  121.  
  122.  
  123. End.