home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / PASCAL / PERFORM / UPPER.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-28  |  3KB  |  94 lines
  1. {$IFDEF VER70}
  2. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X+}
  3. {$ELSE}
  4. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S+,V-,X+}
  5. {$ENDIF}
  6. unit Upper;
  7. interface
  8. {
  9.     Borland Pascal (Objects) 7.0
  10.     Author: Bob Swart, released to Public Domain 1/93
  11.     Code size: 360 bytes
  12.     Data size:   0 bytes
  13.     -------------------------------------------------------------------------
  14.     This unit contains functions and procedures for string capitalisation.
  15. }
  16.  
  17.   function Upper0({var} Str: String): String;
  18.  
  19.   function Upper1(var Str: String): String;
  20.  
  21.   procedure Upper2(var Str: String);
  22.  
  23.   function Upper3(Str: String): String;
  24.  
  25.   procedure Upper4(var Str: String);
  26.   InLine(
  27.     $8C/$DA/          {     mov   DX,DS                }
  28.     $5E/              {     pop   SI                   }
  29.     $1F/              {     pop   DS                   }
  30.     $AC/              {     lodsb                      }
  31.     $30/$E4/          {     xor   AH,AH                }
  32.     $89/$C1/          {     mov   CX,AX                }
  33.     $E3/$13/          {     jcxz  @3                   }
  34.     $B3/Ord('a')/     {     mov   BL,'a'               }
  35.     $B7/Ord('z')/     {     mov   BH,'z'               }
  36.     $AC/              { @1: lodsb                      }
  37.     $38/$D8/          {     cmp   AL,BL                }
  38.     $72/$08/          {     jb    @2                   }
  39.     $38/$F8/          {     cmp   AL,BH                }
  40.     $77/$04/          {     ja    @2                   }
  41.     $80/$6C/$FF/$20/  {     sub   BYTE PTR [SI-01],$20 }
  42.     $E2/$F1/          { @2: loop  @1                   }
  43.     $8E/$DA);         { @3: mov   DS,DX                }
  44.  
  45. implementation
  46.  
  47.   function Upper0({var} Str: String): String;
  48.   var len: Byte absolute Str;
  49.       i: Integer;
  50.   begin
  51.     Upper0[0] := Char(len);
  52.     for i:=1 to len do Upper0[i] := UpCase(Str[len])
  53.   end {Upper0};
  54.  
  55.   function Upper1(var Str: String): String;
  56.   var len: Byte absolute Str;
  57.       i: Integer;
  58.   begin
  59.     Upper1[0] := Char(len);
  60.     for i:=1 to len do Upper1[i] := UpCase(Str[len])
  61.   end {Upper1};
  62.  
  63.   procedure Upper2(var Str: String);
  64.   var len: Byte absolute Str;
  65.       i: Integer;
  66.   begin
  67.     for i:=1 to len do Str[i] := UpCase(Str[i])
  68.   end {Upper2};
  69.  
  70.   function Upper3(Str: String): String; Assembler;
  71.   ASM
  72.         mov   DX,DS
  73.         lds   SI,Str
  74.         les   DI,@Result
  75.         cld
  76.         lodsb
  77.         stosb
  78.         xor   AH,AH
  79.         mov   CX,AX
  80.         jcxz  @3
  81.         mov   BL,'a'
  82.         mov   BH,'z'
  83.     @1: lodsb
  84.         cmp   AL,BL
  85.         jb    @2
  86.         cmp   AL,BH
  87.         ja    @2
  88.         sub   AL,$20
  89.     @2: stosb
  90.         loop  @1
  91.     @3: mov   DS,DX
  92.   end {Upper3};
  93. end.
  94.