Printer
  1. Help on Printer Control Codes
  2. How to get Paper Source?
  3. Printing Rotated text...[UPD]
  4. Stretched bitmap on TPrinter
  5. How to print a bitmap?
  6. Dump a text file
  7. Printing a line at a time
  8. Printing Tricks
  9. Passthough escape function
  10. How to print exact sizes
  11. Windows API about Printer
  12. Property changes in same print[NEW]
  13. Paper Formats[NEW]

Help on Printer Control Codes

From: dblock@vdn.com (David Block)

Vincent Lim <kaneda@singnet.com.sg> wrote:

How do I send Printer Control Codes to the printer without having them
translated into unprintable characters?
Not sure if it is Windows API or Delphi is the culprit.
When I write the printer control codes, they are just printed as
unprintable characters rather than being interpreted by the printer.
You need to use the Passthrough printer Escape function to send data directly to the printer. If you're using WriteLn, then it won't work. Here's some code to get you started:


unit Passthru;

interface

uses printers, WinProcs, WinTypes, SysUtils;

Procedure       PrintTest;

implementation

Type
        TPassThroughData = Record
                nLen : Integer;
                Data : Array[0..255] of byte;
        end;

Procedure DirectPrint(s : String);
var
        PTBlock : TPassThroughData;
Begin
        PTBlock.nLen := Length(s);
        StrPCopy(@PTBlock.Data,s);
        Escape(printer.handle, PASSTHROUGH,0,@PTBlock,nil);
End;



Procedure PrintTest;
Begin
        Printer.BeginDoc;
        DirectPrint(CHR(27)+'&l1O'+'Hello, World!');
        Printer.EndDoc;
End;


end.

How to get Paper Source?

'Joe C. Hecht' <jhecht@wpo.borland.com>

Below are some code snippets to change the printer settings. Wherever the changes are made, you could instead examine the printer settings. See the documentation for ExtDeviceMode and the TDEVMODE structure as well the printer escape GETSETPAPERBINS and GetDeviceCaps().

*********************************************

One way to change printer settings at the start of a print job is to change the printers devicemode.

Example:


var
Device : array[0..255] of char;
Driver : array[0..255] of char;
Port   : array[0..255] of char;
hDMode : THandle;
PDMode : PDEVMODE;
begin
  Printer.PrinterIndex := Printer.PrinterIndex;
  Printer.GetPrinter(Device, Driver, Port, hDMode);
  if hDMode <> 0 then begin
    pDMode := GlobalLock(hDMode);
    if pDMode <> nil then begin
      pDMode^.dmFields := pDMode^.dmFields or DM_COPIES;
      pDMode^.dmCopies := 5;
      GlobalUnlock(hDMode);
    end;
    GlobalFree(hDMode);
  end;
  Printer.PrinterIndex := Printer.PrinterIndex;
  Printer.BeginDoc;
  Printer.Canvas.TextOut(100,100, 'Test 1');
  Printer.EndDoc;

Another way is to change TPrinter. This will enable you to change settings in mid job. You must make the change >>>between<<< pages.

To do this:

Before every startpage() command in printers.pas in the Source\VCL directory add something like:


 DevMode.dmPaperSize:=DMPAPER_LEGAL
{any other devicemode settings go here}
 Windows.ResetDc(dc,Devmode^);

This will reset the pagesize. you can look up DEVMODE in the help to find other paper sizes.

You will need to rebuild the vcl source for this to work, by adding the path to the VCL source directory to the beginning of the library path s tatement under tools..options.. library...libaray path. Quit Delphi then do a build all.

Another quick note...

When changing printers, be aware that fontsizes may not always scale properly. To ensure proper scaling set the PixelsPerInch property of the font.

Here are two examples:


uses Printers;

var
  MyFile: TextFile;
begin
  AssignPrn(MyFile);
  Rewrite(MyFile);

  Printer.Canvas.Font.Name := 'Courier New';
  Printer.Canvas.Font.Style := [fsBold];
  Printer.Canvas.Font.PixelsPerInch:=
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);

  Writeln(MyFile, 'Print this text');

  System.CloseFile(MyFile);
end;


uses Printers;

begin
  Printer.BeginDoc;
  Printer.Canvas.Font.Name := 'Courier New';
  Printer.Canvas.Font.Style := [fsBold];

  Printer.Canvas.Font.PixelsPerInch:=
    GetDeviceCaps(Printer.Canvas.Handle, LOGPIXELSY);

  Printer.Canvas.Textout(10, 10, 'Print this text');

  Printer.EndDoc;
end;

