Unit Print;{
ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
º T E C H N I S C H E U N I V E R S I T Ž T C H E M N I T Z º
º º
º Programm zur Ansteuerung des AD/DA-Wandlermoduls mit Einchip- º
º rechner 68HC11 º
º º
º UNIT Bildschirmausdruck º
º º
º Programmierer: Torsten Levin º
º 03 AET 89 º
º TU Chemnitz-Zwickau º
º º
º Chemnitz, Januar-April 1993 º
ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ
}
INTERFACE
procedure InitLPT(Nr:Word;Var Fehler:Byte);
procedure Hardcopy(LPT:Word;Var Error:Byte);
IMPLEMENTATION
Uses Crt,Graph,Dos,Windows;
{---Prozedur LPT-Initialisierung---------------------------}
function F(AH:Byte):byte;
begin
If AH and $01 <> 0 Then F:=1 { Wartezeit abgelaufen }
else If AH and $08 <> 0 Then F:=2 { Ausgabefehler }
else If AH and $20 <> 0 Then F:=3 { Papier alle }
else If AH and $80 = 0 Then F:=4 { Drucker reagiert nicht }
else If AH and $10 = 0 Then F:=5 { Kein Drucker gefunden }
else F:=0;
end;
procedure InitLPT(Nr:Word;Var Fehler:Byte);
var
regs: Registers;
begin
with Regs do begin
AH := 2;
DX := Nr-1;
Intr ($17,Regs);
Fehler:=F(AH);
If Fehler<>0 Then exit;
AH := 1;
DX := Nr-1;
Intr ($17,Regs);
Fehler:=F(AH or $80);
end;
End;
{---Prozedure Bildschirmausdruck---------------------------}
procedure Hardcopy(LPT:Word;Var Error:Byte);
const
Mask : array[0..7] of byte = (128,64,32,16,8,4,2,1);
FirstPlane = 0;
LastPlane = 3;
BackGndCol = 0;
var
i,j : integer;
OutByte : byte;
Membyte : array[0..7] of byte;
Answer : char;
{--- Unterprozedur Ausgabe eines Zeichens an LPT X----------}
procedure OutLPT (LPTNr:Word;cc:char;Var Fehler:Byte);
var
regs: Registers;
begin
with Regs do begin
AH := 2;
DX := LPTNr-1;
Intr ($17,Regs);
Fehler:=F(AH or $80); { Wartezeit abgelaufen }
If Fehler<>0 Then exit;
AH := 0;
AL := ord(cc);
DX := LPTNr-1;
Intr ($17,Regs);
End;
end;
procedure OutLptStr(Nr:Word;const s:String; var Fehler:Byte);
var
i: Integer;
begin
for i:=1 to Length(s) do begin
OutLpt(Nr,s[i],Fehler);
if Fehler<>0 then exit;
end;
end;
{---Unterprozedur GETMEMBYTE-------------------------------}
procedure GetMemByte(x,y:integer);
{Holt ein (noch horizontal orientiertes) 8x8-Feld an Pixeldaten}
var
zz: Word;
j: integer;
i: byte;
begin
for j:=0 to 7 do begin
MemByte[j] := 0;
if y>GetMaxY then break;
zz := Word(y)*80 + Word(x) shr 3; {Pixel-Adresse}
for i:=FirstPlane to LastPlane do begin
port[$3ce] := 4;
port[$3cf] := i;
MemByte[j] := MemByte[j] or Mem[SegA000:zz];
end;
MemByte[j]:=not MemByte[j]; {Bits f�r Drucker umkehren}
Inc(y);
end;
end;
{---Unterprocedure Ausgabe einer Zeile---------------------}
procedure OneLine (ky: integer);
const Leftrim=75;
var
j,k,l : integer;
begin
Error:=0;
OutLptStr(Lpt,#$1b'L',Error);
If Error<>0 Then Exit;
OutLPT(Lpt,chr(lo(GetMAxX+leftrim+1)),Error);
If Error<>0 Then Exit;
OutLPT(Lpt,chr(Hi(GetMaxX+leftrim+1)),Error);
If Error<>0 Then Exit;
for j:=1 to leftrim+1 do Begin
OutLPT(Lpt,(chr(0)),Error);
If Error<>0 Then Exit;
End;
for j:=0 to GetMaxX do begin
k := j mod 8;
if k = 0 then GetMemByte(j,ky);
OutByte := 0;
for l:=0 to 7 do begin
if (MemByte[l] and Mask[k]) <> 0
then OutByte:=OutByte or mask[l];
end;
OutLPT(Lpt,(chr(OutByte)),Error);
If Error<>0 Then Exit;
end;
OutLPTStr(Lpt,#13#10,Error);
end;
{---Hauptprozedur------------------------------------------}
begin
OutLptStr(LPT,#$0A#$1B'3'#24,Error);
If Error<>0 Then exit;
i := 0;
repeat
OneLine(i);
if Error<>0 then exit;
if Taste and (ta=#27) then break;
Inc(i,8);
until i>GetMaxY;
OutLptStr(Lpt,#$1B'2'#13#10,Error);
End;
End.
Vorgefundene Kodierung: ANSI (CP1252) | 4
|
|