home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 04 / tricks / graphhc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-01-10  |  2.5 KB  |  85 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      GRAPHHC.PAS                       *)
  3. (*      Prozedur zum Grafikausdruck eines beliebigen      *)
  4. (*                   Bildschirmbereichs                   *)
  5. (*         (c) 1989 Christian Ramsauer  &  TOOLBOX        *)
  6. (* ------------------------------------------------------ *)
  7. UNIT GraphHC;
  8.  
  9. INTERFACE
  10.  
  11. USES Crt, Graph, Printer;
  12.  
  13. PROCEDURE GraphHardcopy;
  14.      (* Diese Prozedur muß aufgerufen werden, um in einem *)
  15.      (* eigenen Programm eine Grafikhardcopy am Drucker   *)
  16.      (* auszugeben !                                      *)
  17.  
  18. IMPLEMENTATION
  19.  
  20. PROCEDURE GraphHardcopy;
  21.  
  22. VAR  x1, x2, y1, y2, xmax, ymax, grmode : INTEGER;
  23.      ch                                 : CHAR;
  24.      gr                                 : WORD;
  25.      bits                               : BYTE;
  26.      p                                  : POINTER;
  27.  
  28. PROCEDURE Hardcopy(x1, y1, x2, y2 : WORD);
  29. CONST  bt : ARRAY[1..6] OF BYTE = (128,64,32,16,8,4);
  30. VAR    i, j, k : INTEGER;
  31. BEGIN
  32.   k := x2 - x1 + 1;
  33.   WriteLn(LST, #27, 'A', #6, #27, '2');
  34.   REPEAT
  35.     Write(LST,#27,'L',Chr(k MOD 256),Chr(k DIV 256));
  36.     FOR i := x1 TO x2 DO BEGIN
  37.       bits := 0;
  38.       j    := 0;
  39.       WHILE (y1 +j <= y2) AND (j < 6) DO BEGIN
  40.         j := j + 1;
  41.         IF GetPixel(i, y1 + j - 1) <> 0 THEN
  42.           bits := bits + bt[j];
  43.       END;
  44.       Write(LST, Chr(bits));
  45.     END;
  46.     WriteLn(LST);
  47.     y1 := y1 + 6;
  48.   UNTIL y1 >= y2;
  49. END;
  50.  
  51. BEGIN
  52.   xmax := GetMaxX;
  53.   ymax := GetMaxY;
  54.   gr   := ImageSize(0, 0, xmax, ymax);
  55.   GetMem(p, gr);
  56.   GetImage(0, 0, xmax, ymax, p^);
  57.   grmode := GetGraphMode;
  58.   RestoreCrtMode;
  59.   ClrScr;
  60.   REPEAT
  61.     WriteLn('Grafik-Hardcopy-Routine:');
  62.     WriteLn;
  63.     Write('x-Koordinate der linken oberen Ecke: ');
  64.     ReadLn(x1);
  65.     Write('y-Koordinate der linken oberen Ecke: ');
  66.     ReadLn(y1);
  67.     Write('x-Koordinate der rechten unteren Ecke: ');
  68.     ReadLn(x2);
  69.     Write('y-Koordinate der rechten unteren Ecke: ');
  70.     ReadLn(y2);
  71.     WriteLn;
  72.   UNTIL (x1 > -1) AND (x2 < xmax) AND (x1 <= x2) AND
  73.         (y1 > -1) AND (y2 < ymax) AND (y1 <= y2);
  74.   Write('Hardcopy ausführen ? (J/N) ');
  75.   ch := ReadKey;
  76.   SetGraphMode(grmode);
  77.   PutImage(0, 0, p^, 0);
  78.   FreeMem(p, gr);
  79.   IF UpCase(ch) = 'J' THEN Hardcopy(x1, y1, x2, y2);
  80. END;
  81.  
  82. END.
  83. (* ------------------------------------------------- *)
  84. (*                Ende von GRAPHHC.PAS               *)
  85.