Printing Rotated text...[UPD]

  1. From: "Peter Szymiczek" <szymicpe@bmw.com.au>
    procedure AngleTextOut(CV: TCanvas; const sText: String; x, y, angle:integer);
    var
      LogFont: TLogFont;
      SaveFont: TFont;
    begin
      SaveFont := TFont.Create;
      SaveFont.Assign(CV.Font);
      GetObject(SaveFont.Handle, sizeof(TLogFont), @LogFont);
      with LogFont do
        begin
          lfEscapement := angle *10;
          lfPitchAndFamily := FIXED_PITCH or FF_DONTCARE;
        end; {with}
      CV.Font.Handle := CreateFontIndirect(LogFont);
      SetBkMode(CV.Handle, TRANSPARENT);
      CV.TextOut(x, y, sText);
      CV.Font.Assign(SaveFont);
      SaveFont.Free;
    end;
    

  2. From: Jukka Palomäki <jukpalom@utu.fi>

    This is how I have solved the problem:


    procedure TextOutVertical(var bitmap: TBitmap; x, y: Integer; s: String);
    var b1, b2: TBitmap;
        i, j: Integer;
    begin
      with bitmap.Canvas do
      begin
        b1 := TBitmap.Create;
        b1.Canvas.Font := lpYhFont;
        b1.Width  := TextWidth(s) + 1;
        b1.Height := TextHeight(s) + 1;
        b1.Canvas.TextOut(1, 1, s);
    
        b2 := TPackedBitmap.Create;
        b2.Width  := TextHeight(s);
        b2.Height := TextWidth(s);
        for i := 0 to b1.Width - 1 do
            for j := 0 to b1.Height do
                b2.Canvas.Pixels[j, b2.Height + 1 - i] := b1.Canvas.Pixels[i, j];
        Draw(x, y, b2);
        b1.Free;
        b2.Free;
      end
    end;
    

  3. From: "Dmitry" <dimon@diogen.nstu.nsk.su>

    Long time ago I did so: I created font, select it in DC ...


    function CreateMyFont(degree: Integer): HFONT;
    begin
      CreateMyFont := CreateFont(
        -30, 0, degree, 0, 0,
        0, 0, 0, 1, OUT_TT_PRECIS,
        0, 0, 0, szFontName);
    end;
    

    .... and then I used any draw text function for text output.

  4. "Eric Lawrence" <deltagrp@wam.umd.edu>

    The method (1) shown is quite slow, as it requires drawing the text, and then inefficiently rotating it. Try this instead:


    procedure TForm1.TextUp(aRect:tRect;aTxt:String);
    var LFont: TLogFont; hOldFont, hNewFont: HFont;
    begin
      GetObject(Canvas.Font.Handle,SizeOf(LFont),Addr(LFont));
      LFont.lfEscapement := 900;
      hNewFont := CreateFontIndirect(LFont);
      hOldFont := SelectObject(Canvas.Handle,hNewFont);
      Canvas.TextOut(aRect.Left+2,aRect.Top,aTxt);
      hNewFont := SelectObject(Canvas.Handle,hOldFont);
      DeleteObject(hNewFont);
    end;
    

Stretched bitmap on TPrinter

wea@felten.co.at (Alexander Wernhart)

On Tue, 4 Feb 1997 20:54:43 -0300, Ruy Ponce de Leon Junior
<rplj@di.ufpe.br> wrote:


