home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TURBO.ZIP / TSTATTR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-06-09  |  1.3 KB  |  61 lines
  1. PROGRAM TST2;
  2. VAR I,J,K:INTEGER;
  3.  
  4. FUNCTION WAITCHAR:INTEGER;
  5. VAR I:INTEGER;
  6.    FUNCTION INKEY:INTEGER;
  7.    VAR I:BYTE;
  8.    BEGIN INLINE ($B4/$08/$CD/$21/$88/$46/I); INKEY:=I;
  9.    END; {INKEY}
  10. BEGIN
  11.    I:=INKEY;
  12.    IF I=0 THEN WAITCHAR:=INKEY+256
  13.    ELSE WAITCHAR:=I;
  14. END; {WAITCHAR}
  15.  
  16. PROCEDURE RULE(I:INTEGER);
  17. VAR J,K:INTEGER;
  18. BEGIN
  19.    GOTOXY(1,I);
  20.    FOR J:=1 TO 8 DO WRITE(J:9,'0');
  21.    GOTOXY(1,I+1);
  22.    FOR J:=1 TO 7 DO BEGIN
  23.       FOR K:=1 TO 4 DO WRITE(CHR(196));
  24.       WRITE(CHR(194));
  25.       FOR K:=1 TO 4 DO WRITE(CHR(196));
  26.       WRITE(CHR(197));
  27.    END;
  28.    FOR K:=1 TO 4 DO WRITE(CHR(196));
  29.    WRITE(CHR(194));
  30.    FOR K:=1 TO 4 DO WRITE(CHR(196));
  31.    WRITE(CHR(180));
  32. END {RULE};
  33.  
  34. BEGIN
  35.    FOR I:=2 TO 17 DO BEGIN
  36.       K:=I*160;
  37.       FOR J:=13 TO 79 DO MEM[$B800:K+J*2]:=J+52;
  38.    END;
  39.    RULE(1);
  40.    I:=0;
  41.    WHILE I<256 DO BEGIN
  42.       GOTOXY(1,(I MOD 16)+3);
  43.       WRITE(I:3);
  44.       WRITE(' ');
  45.       FOR J:=0 TO 7 DO BEGIN
  46.          K:=7-J;
  47.          IF ((($01 SHL K) AND I) <> 0) THEN WRITE('1') ELSE WRITE('0');
  48.       END;
  49.       K:=((I MOD 16)+2)*160+1;
  50.       FOR J:=13 TO 79 DO MEM[$B800:K+J*2]:=I;
  51.       IF (I MOD 16)=15
  52.       THEN BEGIN
  53.          GOTOXY(1,20);
  54.          WRITE('Press ESCAPE to exit:');
  55.          IF WAITCHAR=27 THEN I:=256
  56.       END;
  57.       I:=I+1;
  58.       IF I=256 THEN I:=0;
  59.    END;
  60. END.
  61.