home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
sonderh1
/
hgrcopy.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1987-04-15
|
3KB
|
83 lines
(*------------------------------------------------------------------------*)
(* HGRCOPY.PAS *)
(* Hardcopy-Prozedur zur Druckerausgabe von Bildschirmbereichen in vier *)
(* verschiedenen Groessen. Hier implementiert fuer IBM-PC und Turbo- *)
(* Pascal. *)
(*------------------------------------------------------------------------*)
PROCEDURE hgrcopy (left, top, right, bottom, size : INTEGER);
CONST breite = 639; (* Bildschirmbreite IBM-PC HiRes 0..639 *)
hoehe = 199; (* Bildschirmhoehe IBM-PC HiRes 0..199 *)
ptrres = 640; (* Breite einer Druckzeile des Druckers *)
zweih1 : ARRAY [0..7] OF INTEGER = (128,64,32,16,8,4,2,1);
zweih2 : ARRAY [0..3] OF INTEGER = (192,48,12,3);
zweih4 : ARRAY [0..1] OF INTEGER = (240,15);
zweih8 : ARRAY [0..0] OF INTEGER = (255);
VAR bitnumber, i, j, decrement, y, n, spalte : INTEGER;
(*---------------------------------------------------------------------*)
(* folgende Funktion ist Implementationsabhaengig und soll den Wert
TRUE liefern, wenn der Bildpunkt (x,y) gesetzt ist, sonst wird
FALSE zurueckgegeben. *)
FUNCTION screenbit (x, y: INTEGER): BOOLEAN;
BEGIN
screenbit := GetDotColor(x,y) > 0;
END;
(*---------------------------------------------------------------------*)
(* ueberprueft den Bildschirmausschnitt auf Gueltigkeit: *)
FUNCTION params_ok: BOOLEAN;
VAR ok : BOOLEAN;
BEGIN
ok := TRUE;
IF (left < 0) OR (right > breite) OR (left > right)
OR (top < 0) OR (bottom > hoehe) OR (top > bottom)
OR NOT (size IN [1,2,4,8]) THEN
ok := FALSE;
bitnumber := size * (right-left+1); (* Punkteanzahl pro Druckzeile *)
IF bitnumber > ptrres THEN
ok := FALSE;
END;
(*---------------------------------------------------------------------*)
BEGIN
IF params_ok THEN
BEGIN
y := top;
decrement := 8 DIV size;
Write (Lst, Chr(27), Chr(51), Chr(24)); (* Graphikzeilenabstand *)
WHILE y <= bottom DO
BEGIN
(* Anzahl folgender Grafikdaten dem Drucker mitteilen *)
Write (Lst, Chr(27), Chr(75), Chr(Lo(bitnumber)), Chr(Hi(bitnumber)));
FOR i := left TO right DO
BEGIN
spalte := 0;
FOR n := y TO Pred(y+decrement) DO
IF n <= bottom THEN
IF screenbit(i, n) THEN
CASE size OF
1: spalte := spalte OR zweih1[n-y];
2: spalte := spalte OR zweih2[n-y];
4: spalte := spalte OR zweih4[n-y];
8: spalte := spalte OR zweih8[n-y];
END;
FOR j := 1 TO size DO
Write (Lst, Chr(spalte));
END;
WriteLn (Lst);
y := y + decrement;
END;
Write (Lst, Chr(27), Chr(50)); (* normaler Zeilenabstand *)
END;
END; (* hgrcopy *)