411 REFERENCE · Wikibooks
Pascal Programming/Examples
Reference material by Wikibooks contributors. This retains its source identity and is not 411 news reporting.
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)PCL in wikipedii 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}
Getting started Register
Category:Book:Pascal Programming