home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / tiftool / delatt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-09  |  1.9 KB  |  93 lines
  1.  
  2. PROGRAM DELATT;
  3. { LÖSCHEN VIDEO- ATTRIBUTE }
  4.  
  5. USES  CRT,DOS;
  6.  
  7.  
  8. TYPE  SCRINH = RECORD C,A : BYTE; END;
  9.  
  10.  
  11. CONST EGAPAL : ARRAY[0..15] OF BYTE = (0,1,2,3,4,5,6,7,
  12.                                        $38,9,$12,$1B,$24,$2D,$36,$3F);
  13.  
  14.  
  15. VAR   I,J     : BYTE;
  16.       CH      : CHAR;
  17.       AUS     : TEXT;
  18.       SCREEN  : ARRAY[0..24,0..79] OF SCRINH ABSOLUTE $B800:0;
  19.  
  20.  
  21. PROCEDURE SETBLINK(ON:BOOLEAN);
  22. VAR   R  : REGISTERS;
  23. BEGIN
  24.   WITH R DO BEGIN
  25.     AX := $1003;
  26.     IF ON THEN BL := 1 ELSE BL := 0;
  27.     INTR($10,R);
  28.   END; { WITH R }
  29. END; { SETBLINK }
  30.  
  31.  
  32. PROCEDURE NORMALCURSOR;
  33. VAR   R  : REGISTERS;
  34. BEGIN
  35.   WITH R DO BEGIN
  36.     AH := 1;
  37.     CX := $0607;
  38.     INTR($10,R);
  39.   END; { WITH R }
  40. END; { NORMALCURSOR }
  41.  
  42.  
  43. PROCEDURE RAHMENFARBE(FARBE:BYTE);
  44. VAR   R  : REGISTERS;
  45. BEGIN
  46.   R.AH := $10;
  47.   R.AL := $01;
  48.   R.BH := FARBE;
  49.   INTR($10,R);
  50. END; { RAHMENFARBE }
  51.  
  52.  
  53. PROCEDURE EGAPALETTE_DEFAULT;
  54. VAR   R  : REGISTERS;
  55.       I  : BYTE;
  56. BEGIN
  57.   FOR I := 0 TO 15 DO BEGIN
  58.     R.AH := $10;
  59.     R.AL := $00;
  60.     R.BL := I;
  61.     R.BH := EGAPAL[I];
  62.     INTR($10,R);
  63.   END;
  64. END; { EGAPALETTE_DEFAULT }
  65.  
  66.  
  67. BEGIN { HAUPTPROGRAMM }
  68.   IF LASTMODE <> 3 THEN TEXTMODE(CO80);
  69.  
  70. { DIE 16 AUS 64- FARBEN EGA- PALETTE AUF DEFAULT- WERT SETZEN }
  71.   EGAPALETTE_DEFAULT;
  72.  
  73. { VON DER ZEILE, IN DER SICH DER CURSOR BEFINDET, BIS ZUM ENDE DES
  74.   BILDSCHIRMS DAS VIDEO- ATTRIBUT LÖSCHEN
  75. }
  76.   FOR I := PRED(WHEREY) TO 25 DO
  77.     FOR J := 0 TO 79 DO SCREEN[I,J].A := 7;
  78. { AUCH RELIKTE IM TASTATURBUFFER KÖNNEN MANCHMAL STÖREN }
  79.   WHILE KEYPRESSED DO CH := READKEY;
  80.  
  81.   NORMALCURSOR;
  82.   SETBLINK(TRUE);
  83.   TEXTATTR := $07;
  84.   RAHMENFARBE(0);
  85.  
  86. { DAS VIDEO- ATTRIBUT FÜR ANSI.SYS LÖSCHEN - STÖRT AUCH OHNE ANSI.SYS NICHT }
  87.   ASSIGN(AUS,'CON');
  88.   REWRITE(AUS);              { 12345 }
  89.   WRITE(AUS,^[,'[0m'#8#8#8#8#8'     '#8#8#8#8#8);
  90.   CLOSE(AUS);
  91. END.
  92.  
  93.