home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / tricks / hardcopy.inc < prev    next >
Encoding:
Text File  |  1990-11-06  |  3.9 KB  |  120 lines
  1. (* ------------------------------------------------- *)
  2. (*                HARDCOPY.PAS                       *)
  3. (*     Verbesserung der Hardcopy-Bibliothek          *)
  4. (*               in TOOLBOX 10'89                    *)
  5. (* ------------------------------------------------- *)
  6. (*      ersetzt alte Prozedur IBMHardCopy            *)
  7. (*                                                   *)
  8. (*     (C) 1991  Paul Konietzko & TOOLBOX            *)
  9. (* ------------------------------------------------- *)
  10.  
  11.   PROCEDURE IBMHardCopy;
  12.   LABEL 9;
  13.   CONST
  14.     xmax = 800;
  15.     p : ARRAY[0..7] OF BYTE = (128,64,32,16,8,4,2,1);
  16.   var
  17.     g : array[0..xmax] of byte;
  18.     modus, page, d                 : BYTE;
  19.     x, y, i, j, n1, n2, xres, yres : WORD;
  20.   BEGIN
  21.     Regs.ah := $0F;
  22.     Intr($10, Regs);
  23.     modus := Regs.al;
  24.     page := Regs.bh;
  25.     CASE modus OF
  26.       $04, $05, $0d, $13 : BEGIN
  27.                              xres := 320; yres := 200;
  28.                            END;
  29.       $06, $0E           : BEGIN
  30.                              xres := 640; yres := 200;
  31.                            END;
  32.       $40, $48           : BEGIN
  33.                              xres := 640; yres := 400;
  34.                            END;
  35.       $0F, $10, $2d      : BEGIN
  36.                              xres := 640; yres := 350;
  37.                            END;
  38.       $11, $12, $25, $2E : BEGIN
  39.                              xres := 640; yres := 480;
  40.                            END;
  41.       $29, $30           : BEGIN
  42.                              xres := 800; yres := 600;
  43.                            END;
  44.     END;
  45.     n2 := xres DIV 256;
  46.     n1 := xres MOD 256;
  47.     PrintString(#27#64);
  48.     IF error THEN GOTO 9;       { ESC @ = reset }
  49.     PrintString(#27#85#49);
  50.     IF error THEN GOTO 9;       { ESC U 1 = unidirectional }
  51.  
  52.     FOR i := 0 TO (yres DIV 8) DO BEGIN
  53.       FOR x := 0 TO Pred(xres) DO BEGIN
  54.         d := 0;
  55.         FOR j := 0 TO 7 DO BEGIN
  56.           y := i * 8 + j;
  57.           Regs.ah := $0d;
  58.           Regs.bh := page;
  59.           Regs.cx := x;
  60.           Regs.dx := y;
  61.           Intr($10, Regs);
  62.           IF Regs.al > 0 THEN d := d + p[j];
  63.         END;
  64.  
  65.         g[x] :=d;
  66.       END;
  67.  
  68.       PrintString(#27#51#23);
  69.       IF error THEN GOTO 9;   { ESC 3 23 = 23/216 Zoll }
  70.       PrintString(#13#10);
  71.       IF error THEN GOTO 9;   { CR LF }
  72.       PrintString(#9#27#76 + Chr(n1) + Chr(n2));
  73.       IF error THEN GOTO 9;   { TAB ESC L }
  74.       FOR x := 0 TO Pred(xres) DO BEGIN
  75.          PrintString(chr(g[x]));
  76.       END;
  77.  
  78.       PrintString(#27#51#0);
  79.       IF error THEN GOTO 9;   {ESC 3 1 = 1/216 Zoll }
  80.       PrintString(#13#10);
  81.       IF error THEN GOTO 9;   { CR LF }
  82.       PrintString(#9#27#76 + Chr(n1) + Chr(n2));
  83.       IF error THEN GOTO 9;   { TAB ESC L }
  84.       FOR x := 0 TO Pred(xres) DO BEGIN
  85.         PrintString(chr(g[x]));
  86.       END;
  87.  
  88.       PrintString(#27#51#1);
  89.       IF error THEN GOTO 9;   {ESC 3 1 = 1/216 Zoll }
  90.       PrintString(#13#10);
  91.       IF error THEN GOTO 9;   { CR LF }
  92.       PrintString(#9#27#76 + Chr(n1) + Chr(n2));
  93.       IF error THEN GOTO 9;   { TAB ESC L }
  94.       FOR x := 0 TO Pred(xres) DO BEGIN
  95.         PrintString(chr(g[x]));
  96.       END;
  97.  
  98.       PrintString(#27#51#0);
  99.       IF error THEN GOTO 9;   {ESC 3 1 = 1/216 Zoll }
  100.       PrintString(#13#10);
  101.       IF error THEN GOTO 9;   { CR LF }
  102.       PrintString(#9#27#76 + Chr(n1) + Chr(n2));
  103.       IF error THEN GOTO 9;   { TAB ESC L }
  104.       FOR x := 0 TO Pred(xres) DO BEGIN
  105.         PrintString(chr(g[x]));
  106.       END;
  107.  
  108.     END;
  109.     PrintString(#27#65#12#27#50);
  110.     IF error THEN GOTO 9;       { ESC 12/72" Zoll }
  111.     PrintString(#27#85#48);
  112.     IF error THEN GOTO 9;  { ESC U 0 = unidirect. off }
  113.     PrintString(#27#64);
  114.     IF error THEN GOTO 9;                      { Reset }
  115. 9:
  116.   END;
  117. (* ------------------------------------------------- *)
  118. (*              Ende von HARDCOPY.PAS                *)
  119.  
  120.