home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / hgrcopy.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-15  |  3.1 KB  |  83 lines
  1. (*------------------------------------------------------------------------*)
  2. (*                          HGRCOPY.PAS                                   *)
  3. (* Hardcopy-Prozedur zur Druckerausgabe von Bildschirmbereichen in vier   *)
  4. (* verschiedenen Groessen. Hier implementiert fuer IBM-PC und Turbo-      *)
  5. (* Pascal.                                                                *)
  6. (*------------------------------------------------------------------------*)
  7.  
  8. PROCEDURE hgrcopy (left, top, right, bottom, size : INTEGER);
  9.  
  10. CONST breite  = 639;              (* Bildschirmbreite IBM-PC HiRes 0..639 *)
  11.       hoehe   = 199;              (* Bildschirmhoehe  IBM-PC HiRes 0..199 *)
  12.       ptrres  = 640;              (* Breite einer Druckzeile des Druckers *)
  13.  
  14.       zweih1  : ARRAY [0..7] OF INTEGER = (128,64,32,16,8,4,2,1);
  15.       zweih2  : ARRAY [0..3] OF INTEGER = (192,48,12,3);
  16.       zweih4  : ARRAY [0..1] OF INTEGER = (240,15);
  17.       zweih8  : ARRAY [0..0] OF INTEGER = (255);
  18.  
  19. VAR   bitnumber, i, j, decrement, y, n, spalte : INTEGER;
  20.  
  21.    (*---------------------------------------------------------------------*)
  22.    (* folgende Funktion ist Implementationsabhaengig und soll den Wert
  23.       TRUE liefern, wenn der Bildpunkt (x,y) gesetzt ist, sonst wird
  24.       FALSE zurueckgegeben.                                               *)
  25.  
  26.    FUNCTION screenbit (x, y: INTEGER): BOOLEAN;
  27.  
  28.    BEGIN
  29.      screenbit := GetDotColor(x,y) > 0;
  30.    END;
  31.  
  32.    (*---------------------------------------------------------------------*)
  33.    (* ueberprueft den Bildschirmausschnitt auf Gueltigkeit:               *)
  34.  
  35.    FUNCTION params_ok: BOOLEAN;
  36.  
  37.    VAR ok : BOOLEAN;
  38.  
  39.    BEGIN
  40.      ok := TRUE;
  41.      IF (left < 0) OR (right > breite) OR (left > right)
  42.       OR (top < 0) OR (bottom > hoehe) OR (top > bottom)
  43.       OR NOT (size IN [1,2,4,8]) THEN
  44.        ok := FALSE;
  45.      bitnumber := size * (right-left+1);   (* Punkteanzahl pro Druckzeile *)
  46.      IF bitnumber > ptrres THEN
  47.        ok := FALSE;
  48.    END;
  49.  
  50.    (*---------------------------------------------------------------------*)
  51.  
  52. BEGIN
  53.   IF params_ok THEN
  54.   BEGIN
  55.     y := top;
  56.     decrement := 8 DIV size;
  57.     Write (Lst, Chr(27), Chr(51), Chr(24));       (* Graphikzeilenabstand *)
  58.     WHILE y <= bottom DO
  59.     BEGIN
  60.                     (* Anzahl folgender Grafikdaten dem Drucker mitteilen *)
  61.       Write (Lst, Chr(27), Chr(75), Chr(Lo(bitnumber)), Chr(Hi(bitnumber)));
  62.       FOR i := left TO right DO
  63.       BEGIN
  64.         spalte := 0;
  65.         FOR n := y TO Pred(y+decrement) DO
  66.           IF n <= bottom THEN
  67.             IF screenbit(i, n) THEN
  68.               CASE size  OF
  69.                 1: spalte := spalte OR zweih1[n-y];
  70.                 2: spalte := spalte OR zweih2[n-y];
  71.                 4: spalte := spalte OR zweih4[n-y];
  72.                 8: spalte := spalte OR zweih8[n-y];
  73.               END;
  74.         FOR j := 1 TO size DO
  75.           Write (Lst, Chr(spalte));
  76.       END;
  77.       WriteLn (Lst);
  78.       y := y + decrement;
  79.     END;
  80.     Write (Lst, Chr(27), Chr(50));              (* normaler Zeilenabstand *)
  81.   END;
  82. END; (* hgrcopy *)
  83.