home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / das_buch / dos / ansi.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-13  |  2.9 KB  |  115 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X-}
  2. (*===================================================================*)
  3. (*                              ANSI.PAS                             *)
  4. (*            Copyright (C) 1993 te-wi Verlag, München               *)
  5. (*    Die Unit stellt ein Inferface zum ANSI-Treiber zur Verfügung   *)
  6. (*===================================================================*)
  7.  
  8. UNIT ANSI;
  9.  
  10. INTERFACE
  11.  
  12. VAR
  13.   CON: Text;
  14.  
  15. (*   Überprüfung, ob ein ANSI-Treiber installiert ist                *)
  16. FUNCTION AnsiSys: BOOLEAN;
  17.  
  18. (* Übergabe von beliebigen Werten an den ANSI-Treiber                *)
  19. PROCEDURE AnsiOut(s: SHORTINT);
  20.  
  21. (* ANSI-Farbeinschaltung: Attribut 7 = grau                          *)
  22. PROCEDURE AnsiGray;
  23.  
  24. (* ANSI-Farbeinschaltung: Attribut 15 = weiß                         *)
  25. PROCEDURE AnsiWhite;
  26.  
  27. (* ANSI-Farbeinschaltung: Attribut 14 = gelb                         *)
  28. PROCEDURE AnsiYellow;
  29.  
  30. IMPLEMENTATION
  31.  
  32. USES
  33.   Crt;
  34.  
  35. CONST
  36.   ESC = #27;
  37.   ansiinstalled: BOOLEAN = FALSE;
  38.  
  39. FUNCTION AnsiSys: BOOLEAN;
  40. (* Test ob ANSI.SYS installiert ist; da alle Ausgaben über die       *)
  41. (* Standard-Ausgabe gehen, müssen die Bildschirmfarben über ANSI-Se- *)
  42. (* quenzen gesteuert werden. Ist ANSI.SYS nicht installiert, werden  *)
  43. (* keine ANSI-Steuerbefehle vom Programm ausgegeben.                 *)
  44. VAR
  45.   posold,
  46.   posnew  : BYTE;
  47. BEGIN
  48.   AnsiSys := FALSE;
  49.   posold  := WhereX;                                (* Spalte merken *)
  50.   Write(CON, Chr(27), '[2m');                       (* ANSI-Sequenz  *)
  51.   posnew  := WhereX;                                (* neue Position *)
  52.  
  53.   IF posnew = posold THEN AnsiSys := TRUE;(*Sequenz wurde verarbeitet*)
  54.  
  55.   GotoXY(1, WhereY);                             (* evtl. vorhandene *)
  56.   ClrEoL;                                        (* Zeichen löschen  *)
  57. END;
  58.  
  59. (*-------------------------------------------------------------------*)
  60.  
  61. PROCEDURE AnsiOut(s: SHORTINT);
  62. BEGIN
  63.   Write(CON, ESC + '[' , s , 'm');
  64. END;
  65.  
  66. (*-------------------------------------------------------------------*)
  67.  
  68. PROCEDURE AnsiGray;
  69. BEGIN
  70.   IF ansiinstalled THEN AnsiOut(0);
  71. END;
  72.  
  73. (*-------------------------------------------------------------------*)
  74.  
  75. PROCEDURE AnsiWhite;
  76. BEGIN
  77.   IF ansiinstalled THEN
  78.   BEGIN
  79.     AnsiOut(0);
  80.     AnsiOut(1);
  81.   END;
  82. END;
  83.  
  84. (*-------------------------------------------------------------------*)
  85.  
  86. PROCEDURE AnsiYellow;
  87. BEGIN
  88.   IF ansiinstalled THEN AnsiOut(33);
  89. END;
  90.  
  91. VAR
  92.   OldExitProc: Pointer;
  93.  
  94. {$F+}
  95. PROCEDURE ANSIExitProc;
  96. VAR
  97.   ExitProc: POINTER;
  98. BEGIN
  99.   Close(CON);
  100.   ExitProc := OldExitProc;
  101. END;
  102. {$F-}
  103.  
  104. (*-------------------------------------------------------------------*)
  105.  
  106. BEGIN
  107.   Assign(CON, '');
  108.   Append(CON);
  109.   ansiinstalled := AnsiSys;
  110.   OldExitProc := ExitProc;
  111.   ExitProc := @ANSIExitProc;
  112. END.
  113.  
  114. (*===================================================================*)
  115.