home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP_ADV.ZIP / LIST1006.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-07-31  |  4.9 KB  |  155 lines
  1.  
  2. Unit GraphPRN;
  3. {------------------------------------------------------------}
  4. { This  unit is  designed to send  graphics images  to Epson }
  5. { Compatible  and  late  model  IBM  ProPrinter  Dot  Matrix }
  6. { printers.  It takes the  image from  the currently  active }
  7. { Viewport, determined  by  a call  to  GetViewSettings, and }
  8. { transfers that image to the printer.                       }
  9.  
  10. Interface
  11.  
  12. Uses Dos, Graph;     { Used to get the Image from the Screen }
  13.  
  14. Var
  15.    LST : Text;
  16.  
  17. Procedure HardCopy (Gmode: Integer);
  18. { Procedure HardCopy prints the current ViewPort    }
  19. {   To an IBM or Epson compatible graphics printer. }
  20. {                                                   }
  21. { Valid Gmode numbers are :                         }
  22. {     -4 to -1 for Epson and IBM Graphic Printers   }
  23. {      0 to 7  for Epson Printers                   }
  24.  
  25. Implementation
  26.  
  27. Procedure HardCopy( Gmode: Integer );
  28.  
  29. Const
  30.    Bits : Array [0..7] of Byte = (128,64,32,16,8,4,2,1);
  31.  
  32.  
  33. Var
  34.     X,Y,YOfs        : Integer;   { Screen  location variables }
  35.     BitData,MaxBits : Byte;      { Number of Bits to transfer }
  36.     Vport           : ViewPortType;{Used to get view settings }
  37.     Height, Width   : Word;      { Size of image  to transfer }
  38.     HiBit, LoBit    : Char;      {     Char size of image     }
  39.     LineSpacing,                 { Additional  Info for  dump }
  40.     GraphixPrefix   : String[10];{      "        "   "     "  }
  41.  
  42. Begin
  43.   LineSpacing   := #27+'3'+#24; { 24/216 inch line spacing    }
  44.   Case Gmode Of
  45.        -1: GraphixPrefix := #27+'K'; { Std. Density           }
  46.        -2: GraphixPrefix := #27+'L'; { Double Density         }
  47.        -3: GraphixPrefix := #27+'Y'; { Dbl. Density Dbl. Speed}
  48.        -4: GraphixPrefix := #27+'Z'; { Quad. Density          }
  49.      0..7: GraphixPrefix := #27+'*'+Chr(Gmode);{ 8-Pin Bit Img}
  50.     Else
  51.      Exit;                           { Invalid Mode Selection }
  52.   End;
  53.   GetViewSettings( Vport );          { Get  size  of image to }
  54.   Height := Vport.Y2 - Vport.Y1;     { be printed             }
  55.   Width  := ( Vport.X2 + 1 ) - Vport.X1;
  56.   HiBit := Chr(Hi(Width));           {Translate sizes to char }
  57.   LoBit := Chr(Lo(Width));           { for  output to printer }
  58.   Write( LST, LineSpacing );
  59.   Y := 0;
  60.   While Y < Height Do
  61.   Begin
  62.      Write( LST,GraphixPrefix,LoBit,HiBit );
  63.      For X := 0 to Width-1 Do
  64.      Begin
  65.         BitData := 0;
  66.         If y + 7 <= Height
  67.           Then MaxBits := 7
  68.         Else
  69.           MaxBits := Height - Y;
  70.         For YOfs := 0 to MaxBits do
  71.         Begin
  72.          If GetPixel( X, YOfs+Y ) > 0
  73.            Then BitData := BitData or Bits[YOfs];
  74.         End;
  75.         Write( LST, Chr(BitData) );
  76.      End;
  77.      WriteLn ( LST );
  78.      Inc(Y,8);
  79.   End;
  80. End;
  81.  
  82. {$F+}
  83.  
  84. {      LSTNoFunction performs a NUL operation for a Reset or  }
  85. { Rewrite on LST (Just in case)                               }
  86.  
  87. Function LSTNoFunction( Var F: TextRec ): integer;
  88. Begin
  89.   LSTNoFunction := 0;                    { No error           }
  90. end;
  91.  
  92. {      LSTOutputToPrinter sends a the output to the Printer   }
  93. { port number stored in the first byte or the UserData area   }
  94. { of the Text Record.                                         }
  95.  
  96. Function LSTOutputToPrinter( Var F: TextRec ): integer;
  97. var
  98.   Regs: Registers;
  99.   P : word;
  100. begin
  101.   With F do
  102.   Begin
  103.     P := 0;
  104.     Regs.AH := 16;
  105.     While (P < BufPos) and ((regs.ah and 16) = 16) do
  106.     Begin
  107.       Regs.AL := Ord(BufPtr^[P]);
  108.       Regs.AH := 0;
  109.       Regs.DX := UserData[1];
  110.       Intr($17,Regs);
  111.       Inc(P);
  112.     end;
  113.     BufPos := 0;
  114.   End;
  115.   if (Regs.AH and 16) = 16 then
  116.     LSTOutputToPrinter := 0              { No error           }
  117.    else
  118.      if (Regs.AH and 32 ) = 32 then
  119.        LSTOutputToPrinter := 159         { Out of Paper       }
  120.    else
  121.        LSTOutputToPrinter := 160;        { Device write Fault }
  122. End;
  123.  
  124. {$F-}
  125.  
  126. {      AssignLST both sets up the LST text file record as     }
  127. { would ASSIGN, and initializes it as would a RESET.  It also }
  128. { stores the Port number in the first Byte of the UserData    }
  129. { area.                                                       }
  130.  
  131. Procedure AssignLST( Port:Byte );
  132. Begin
  133.   With TextRec(LST) do
  134.     begin
  135.       Handle      := $FFF0;
  136.       Mode        := fmOutput;
  137.       BufSize     := SizeOf(Buffer);
  138.       BufPtr      := @Buffer;
  139.       BufPos      := 0;
  140.       OpenFunc    := @LSTNoFunction;
  141.       InOutFunc   := @LSTOutputToPrinter;
  142.       FlushFunc   := @LSTOutputToPrinter;
  143.       CloseFunc   := @LSTOutputToPrinter;
  144.       UserData[1] := Port - 1;  { We subtract one because }
  145.   end;                          { Dos Counts from zero.   }
  146. end;
  147.  
  148.  
  149.  
  150. Begin
  151.    AssignLST( 1 );           { Sets output printer to LPT1 by }
  152.                              { default.  Change this value to }
  153.                              { select other LPT ports.        }
  154. End.
  155.