home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 04 / tricks / upper.pas < prev    next >
Pascal/Delphi Source File  |  1991-01-08  |  2KB  |  58 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      UPPER.PAS                         *)
  3. (*           (c) 1991 Gerd Cebulla & TOOLBOX              *)
  4. (* ------------------------------------------------------ *)
  5. UNIT Upper;
  6.  
  7. INTERFACE
  8.  
  9. USES Dos;
  10.  
  11.   FUNCTION UpCase(Zeichen : CHAR) : CHAR;
  12.  
  13. IMPLEMENTATION
  14.  
  15. VAR
  16.   DosUpCase : Pointer;
  17.  
  18.   FUNCTION UpCase (Zeichen : CHAR) : CHAR;
  19.   BEGIN
  20.     IF (Zeichen < #128) OR (DosUpCase = NIL) THEN
  21.       UpCase := System.UpCase(Zeichen)
  22.     ELSE INLINE
  23.       ($8A/$86/Zeichen/    { mov  al, Zeichen[bp] }
  24.        $FF/$1E/DosUpCase/  { call far [DosUpCase] }
  25.        $88/$86/UpCase);    { mov  UpCase[bp], al  }
  26.     END;
  27.  
  28.   PROCEDURE UpCaseInit;
  29.   TYPE
  30.     CountryBuffer = RECORD
  31.                       Fill1     : ARRAY [ 0..17] OF BYTE;
  32.                       UpCasePtr : Pointer;
  33.                       Fill2     : ARRAY [22..33] OF BYTE;
  34.                     END;
  35.   VAR
  36.     CountryBuf : ^CountryBuffer;
  37.     Regs       : Registers;
  38.   BEGIN
  39.     Regs.AH := $30;
  40.     MsDos(Regs);             { DOS-Version abfragen }
  41.     IF Regs.AL < 3 THEN
  42.       DosUpCase := NIL
  43.     ELSE BEGIN
  44.       New(CountryBuf);
  45.       Regs.AX := $3800;
  46.       Regs.DS := Seg(CountryBuf^);
  47.       Regs.DX := Ofs(CountryBuf^);
  48.       MsDos(Regs);
  49.       DosUpCase := CountryBuf^.UpCasePtr;
  50.       Dispose(CountryBuf);
  51.     END;
  52.   END;
  53.  
  54. BEGIN
  55.   UpCaseInit;
  56. END.
  57. (* ------------------------------------------------------ *)
  58. (*                Ende von UPPER.PAS                      *)