Pascal Programming/Examples

How Pascal can solve your problems?

Printer driver in PCL level III

Let's say we have a printer that our operating system does not support (there is no driver). What to do ? Write your own driver in Pascal.

PCL (Printer Command Language) is a page description language (PDL) developed by Hewlett-Packard as a printer protocol and has become a de facto industry standard.

The following module allows you to print, but only black and white.

{PRINTERM.PAS - printing graphical screen on Hewlet Packard Desk Jet 550 C printer ( using PCL level III language - only black and white )}
Unit PrinterM;


INTERFACE {****************************************************************}

uses dos,graph;

const LPT1=0;      { printer port number }
      Escape=#27;
      FormFeed=#12;
      Reset=Escape+#69;
      LandscapePageOrientation=Escape+#38+#108+#49+#79;
      PortraitPageOrientation=Escape+#38+#108+#48+#79;
      StartGraphicsAtLeft=Escape+'*r0A';
      StartGraphicsAtCurrent=Escape+'*r1A';
      EndGraphics=Escape+'*rbC';
var rejestr:registers;
Procedure WriteLst(text:string);
Procedure PrinterTest;
Procedure ScreenCopy(XminOfPrint,YminOfPrint,ResolutionOfPrint:integer);
Procedure ScreenCopy1;

IMPLEMENTATION {************************************************************}

Procedure WriteLst(text:string);

  var i:integer;

  begin with rejestr do
          for i:=1 to Length(text) do
            begin Ah:=0;     { function code, 0 indicates byte output  }
                  Dx:=LPT1;  { printer port number }
                  Al:=Byte(text[i]);   { byte output }
                  Intr($17,rejestr);
            end; { for i:=1 ... }
   end; { Procedure WriteLst }
{...........................................................................}
Procedure PrinterTest;   { works in the text mode}

  begin
    rejestr.dx:=LPT1;  { Port Number to which the printer is attached ;  0 = LPT1 }
    rejestr.ah:=2;     { Function Number ; printer port status }
    Intr($17,rejestr); {BIOS Interrupt #17 : initializes the indicated printer port and returns its status }
    if rejestr.ah=144  { 10010000B : (bit 7) =1  i (bit 4) =1  }
       then writeLn('Printer on LPT1 is OK')
       else writeLn('Printer on LPT1 is not OK');
       WriteLst(Reset);
  end; { Procedure PrinterTest }
{..........................................................................}
Procedure ScreenCopy(XminOfPrint,YminOfPrint,ResolutionOfPrint:integer);
  const Weighte: array[0..7] of byte=(1,2,4,8,16,32,64,128);
  var Xmax,Ymax,x,y:integer;
      NumberOfBytes,
      ResolutionOfPrintL,
      XminOfPrintL,YminOfPrintL:string;
      MyByte:byte;
  begin
    WriteLst(PortraitPageOrientation);
    {--------------------- ScreenResolution---------------------------------}
    Xmax:=GetMaxX;
    Ymax:=GetMaxY;
    {--------------------- NumberOfBytes in one horizontal line ----------}
    Str((Xmax div 8)+1,NumberOfBytes);
    {--------------------- Resolution of the print ---------------------------}
    Case ResolutionOfPrint of 75,100,150,300 : Str(ResolutionOfPrint,ResolutionOfPrintL);
         else if Xmax<=319 then ResolutionOfPrintL:='75'
                           else if Xmax<=639 then ResolutionOfPrintL:='100'
                                             else ResolutionOfPrintL:='150';
    end; { Case ResolutionOfPrint  }
    WriteLst(Escape+'*t'+ResolutionOfPrintL+'R'); { set raster graphic printing resolution  }
    {------------------- pozycja kursora -----------------------------------}
    Str(XminOfPrint,XminOfPrintL);
    Str(YminOfPrint,YminOfPrintL);
    WriteLst(Escape+'*p'+XminOfPrintL+'X'   { pozycja kursora }
                        +YminOfPrintL+'Y');
    WriteLst(StartGraphicsAtCurrent);
    {----------------------------------------------------------------------}
    For y:=0 to Ymax do
      begin
        MyByte:=0;
        WriteLst(Escape+'*b'+NumberOfBytes+'W'); { transfer raster graphics }
        For x:=0 to Xmax do
          begin
            If GetPixel(x,y)<>black then Bajt:=Bajt+Weighte[7-(x mod 8)];
            If ( x mod 8)=7 then begin
                                   WriteLst(Chr(MyByte));
                                   Bajt:=0;
                                 end; { If ( x mod 8 ) ... }
          end; { for x:=0 ... }
      end; { for y:=0 ... }
      {---------------------------------------------------------------------}
      WriteLst(EndGraphics);
      WriteLst(FormFeed);
  end; { Procedure ScreenCopy }
 {..........................................................................}
Procedure ScreenCopy1;

  const Weighte: array[0..7] of byte=(1,2,4,8,16,32,64,128);
        ResolutionOfPrint='75';  { dpi= dots per inch, jako lancuch }
  var   Xmax,Ymax,x,y:integer;
        NumberOfBytes,
        ResolutionOfPrintL:string;
        MyByte:byte;
        kolor:word;
  begin
    WriteLst(PortraitPageOrientation);
    {--------------------- ScreenResolution---------------------------------}
    Xmax:=GetMaxX;
    Ymax:=GetMaxY;
    {--------------------- NumberOfBytes in one horizontal line ----------}
    Str((Xmax div 8)+1,NumberOfBytes);
    {--------------------- Resolution of the print ---------------------------}
    WriteLst(Escape+'*t'+ResolutionOfPrint+'R');
    {------------------- Cursors position -----------------------------------}
    WriteLst(StartGraphicsAtLeft);
    {----------------------------------------------------------------------}
    For y:=0 to Ymax do
      begin
        MyByte:=0;
        WriteLst(Escape+'*b'+NumberOfBytes+'W'); { transfer raster graphics }
        For x:=0 to Xmax do
          begin
            If GetPixel(x,y)<>black then Bajt:=Bajt+Weighte[7-(x mod 8)];
            If ( x mod 8)=7 then begin
                                   WriteLst(Chr(MyByte));
                                   Bajt:=0;
                                 end; { If ( x mod 8 ) ... }
          end; { for x:=0 ... }
      end; { for y:=0 ... }
      {---------------------------------------------------------------------}
      WriteLst(EndGraphics);
      WriteLst(FormFeed);
  end; { Procedure ScreenCopy1 }

END.{********************* modulu PrinterM **********************************}
{Borland Turbo Pascal 7.0 programming language for Microsoft's MS-Dos operating system}