I'm writing a program that prints a bitmap to the printer
via TPrinter object. The problem occurs when I "stretch"
the bitmap to fit the adequate area on paper. Due to the
stretching (bitblts to Printer's DC), dotted patterns appear
on the  bitmap regions, making them almost gray.
This is an obvius undesired effect. Does anybody knows some 
approach to help me?
 
Try this:


procedure DrawImage(Canvas: TCanvas; DestRect: TRect; ABitmap:
TBitmap);
var
  Header, Bits: Pointer;
  HeaderSize: Integer;
  BitsSize: Longint;
begin
  GetDIBSizes(ABitmap.Handle, HeaderSize, BitsSize);
  Header := MemAlloc(HeaderSize);
  Bits := MemAlloc(BitsSize);
  try
    GetDIB(ABitmap.Handle, ABitmap.Palette, Header^, Bits^);
    StretchDIBits(Canvas.Handle, DestRect.Left, DestRect.Top,
        DestRect.Right, DestRect.Bottom,
        0, 0, ABitmap.Width, ABitmap.Height, Bits,TBitmapInfo(Header^),
        DIB_RGB_COLORS, SRCCOPY);
    { you might want to try DIB_PAL_COLORS instead, but this is well
      beyond the scope of my knowledge. }
  finally
    MemFree(Header, HeaderSize);
    MemFree(Bits, BitsSize);
  end;
end;

{ Print a Bitmap using the whole Printerpage }
procedure PrintBitmap(ABitmap: TBitmap);
var
  relheight, relwidth: integer;
begin
  screen.cursor := crHourglass;
  Printer.BeginDoc;
  if ((ABitmap.width / ABitmap.height) > (printer.pagewidth /printer.pageheight)) then
  begin
    { Stretch Bitmap to width of Printerpage }
    relwidth := printer.pagewidth;
    relheight := MulDiv(ABitmap.height, printer.pagewidth,ABitmap.width);
  end else
  begin
    { Stretch Bitmap to height of Printerpage }
    relwidth := MulDiv(ABitmap.width, printer.pageheight, ABitmap.height);
    relheight := printer.pageheight;
  end;
  DrawImage(Printer.Canvas, Rect(0, 0, relWidth, relHeight), ABitmap);
  Printer.EndDoc;
  screen.cursor := crDefault;
end;

How to print a bitmap?

Use the following code. Remember to include the Printers unit in the uses clause :

Lines followed by // ** are essential. The others are to get the scaling correct otherwise you end up with extremely small images. Printer resolutions are higher than your screen resolution.


procedure TForm1.Button1Click(Sender: TObject);
var
  ScaleX, ScaleY: Integer;
  R: TRect;
begin
  Printer.BeginDoc;  // **
  with Printer do
  try
    ScaleX := GetDeviceCaps(Handle, logPixelsX) div PixelsPerInch;
    ScaleY := GetDeviceCaps(Handle, logPixelsY) div PixelsPerInch;
    R := Rect(0, 0, Image1.Picture.Width * ScaleX,
      Image1.Picture.Height * ScaleY);
    Canvas.StretchDraw(R, Image1.Picture.Graphic);  // **
  finally
    EndDoc;  // **
  end;
end;

Dump a text file

From: Chris Monson <ckmonson@burgoyne.com>

Use CreateFile to get a handle to LPT1


  LPTHandle := CreateFile( 'LPT1',GENERIC_WRITE,
                 0, PSecurityAttributes(nil),
                 OPEN_EXISTING, FILE_FLAG_OVERLAPPED,
                 0);

Then use WriteFile to send a string of characters or use


  While not
    TransmitCommChar( LPTHandle, CharToSend ) do
  Application.ProcessMessages;

It sends one raw character at a time to the parallel port. It waits for the recent character to get processed and then immediately sends a new one. I got it printing stuff pretty fast.

Printing a line at a time

From: Peter van Lonkhuyzen <peterv@lin01.global.co.za>

> I've tried to write a D1 or D2 program that will print only one line at a time to a printer (any type), exit the program but NOT eject the page, 
so that the next time I run the program and it prints a line, it prints on the very next line, etc.

According to M$ this is illegal as it "defeats the multitasking nature" but I needed the same functionality.

I created the following derivative of the TPrinter object. It works perfectly on dotmatrix printers.

sample usage


var Myprinter : TRawPrinter;
    oldprinter : TPrinter;
begin
 MyPrinter:=TRawPrinter.Create;
 oldprinter:=setprinter(MyPrinter);
 try
  if Printdialog1.execute then
  begin
    myprinter.startraw;
    myprinter.write('khsdhskhkshdksd');
    myprinter.writeln;
    myprinter.endraw;
  end
 finally
  setprinter(oldprinyter);
  myprinter.free;
 end
end;

Here is the code for the raw printer object.


unit Rawprinter;

interface
uses printers,windows;

type TRawprinter =class(TPrinter)
                  public
                    dc2 : HDC;
                    procedure startraw;
                    procedure endraw;
                    procedure write(const s : string);
                    procedure writeln;
                  end;

implementation
uses sysutils,forms;

function AbortProc(Prn: HDC; Error: Integer): Bool; stdcall;
begin
  Application.ProcessMessages;
  Result := not Printer.Aborted;
end;

type
  TPrinterDevice = class
    Driver, Device, Port: String;
    constructor Create(ADriver, ADevice, APort: PChar);
    function IsEqual(ADriver, ADevice, APort: PChar): Boolean;
  end;

constructor TPrinterDevice.Create(ADriver, ADevice, APort: PChar);
begin
  inherited Create;
  Driver := ADriver;
  Device := ADevice;
  Port := APort;
end;

function TPrinterDevice.IsEqual(ADriver, ADevice, APort: PChar): Boolean;
begin
  Result := (Device = ADevice) and (Port = APort);
end;


procedure TRawprinter.startraw;
var
  CTitle: array[0..31] of Char;
  CMode : Array[0..4] of char;
  DocInfo: TDocInfo;
  r : integer;
begin
  StrPLCopy(CTitle, Title, SizeOf(CTitle) - 1);
  StrPCopy(CMode, 'RAW');
  FillChar(DocInfo, SizeOf(DocInfo), 0);
  with DocInfo do
  begin
    cbSize := SizeOf(DocInfo);
    lpszDocName := CTitle;
    lpszOutput := nil;
    lpszDatatype :=CMode;
  end;
  with TPrinterDevice(Printers.Objects[PrinterIndex]) do
  begin
    DC2 := CreateDC(PChar(Driver), PChar(Device), PChar(Port), nil);
  end;
  SetAbortProc(dc2, AbortProc);
  r:=StartDoc(dc2, DocInfo);
end;

procedure TRawprinter.endraw;
var r : integer;
begin
  r:=windows.enddoc(dc2);
end;

type passrec = packed record
                 l : word;
                 s : Array[0..255] of char;
               end;
var pass : Passrec;
procedure TRawprinter.write(const s : string);
begin
  pass.l:=length(s);
  strpcopy(pass.s,s);
  escape(dc2,PASSTHROUGH,0,@pass,nil);
end;

procedure TRawprinter.writeln;
begin
  pass.l:=2;
  strpcopy(pass.s,#13#10);
  escape(dc2,PASSTHROUGH,0,@pass,nil);
end;

end.

Printing Tricks

rgilland@ecn.net.au (Robert Gilland)

"Guy Vandenberg" <guyvdb@MindSpring>

You are a genius. After pulling my hair out and downloading anything that had anything to do with printing in delphi on the net and getting nowhere fast. Your little piece of code actually made sence to me and was userfrindly. I put it together with other code other small hints on printing and I got the below. Use it to your delight. You were the initiator.


const INCHES_PER_MILIMETER : Real  = 0.04;

type
  TOffset =   record
               X,Y: Integer;
              end;

var FDeviceName : String;  {Get the name}
    FPageHeightPixel, FPageWidthPixel : Integer ;  {Page height and Page Width}
    FOrientation : TPrinterOrientation; {Orientation}
    FPrintOffsetPixels : TOffset;
    FPixelsPerMMX,FPixelsPerMMY: Real;
    MMSize, FPageHeightMM : Integer;
    TheReport, TheHead, HeadLine, RecordLine, TFname, TLname :String;

procedure TMissing_Rep.GetDeviceSettings;

var
  retval: integer;
  PixX, PixY: Integer;

begin
    FDeviceName := Printer.Printers[Printer.PrinterIndex];  {Get the name}
    FPageHeightPixel := Printer.PageHeight;                 {Page height}
    FPageWidthPixel := Printer.PageWidth;                   {Page Width}
    FOrientation := Printer.Orientation;
{Orientation}
    {Get the printable area offsets}
    {$IFDEF WIN32}
       FPrintOffsetPixels.X := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
       FPrintOffsetPixels.Y := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
    {$ELSE}
       retval := Escape(Printer.Handle,GETPRINTINGOFFSET,
                        0, nil, @FPrintOffsetPixels);
    {$ENDIF}
    {Get Pixels per Milimeter Ratio}
    PixX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
    PixY :=  GetDeviceCaps(Printer.Handle, LOGPIXELSY);
    FPixelsPerMMX := INCHES_PER_MILIMETER * PixX;
    FPixelsPerMMY := INCHES_PER_MILIMETER  * PixY;
    FPageHeightMM := Round(FPageHeightPixel/FPixelsPerMMY);
 end;

function TMissing_Rep.PutText(mmX,mmY: Integer; S: string; LeftAlign:
Boolean): boolean;
var
  X, Y: Integer;
  align: WORD;
begin
  if LeftAlign then
    align :=  SetTextAlign(Printer.Handle,TA_BOTTOM or TA_LEFT)
  else
    align :=  SetTextAlign(Printer.Handle,TA_BOTTOM or TA_RIGHT);
  result := FALSE; {Assume fail}
  X := Trunc(mmX * FPixelsPerMMX) - FPrintOffsetPixels.X;
  Y := Trunc(mmY * FPixelsPerMMY) - FPrintOffsetPixels.Y;
  if X < 0 then exit;
  if Y < 0 then exit;
  Printer.Canvas.TextOut(X,Y,S);
  result := TRUE;
end;

procedure TMissing_Rep.Print_ButClick(Sender: TObject);

var PixelSize: Integer;

begin
Print_But.Enabled := False;
if PrintDialog1.Execute then
 begin
 Printer.Canvas.Font := Missing_Rep.Font;
 PixelSize := Printer.Canvas.TextHeight('Yy');
 MMSize := Round(PixelSize/FPixelsPerMMY);
 Printer.Title := 'Breast Cancer Project Missing Report';
 Printer.BeginDoc;                        { begin to send print job to printer }
 PrintGenerator;
 Printer.EndDoc;                 { EndDoc ends and starts printing print job }
 end;
 Print_But.Enabled := True;
 end;

procedure TMissing_Rep.PrintGenerator;

Var
  yLoc , NumRows, TheRow :Integer;

  procedure Heading;
  begin
   yLoc := 20;
   PutText(20, 20, TheHead, TRUE);
   yLoc := yLoc + MMSize;
   PutText(20,  yLoc, StringGrid1.Cells[0,0], TRUE);
   PutText(60,  yLoc, StringGrid1.Cells[1,0], TRUE);
   PutText(100, yLoc, StringGrid1.Cells[2,0], TRUE);
   PutText(120, yLoc, StringGrid1.Cells[3,0], TRUE);
   PutText(150, yLoc, StringGrid1.Cells[4,0], TRUE);
   yLoc := yLoc + MMSize;
 end;

  procedure Footer;
  begin
  PutText(100,FPageHeightMM,InttoStr(Printer.PageNumber), TRUE);
  end;

begin
   Heading;
   TheRow := 1;
   while (TheRow < StringGrid1.RowCount) do
   begin
       if (yLoc > (FPageHeightMM - MMSize)) then
	   begin
		  Footer;
		  Printer.NewPage;
		  Heading;
  	   end;
	 TheGauge.Progress := Round(100 * TheRow/(StringGrid1.RowCount - 1));
	 PutText(20,  yLoc, StringGrid1.Cells[0,TheRow], TRUE);
	 PutText(60,  yLoc, StringGrid1.Cells[1,TheRow], TRUE);
	 PutText(100, yLoc, StringGrid1.Cells[2,TheRow], TRUE);
	 PutText(120, yLoc, StringGrid1.Cells[3,TheRow], TRUE);
	 PutText(150, yLoc, StringGrid1.Cells[4,TheRow], TRUE);
	 yLoc := yLoc + MMSize;
	 TheRow := TheRow + 1;
 end;
Footer;
end;

Passthough escape function

"Joe C. Hecht" <jhecht@corp.borland.com>

Gilberto Beda wrote:
> 
someone knows why some windows drivers don't work with a passthrough in
Escape function? 
 
Is it possible to know if a driver printer support the PASSTROUGH
function? I believe Dos apps in 95 use the same function if I command
"copy file > lpt1" Windows95 use the predefint drivers to spool the
report to printer.
Although Delphi's TPrinter unit makes it easy to interface to a given printer, there are times when you may need to drop down to the printers level and send device specific escape sequences. Under sixteen bit versions of Windows, this was as easy as opening the printer port, but under Windows NT, directly accessing the hardware is is illegal. One solution is to use the Windows "PASSTHROUGH" escape to send an escape sequence directly to the printer. In order to use the "PASSTHROUGH" escape, it must be supported by the printer driver. Be forwarned that not all printer drivers will support this feature.

It's worth noting that the "PASSTHROUGH" escape is documented as obsolete for thirty-two bit applications. It should be a number of years before this escape goes by the way, since it is used in many commercial applications.

The example code presented is not targeted to any specific printer model. You will need to know the correct escape sequences to send to the printer you are interfacing to. Note that you must still call the BeginDoc and EndDoc methods of TPrinter. During the BeginDoc call, the printer driver initializes the printer as necessary, and during the EndDoc call, the printer driver will uninitialize the printer and eject the page. When you do make your escape call, the printer may be set for the current windows mapping mode if the printer supports scaling internaly. Technically, you should not do anything that would cause the printer memory to be reset, or eject a page with an escape sequence. In other words, try to leave the printer in the same state it was in when you made your escape. This is more important on intellegent printers (Postscript printers), and not important at all on a standard TTY line printer, where you can do just about anything you like, including ejecting pages.

Code Example:

You will need to declare a structure to hold the buffer you are sending. The structure of the buffer is defined as a word containing the length of the buffer, followed by the buffer containing the data.

Before making the escape call to pass the data, we will use the escape "QUERYESCSUPPORT" to determine if the "PASSTHROUGH" escape is supported by the print driver.

Finally, be aware that your data will be inserted directly into the printers data stream. On some printer models (Postscript), you may need to add a space to the start and end of your data to separate your data from the printer drivers data.

(Postscript is a Registered Trademark of Adobe Systems Incorporated)

*)


unit Esc1;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{ add the printers unit }
uses
   Printers;

{$R *.DFM}

{ declare the "PASSTHROUGH" structure }
type TPrnBuffRec = record
  BuffLength : word;
  Buffer : array [0..255] of char;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Buff : TPrnBuffRec;
  TestInt : integer;
  s : string;
begin

{ Test to see if the "PASSTHROUGH" escape is supported }
  TestInt := PASSTHROUGH;
  if Escape(Printer.Handle,
            QUERYESCSUPPORT,
            sizeof(TestInt),
            @TestInt,
            nil) > 0 then begin

  { Start the printout }
    Printer.BeginDoc;

  { Make a string to passthrough }
    s := ' A Test String ';

  { Copy the string to the buffer }
    StrPCopy(Buff.Buffer, s);

  { Set the buffer length }
    Buff.BuffLength := StrLen(Buff.Buffer);

  { Make the escape}
    Escape(Printer.Canvas.Handle,
           PASSTHROUGH,
           0,
           @Buff,
           nil);

  { End the printout }
    Printer.EndDoc;
  end;
end;

end.

How to print exact sizes

From: "Earl F. Glynn" <EarlGlynn@worldnet.att.net>

The following sample UNIT shows how to use GetDeviceCaps to obtain much information about your printer, including the HORZRES and VERTRES (horizontal and vertical resolution in pixels) and the dimensions in inches. Or, use the LOGPIXELSX and LOGPIXELSY values for the dot density/inch in the horizontal and vertical dimensions.

In addition to the info about a printer, the example below shows how to print a bitmap in its "natural" size, or at a specific location with a specific size on the page. I think this should give you some clues about how to solve your problem.

The example also shows to plot a sine wave at a particular location with a given size (all in inches). Since we in the U.S. are incapable of converting inches to metric (I jest), you'll have to figure that part out yourself.


unit Tstpr2fm;

{Sample usage of Printer object from TPrinter Unit.  Use verbose style
below
 to simplify future reference.

 Shows values returned by GetDeviceCaps Windows API function.

 efg, 19 September 1996}

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Print: TButton;
    Image1: TImage;
    procedure PrintClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
  USES
    Printers;

  {WINAPI GetDeviceCaps Constants from C++ windows.h and wingdi.h}

  {The indivdual constants are defined here for reference only}
  CONST
     DRIVERVERSION   =   0;
     TECHNOLOGY      =   2;  {See windows.h for mask values}
     HORZSIZE        =   4;
     VERTSIZE        =   6;
     HORZRES         =   8;
     VERTRES         =  10;
     BITSPIXEL       =  12;
     PLANES          =  14;
     NUMBRUSHES      =  16;
     NUMPENS         =  18;
     NUMMARKERS      =  20;
     NUMFONTS        =  22;
     NUMCOLORS       =  24;
     PDEVICESIZE     =  26;
     CURVECAPS       =  28;  {See windows.h for mask values}
     LINECAPS        =  30;  {See windows.h for mask values}
     POLYGONALCAPS   =  32;  {See windows.h for mask values}
     TEXTCAPS        =  34;  {See windows.h for mask values}
     CLIPCAPS        =  36;  {See windows.h for mask values}
     RASTERCAPS      =  38;  {See windows.h for mask values}
     ASPECTX         =  40;
     ASPECTY         =  42;
     ASPECTXY        =  44;

     LOGPIXELSX      =  88;
     LOGPIXELSY      =  90;

     SIZEPALETTE     = 104;
     NUMRESERVED     = 106;
     COLORRES        = 108;

     PHYSICALWIDTH   = 110;   {See wingdi.h for definition}
     PHYSICALHEIGHT  = 111;   {See wingdi.h for definition}
     PHYSICALOFFSETX = 112;   {See wingdi.h for definition}
     PHYSICALOFFSETY = 113;   {See wingdi.h for definition}
     SCALINGFACTORX  = 114;   {See wingdi.h for definition}
     SCALINGFACTORY  = 115;   {See wingdi.h for definition}

    DeviceCapsString:  ARRAY[1..34] OF STRING =
     ('DRIVERVERSION',  'TECHNOLOGY',     'HORZSIZE',
      'VERTSIZE',       'HORZRES',        'VERTRES',
      'BITSPIXEL',      'PLANES',         'NUMBRUSHES',
      'NUMPENS',        'NUMMARKERS',     'NUMFONTS',
      'NUMCOLORS',      'PDEVICESIZE',    'CURVECAPS',
      'LINECAPS',       'POLYGONALCAPS',  'TEXTCAPS',
      'CLIPCAPS',       'RASTERCAPS',     'ASPECTX',
      'ASPECTY',        'ASPECTXY',       'LOGPIXELSX',
      'LOGPIXELSY',     'SIZEPALETTE',    'NUMRESERVED',
      'COLORRES',       'PHYSICALWIDTH',  'PHYSICALHEIGHT',
      'PHYSICALOFFSETX','PHYSICALOFFSETY','SCALINGFACTORX',
      'SCALINGFACTORY');

   DeviceCapsIndex:  ARRAY[1..34] OF INTEGER =
     (  0,   2,   4,   6,   8,  10,  12,  14,  16,  18,
       20,  22,  24,  26,  28,  30,  32,  34,  36,  38,
       40,  42,  44,  88,  90, 104, 106, 108, 110, 111,
      112, 113, 114, 115);

  {$R *.DFM}

FUNCTION iPosition(const i:  INTEGER):  INTEGER;
BEGIN
  RESULT := Integer(i * LongInt(Printer.PageWidth)  DIV 1000)
END {iPosition};


FUNCTION jPosition(const j:  INTEGER):  INTEGER;
BEGIN
  RESULT := Integer(j * LongInt(Printer.PageHeight) DIV 1000)
END {jPosition};


procedure TForm1.PrintClick(Sender: TObject);
  VAR
    DestinationRectangle:  TRect;
    GraphicAspectRatio  :  DOUBLE;
    i                   :  INTEGER;
    j                   :  INTEGER;
    iBase               :  INTEGER;
    iPixelsPerInch      :  WORD;
    jBase               :  INTEGER;
    jDelta              :  INTEGER;
    jPixelsPerInch      :  WORD;
    OffScreen           :  TBitMap;
    PixelAspectRatio    :  DOUBLE;
    SourceRectangle     :  TRect;
    TargetRectangle     :  TRect;
    value               :  INTEGER;
    x                   :  DOUBLE;
    y                   :  DOUBLE;
begin
  Printer.Orientation := poLandscape;
  Printer.BeginDoc;

  {Draw a rectangle to show the margins}
  Printer.Canvas.Rectangle(0,0, Printer.PageWidth, Printer.PageHeight);

  {Properties of Printer and Page}
  Printer.Canvas.Font.Name := 'Times New Roman';
  Printer.Canvas.Font.Size := 12;
  Printer.Canvas.Font.Style := [fsBold];
  Printer.Canvas.TextOut(iPosition(50), jPosition(40), 'Printer/Page Properties');

  Printer.Canvas.Font.Style := [];
  Printer.Canvas.Font.Size := 10;
  iBase := iPosition(50);
  jBase := 60;
  jDelta := 18;
  Printer.Canvas.TextOut(iPosition(50), jPosition(jBase),
    Printer.Printers.Strings[Printer.PrinterIndex]);
  INC (jBase, jDelta);

  Printer.Canvas.TextOut(iBase, jPosition(jBase),
    'Pixels:  ' + IntToStr(Printer.PageWidth) + ' X ' +
                  IntToStr(Printer.PageHeight));
  INC (jBase, jDelta);

  Printer.Canvas.TextOut(iBase, jPosition(jBase),
    'Inches:  ' + FormatFloat('0.000',
                  Printer.PageWidth / Printer.Canvas.Font.PixelsPerInch) + ' X ' +
                  FormatFloat('0.000',
                  Printer.PageHeight / Printer.Canvas.Font.PixelsPerInch)); 
  INC (jBase, 2*jDelta);

  Printer.Canvas.TextOut(iBase, jPosition(jBase),
    'Font:  ' + Printer.Canvas.Font.Name + '   Size:  ' +
    IntToStr(Printer.Canvas.Font.Size));
  INC (jBase, jDelta);


  Printer.Canvas.TextOut(iBase, jPosition(jBase),
    'PixelsPerInch:  ' + IntToStr(Printer.Canvas.Font.PixelsPerInch));
  INC (jBase, jDelta);

  Printer.Canvas.TextOut(iBase, jPosition(jBase),
    '''TEXT'':  ' + IntToStr(Printer.Canvas.TextWidth('TEXT')) + ' X ' +
                    IntToStr(Printer.Canvas.TextHeight('TEXT')) + '
pixels');

  {GetDeviceCaps Values}
  INC (jBase, 2*jDelta);
  Printer.Canvas.Font.Size := 12;
  Printer.Canvas.Font.Style := [fsBold];
  Printer.Canvas.TextOut(iBase, jPosition(jBase), 'GetDeviceCaps');
  INC (jBase, jDelta);

  Printer.Canvas.Font.Size := 10;
  Printer.Canvas.Font.Style := [];

  FOR j := LOW(DeviceCapsIndex) TO HIGH(DeviceCapsIndex) DO
  BEGIN
    value := GetDeviceCaps(Printer.Handle, DeviceCapsIndex[j]);
    Printer.Canvas.TextOut(iBase, jPosition(jBase), DeviceCapsString[j]);

    IF   (DeviceCapsIndex[j] < 28) OR (DeviceCapsIndex[j] > 38)
    THEN Printer.Canvas.TextOut(iPosition(250), jPosition(jBase), Format('%-8d',  [value]))
    ELSE Printer.Canvas.TextOut(iPosition(250), jPosition(jBase), Format('%.4x', [value]));

    INC (jBase, jDelta);

  END;

  {Put image in lower left corner}
  Printer.Canvas.Draw (iPosition(300), jPosition(100),
                       Form1.Image1.Picture.Graphic);

  {Place same image, 1" wide with appropriate height at location
   4" over and 1" down from top left}
  GraphicAspectRatio := Form1.Image1.Picture.Height /
                        Form1.Image1.Picture.Width;

  iPixelsPerInch := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
  jPixelsPerInch := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
  PixelAspectRatio := jPixelsPerInch / iPixelsPerInch;

  TargetRectangle := Rect(4*iPixelsPerInch,  {4"}
                            jPixelsPerInch,  {1"}
                          6*iPixelsPerInch,  {6" -- 2" wide}
                            jPixelsPerInch +
                          TRUNC(2*iPixelsPerInch * GraphicAspectRatio *
                                PixelAspectRatio));

  Printer.Canvas.TextOut(4*iPixelsPerInch, jPixelsPerInch -
                         Printer.Canvas.TextHeight('X'),
                         '2" wide at (4", 1")');
  Printer.Canvas.StretchDraw (TargetRectangle, Form1.Image1.Picture.Graphic);

  {Write to offscreen bitmap and then copy to Printer Canvas}
  SourceRectangle := Rect (0,0, 3*iPixelsPerInch-1,  2*jPixelsPerInch-1);

  {This should not work!  Rectangle = Left, Top, Right, Bottom
   Top and Bottom are reversed?}
  DestinationRectangle := Rect(4*iPixelsPerInch,    6*jPixelsPerInch,
                               7*iPixelsPerInch-1,  4*jPixelsPerinch-1);

  Printer.Canvas.TextOut(4*iPixelsPerInch, 4*jPixelsPerInch -
                         Printer.Canvas.TextHeight('X'),
                         IntToStr(3*iPixelsPerInch) + ' pixels by ' +
                         IntToStr(2*jPixelsPerInch) + ' pixels -- ' +
                         '3"-by-2" at (4",4")');

  OffScreen := TBitMap.Create;
  TRY
    OffScreen.Width  := SourceRectangle.Right  + 1;
    OffScreen.Height := SourceRectangle.Bottom + 1;
    WITH  OffScreen.Canvas DO
    BEGIN
      Pen.Color := clBlack;
      Brush.Color := clWhite;
      Rectangle(0,0, 3*iPixelsPerInch-1, 2*jPixelsPerInch-1);
      Brush.Color := clRed;
      MoveTo (0,0);
      LineTo (3*iPixelsPerInch-1, 2*jPixelsPerInch-1);

      Brush.Color := clBlue;
      MoveTo (0,0);
      FOR i := 0 TO 3*iPixelsPerInch - 1 DO
      BEGIN
        x := 12*PI*(i / (3*iPixelsPerInch - 1));
        y := jPixelsPerInch + jPixelsPerInch*SIN(x);
        LineTo (i, TRUNC(y));
      END

    END;

    Printer.Canvas.CopyRect(DestinationRectangle, OffScreen.Canvas,
                            SourceRectangle);
  FINALLY
    OffScreen.Free
  END;

  {List the fonts for this printer}
  iBase := iPosition(750);
  Printer.Canvas.Font.Name := 'Times New Roman';
  Printer.Canvas.Font.Size := 12;
  Printer.Canvas.Font.Style := [fsBold];
  Printer.Canvas.TextOut(iBase, jPosition(40), 'Fonts');

  Printer.Canvas.Font.Style := [];
  Printer.Canvas.Font.Size := 10;
  jDelta := 16;
  FOR j := 0 TO Printer.Fonts.Count - 1 DO
  BEGIN
    Printer.Canvas.TextOut(iBase, jPosition(60 + jDelta*j), Printer.Fonts.Strings[j])
  END;

  Printer.EndDoc;

end;


end.

Windows API about Printer

From: David and Rhonda Crowder <dcrowder@bridge.net>

>> I want to obtain the values (left, right, top, bottom) of "unprintable area" from the printer.

In August Delphi Developer "Take Control of your printer with a custom Delphi Class":

To get the Left and Top Printer Margins use the Windows Escape Function with the parameter GETPRINTINGOFFSET.


var
  pntMargins : TPoint;
begin
  { @ means " the address of the variable" }
  Escape(Printer.Handle, GETPRINTINGOFFSET,0,nil,@prntMargins);
end;

Getting the Right and Bottom Margins aren't quite so straightforward. There isn't an equivalent Escape call. You obtain these values by getting the physical width (physWidth) and height (physHeight) of the page, the printable width (PrintWidth) and height (PrintHeight) of the page, and then carrying out the following sums:

RightMargin    := physWidth  - PrintWidth  - LeftMargin
BottomMargin := physHeight - PrintHeight - TopMargin

The physical page size is found using Escape, this time with the GETPHYSPAGESIZE parameter. The point pntPageSize contains the page width in pntPageSize.x and page height in pntPageSize.y


var
  pntPageSize : TPoint;
begin
   Escape(Printer.Handle, GETPHYSPAGESIZE,o,nil,@pntPageSize);
end;

Property changes in same print[NEW]

"D. Bussey" <dbussey@bbtel.com>

How to enable printer property changes ( like paper tray, orientation, etc. ) between pages in the same print document in only six steps.

(The example at the end also shows how to switch paper trays...)

*** THE STEPS ***
  1. Create a copy of Printers.pas and rename the copy to NewPrint.pas.

    ***DO NOT make these changes to Printers.pas, if you do you will get an error saying "Unable to find printers.pas" when you compile your application. (Well, that's the error I received...)***

  2. Move NewPrint.pas to the Lib directory.

    (Usually "C:\Program Files\Borland\Delphi 2.0\Lib" )
  3. Change the UNIT NAME in NewPrint.pas

    from:
    unit Printers;

    to:
    unit NewPrint;

  4. Add the following PUBLIC METHOD declaration to the TPrinter object definition in the Interface section of NewPrint.pas:


       procedure NewPageDC(DM: PDevMode);
    

  5. Add the following procedure to the Implementation section of NewPrint.pas:


    procedure TPrinter.NewPageDC(DM: PDevMode);
       begin
          CheckPrinting(True);
          EndPage(DC);
         {Check to see if new device mode setting were passed}
          if Assigned(DM) then
            ResetDC(DC,DM^);
          StartPage(DC);
          Inc(FPageNumber);
          Canvas.Refresh;
      end;
    

  6. Instead of adding "Printers" to the USES clause of your application, add "NewPrint".

    EVERYTHING ELSE WORKS EXACTLY THE SAME (ie BeginDoc, EndDoc, NewPage, etc.) but you now have the capability of changing printer settings on the fly between pages WITHIN THE SAME PRINT DOCUMENT. (The example below shows how.)

    Instead of calling:


       Printer.NewPage;
    

    call:
       Printer.NewPageDC(DevMode);
    

    Here is the small example (with bytes of code from other print altering routines I've gathered).


    procedure TForm1.Button1Click(Sender: TObject);
    var
      ADevice, ADriver, APort: array [0..255] of char;
      ADeviceMode: THandle;
      DevMode: PDevMode;
    begin
        with Printer do begin
          GetPrinter(ADevice,ADriver,APort,ADeviceMode);
          SetPrinter(ADevice,ADriver,APort,0);
          GetPrinter(ADevice,ADriver,APort,ADeviceMode);
          DevMode := GlobalLock(ADeviceMode);
          if not Assigned(DevMode) then ShowMessage('Can''t set printer.')
          else begin
            with DevMode^ do begin
              {Put any other settings you want here}
              dmDefaultSource := DMBIN_UPPER;
             {these codes are listed in "Windows.pas"}
            end;
            GlobalUnlock(ADeviceMode);
            SetPrinter(ADevice,ADriver,APort,ADeviceMode);
          end;
        end;
    
        Printer.BeginDoc;
        Printer.Canvas.TextOut(50,50,'This page is printing from the UPPER PAPER TRAY.');
    
        with DevMode^ do begin
          {Put any other settings you want here}
          dmDefaultSource := DMBIN_LOWER;
         {these codes are listed in "Windows.pas"}
        end;
    
        Printer.NewPageDC(DevMode);
    
        Printer.Canvas.TextOut(50,50,'This page is printing from the LOWER PAPER TRAY.');
        Printer.EndDoc;
    end;
    
    
    {*************************************************************
    
    Notes from the author:
    
    I've used this myself in applications for my job so I know it will work.
    
    These modifications were made in Delphi Client/Server 2.01 running on WinNT 4.0
    but they should work with Delphi 2.0 Standard and Professional, and under Windows95
    as well.  I have not tried them with Delphi 3 yet...  If anyone has any comments
    or questions, feel free to mail me...
    
                                             David A. Bussey
                                             ERC/RAL Developer
                                             River City Bank
                                             dbussey@bbtel.com
    
    ************************************************************}
    

    Paper Formats[NEW]

    here is an example that lists the paper formats for the default printer:


    procedure TForm1.Button2Click(Sender: TObject);
    Type
      TPaperName = Array [0..63] of Char;
      TPaperNameArray = Array [1..High(Cardinal) div Sizeof( TPaperName )] of
                          TPaperName;
      PPapernameArray = ^TPaperNameArray;
    Var
      Device, Driver, Port: Array [0..255] of Char;
      hDevMode: THandle;
      i, numPaperformats: Integer;
      pPaperFormats: PPapernameArray;
    begin
      Printer.PrinterIndex := -1;
      Printer.GetPrinter(Device, Driver, Port, hDevmode);
      numPaperformats :=
        WinSpool.DeviceCapabilities( Device, Port, DC_PAPERNAMES, Nil, Nil );
      If numPaperformats > 0 Then Begin
        GetMem( pPaperformats, numPaperformats * Sizeof( TPapername ));
        try
          WinSpool.DeviceCapabilities( Device, Port, DC_PAPERNAMES,
                                       Pchar( pPaperFormats ), Nil);
          memo1.clear;
          For i:= 1 To numPaperformats Do
            memo1.lines.add( pPaperformats^[i] );
        finally
          FreeMem( pPaperformats );
        end;
      End;
    End;
    


    Please email me and tell me if you liked this page.