home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TP_ADV.ZIP / LIST0703.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-20  |  6.2 KB  |  162 lines
  1. Unit GPrint;
  2. {---------------------------------------------------------------}
  3. { This unit is designed to send graphics images to Epson        }
  4. { Compatible and late model IBM ProPrinter Dot Matrix printers. }
  5. { It takes the image from the currently active view port,       }
  6. { determined by a call to GetViewSettings, and transfers that   }
  7. { image to the printer.                                         }
  8. {---------------------------------------------------------------}
  9.  
  10. Interface
  11.  
  12. Uses Dos, Graph;     { Link in the necessary standard units     }
  13.  
  14. Var
  15.    LST : Text;       { New printer file variable                }
  16.  
  17. Procedure HardCopy (Gmode: Integer);
  18. { Procedure HardCopy prints the current ViewPort to an IBM or   }
  19. { 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.                      { Values of each bit within byte variable  }
  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.   BKColor         : Byte;        { Value of current bk color    }
  42.  
  43. Begin
  44.   LineSpacing   := #27+'3'+#24;  { 24/216 inch line spacing     }
  45.   Case Gmode Of
  46.     -1:   GraphixPrefix := #27+'K';  { Standard Density         }
  47.     -2:   GraphixPrefix := #27+'L';  { Double Density           }
  48.     -3:   GraphixPrefix := #27+'Y'; {  Dbl. Density Dbl. Speed  }
  49.     -4:   GraphixPrefix := #27+'Z'; {  Quad. Density            }
  50.     0..7: GraphixPrefix := #27+'*'+Chr( Gmode);{ 8-Pin Bit Img  }
  51.     Else
  52.       Exit;                        { Invalid Mode Selection     }
  53.   End;
  54.   BKColor := GetBKColor;
  55.   GetViewSettings( Vport );        { Get size of image to be    }
  56.   Height := Vport.Y2 - Vport.Y1;   { printed                    }
  57.   Width  := ( Vport.X2 + 1 ) - Vport.X1;
  58.   HiBit := Chr( Hi( Width ) );     { Translate sizes to char    }
  59.   LoBit := Chr( Lo( Width ) );     { for  output to printer     }
  60.   Write( LST, LineSpacing );
  61.   Y := 0;                          { First Y coordinate         }
  62.   While Y < Height Do              { Do not go beyond viewport  }
  63.   Begin
  64.     Write( LST,GraphixPrefix,LoBit,HiBit );
  65.                                    { Tell printer graphics info }
  66.     For X := 0 to Width-1 Do       { Go across screen lt to rt. }
  67.     Begin
  68.       BitData := 0;                { Initialize to all off (0)  }
  69.       If y + 7 <= Height Then      { Make sure there are 8      }
  70.         MaxBits := 7               { line of info and set it    }
  71.       Else                         { accordingly                }
  72.         MaxBits := Height - Y;
  73.       For YOfs := 0 to MaxBits do  { Go top to bottom on line   }
  74.         If( GetPixel( X, YOfs+Y ) <> BKColor ) Then
  75.            BitData := BitData or Bits[YOfs];
  76.                                    { If pixel on, add to output }
  77.       Write( LST, Chr( BitData ) );{ Byte is created, output it }
  78.     End;
  79.     WriteLn ( LST );
  80.     Inc( Y,8 );                    { Inc by 8 as each line is 8 }
  81.                                    { actual scan line in height }
  82.   End;
  83.   Writeln ( LST, #12 + 327 + 64 );
  84. End;
  85. {---------------------------------------------------------------}
  86. { What follows is the code for the Text File Device Driver for  }
  87. { the LST file variable defined above.  This is necessary as    }
  88. { Turbo opens the LST device defined in the printer unit in a   }
  89. { "Cooked" mode.                                                }
  90. {---------------------------------------------------------------}
  91.  
  92. {$F+}
  93.  
  94. Function LSTNoFunction( Var F: TextRec ): Integer;
  95. { This function performs a NUL operation on LST in case a Reset }
  96. { or a Rewrite is called.                                       }
  97. Begin
  98.   LSTNoFunction := 0;
  99. End;
  100.  
  101. Function LSTOutputToPrinter( Var F: TextRec ): Integer;
  102. { This function sends the output to the printer port number    }
  103. { stored in the first byte of the UserData area of the Text    }
  104. { Record.                                                      }
  105. Var
  106.   Regs: Registers;
  107.   P : word;
  108. Begin
  109.   With F do
  110.   Begin
  111.     P := 0;
  112.     Regs.AH := 16;
  113.     While( ( P < BufPos ) And ( ( Regs.AH and 16 ) = 16 ) ) Do
  114.     Begin
  115.       Regs.AL := Ord( BufPtr^[P] );
  116.       Regs.AH := 0;
  117.       Regs.DX := UserData[1];
  118.       Intr( $17,Regs );
  119.       Inc( P );
  120.     end;
  121.     BufPos := 0;
  122.   End;
  123.   If( Regs.AH and 16 ) = 16 Then
  124.     LSTOutputToPrinter := 0              { No error           }
  125.    Else
  126.      If( Regs.AH and 32 ) = 32 Then
  127.        LSTOutputToPrinter := 159         { Out of Paper       }
  128.      Else
  129.        LSTOutputToPrinter := 160;        { Device write Fault }
  130. End;
  131.  
  132. {$F-}
  133.  
  134. Procedure AssignLST( Port:Byte );
  135. { This procedure sets up the LST text file record as would the  }
  136. { Assign procedure, and initializes it as would a call to the   }
  137. { Reset procedure.  It then stores the LPT port number in the   }
  138. { first byte of the UserData Area of the TextRec type.          }
  139.  
  140. Begin
  141.   With TextRec( LST ) do
  142.   Begin
  143.     Handle      := $FFF0;
  144.     Mode        := fmOutput;
  145.     BufSize     := SizeOf( Buffer );
  146.     BufPtr      := @Buffer;
  147.     BufPos      := 0;
  148.     OpenFunc    := @LSTNoFunction;
  149.     InOutFunc   := @LSTOutputToPrinter;
  150.     FlushFunc   := @LSTOutputToPrinter;
  151.     CloseFunc   := @LSTOutputToPrinter;
  152.     UserData[1] := Port - 1;  { Sub 1 as DOS counts from zero   }
  153.   End;
  154. End;
  155.  
  156. Begin
  157.   AssignLST( 1 );             { Sets output printer to LPT1 by }
  158.                               { default.  Change this value to }
  159.                               { select other LPT ports.        }
  160. End.
  161.  
  162.