home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / tp_util / testbild.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-12-14  |  5.0 KB  |  231 lines
  1.  
  2. PROGRAM TESTBILD;
  3.  
  4. USES  CRT,TPERSATZ,DOS;
  5. { USES TPCRT,DOS;
  6.   UNIT TPCRT KANN DURCH CRT ERSETZT WERDEN, WENN AUF DIE PROZEDUREN
  7.   HIDDENCURSOR = CURSOR VERSTECKEN UND
  8.   NORMALCURSOR = CURSOR EINSCHALTEN
  9.   VERZICHTET WIRD.
  10. }
  11.  
  12. var   i,j,k     : integer;
  13.       X,Y,HGF   : BYTE;
  14.       R         : REGISTERS;
  15.       CH        : CHAR;
  16.       INTENS,KA : BOOLEAN;
  17.  
  18.  
  19. PROCEDURE KEYIN(XCH:CHAR); { CHARACTER IN KEYBOARD- BUFFER SCHREIBEN }
  20. { USES DOS }
  21. VAR   R  : REGISTERS;
  22. BEGIN
  23.   R.AH := 5;
  24.   R.CH := 0;        { SCANCODE WIRD HIER IGNORIERT }
  25.   R.CL := ORD(XCH); { ASCII- CODE }
  26.   INTR($16,R);
  27. END;
  28.  
  29.  
  30. PROCEDURE SETINTENS(INTENS:BOOLEAN);
  31. BEGIN
  32. { SETZEN INTENSIV STATT BLINKEN }
  33.   R.AH := $10;
  34.   R.AL := $03;
  35.   IF INTENS THEN R.BL := $00 ELSE R.BL := $01; { 0 = INTENSIV, 1 = BLINKEN }
  36.   INTR($10,R);
  37. END;
  38.  
  39.  
  40. PROCEDURE RAND;
  41. BEGIN
  42.     TEXTATTR := $1F;
  43.     GOTOXY(X,Y);
  44.     CASE X OF
  45.       2 : BEGIN
  46.             CASE Y OF
  47.               1  : BEGIN
  48.                      WRITE('╔');
  49.                      INC(X);
  50.                    END;
  51.              25  : BEGIN
  52.                      WRITE('╚');
  53.                      DEC(Y);
  54.                    END;
  55.             ELSE
  56.               WRITE('║');
  57.               DEC(Y);
  58.             END; { CASE }
  59.           END;
  60.      79 : BEGIN
  61.             CASE Y OF
  62.               1  : BEGIN
  63.                      WRITE('╗');
  64.                      INC(Y);
  65.                    END;
  66.              25  : BEGIN
  67.                      WRITE('╝');
  68.                      DEC(X,2);
  69.                    END;
  70.             ELSE
  71.               WRITE('║');
  72.               INC(Y);
  73.             END; { CASE }
  74.           END;
  75.     ELSE
  76.       CASE Y OF
  77.         1 : BEGIN
  78.               WRITE('══');
  79.               INC(X,2);
  80.             END;
  81.        25 : BEGIN
  82.               WRITE('══');
  83.               DEC(X,2);
  84.               IF X < 2 THEN X := 2;
  85.             END;
  86.       END; { CASE Y }
  87.     END; { CASE X }
  88.  
  89.     TEXTATTR := $10;
  90.     GOTOXY(X,Y);
  91.     CASE X OF
  92.       2 : BEGIN
  93.             CASE Y OF
  94.               1  : BEGIN
  95.                      WRITE('╔');
  96.                    END;
  97.              25  : BEGIN
  98.                      WRITE('╚');
  99.                    END;
  100.             ELSE
  101.               WRITE('║');
  102.             END; { CASE }
  103.           END;
  104.      79 : BEGIN
  105.             CASE Y OF
  106.               1  : BEGIN
  107.                      WRITE('╗');
  108.                    END;
  109.              25  : BEGIN
  110.                      WRITE('╝');
  111.                    END;
  112.             ELSE
  113.               WRITE('║');
  114.             END; { CASE }
  115.           END;
  116.     ELSE
  117.       CASE Y OF
  118.         1 : BEGIN
  119.               WRITE('══');
  120.             END;
  121.        25 : BEGIN
  122.               WRITE('══');
  123.             END;
  124.       END; { CASE Y }
  125.     END; { CASE X }
  126. END;
  127.  
  128.  
  129. PROCEDURE GFTEXT(HG,FG:BYTE;S:STRING);
  130. VAR   X,Y      : BYTE;
  131.       WMI,WMA  : WORD;
  132. BEGIN
  133.   WMI := WINDMIN;
  134.   WMA := WINDMAX;
  135.   X := WHEREX;
  136.   Y := WHEREY;
  137.   TEXTCOLOR(HG+16);
  138.   WINDOW(X+SUCC(LO(WMI)),Y+HI(WMI),X+LENGTH(S)+SUCC(LO(WMI)),Y+HI(WMI));
  139.   CLRSCR;
  140.   TEXTCOLOR(FG XOR HG + 16);
  141.   WRITE(S);
  142.   WINDOW(SUCC(LO(WMI)),SUCC(HI(WMI)),SUCC(LO(WMA)),SUCC(HI(WMA)));
  143.   GOTOXY(X+LENGTH(S),Y);
  144. END;
  145.  
  146.  
  147. begin
  148.   HIDDENCURSOR;
  149.   KA := FALSE;
  150.   IF PARAMCOUNT > 0 THEN BEGIN
  151.     IF PARAMSTR(1) = 'I' THEN SETINTENS(TRUE);
  152.     IF PARAMSTR(1) = 'B' THEN SETINTENS(FALSE);
  153.     IF PARAMSTR(1) = 'K' THEN KA := TRUE;
  154.   END;
  155.  
  156.   HGF := 1;
  157.   WINDOW(1,1,80,25);
  158.   TEXTATTR := $1F;
  159.   clrscr;
  160.   WRITE(' ╔'); FOR I := 3 TO 78 DO WRITE('═'); WRITE('╗');
  161.   FOR I := 2 TO 24 DO BEGIN
  162.     GOTOXY(2,I); WRITE('║');
  163.     GOTOXY(79,I); WRITE('║');
  164.   END;
  165.   GOTOXY(1,25);
  166.   WRITE(' ╚'); FOR I := 3 TO 78 DO WRITE('═'); WRITE('╝');
  167.   GOTOXY(27,3); WRITE('Testbild für Farbeinstellung');
  168.   GOTOXY(24,22); WRITE('Testbild B = Hintergrund blinkend');
  169.   GOTOXY(24,23); WRITE('Testbild I = Hintergrund intensiv');
  170.  
  171.   WINDOW(8,5,75,22);
  172.   for i := 0 to 15 do begin
  173.     textcolor(i);
  174.     for j := 0 to 7 do begin
  175.       textbackground(j);
  176.       write(' 12 ');
  177.     end; { next j }
  178.     TEXTATTR := $1F;
  179.     WRITE(' ');
  180.     textcolor(i);
  181.     for j := 0 to 7 do begin
  182.       textbackground(j);
  183.       TEXTCOLOR(I+16);
  184.       write(' 12 ');
  185.     end; { next j }
  186.     writeln;
  187.   end; { next i }
  188.  
  189.   WINDOW(1,1,80,25);
  190.   INTENS := FALSE;
  191.   X := 2; Y := 1;
  192.   I := 1;
  193.   REPEAT
  194.     IF KA THEN BEGIN
  195.  
  196.       FOR I := 0 TO 63 DO BEGIN
  197.         R.AH := $10;
  198.         R.AL := $00;
  199.         R.BH := I;
  200.         R.BL := 1;
  201.         INTR($10,R);
  202.         DELAY(50);
  203.       END;
  204.  
  205. (*
  206.       INTENS := NOT INTENS;
  207.       SETINTENS(INTENS);
  208.       FOR J := 1 TO I DO BEGIN END;
  209.       INC(I,50);
  210.       IF I > 20000 THEN BEGIN
  211.         I := 1;
  212.       END;
  213. *)
  214.     END ELSE BEGIN
  215.       RAND;
  216.       K := 0;
  217.       REPEAT
  218.         DELAY(1);
  219.         INC(K);
  220.       UNTIL KEYPRESSED OR (K > 80);
  221.     END;
  222.   UNTIL KEYPRESSED;
  223.  
  224.   CH := READKEY;
  225.   IF CH <> ^[ THEN KEYIN(CH);
  226.   NORMALCURSOR;
  227.   textcolor(7);
  228.   textbackground(0);
  229.   GOTOXY(1,25);
  230. end.
  231.