Source file: /~heha/messtech/ad_da.zip/PAS/PRINT.PAS

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.