Printer
From: [email protected] (David Block)
Vincent Lim <[email protected]> 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.
'Joe C. Hecht' <[email protected]>
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;
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;
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;
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.
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;
[email protected] (Alexander Wernhart)
On Tue, 4 Feb 1997 20:54:43 -0300, Ruy Ponce de Leon Junior <[email protected]> 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;
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;
From: Chris Monson <[email protected]>
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.
From: Peter van Lonkhuyzen <[email protected]>
> 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.
[email protected] (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;
"Joe C. Hecht" <[email protected]>
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.
From: "Earl F. Glynn" <[email protected]>
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.
From: David and Rhonda Crowder <[email protected]>
>> 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;
"D. Bussey" <[email protected]>
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 ***
***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...)***
(Usually "C:\Program Files\Borland\Delphi 2.0\Lib" )
from:
unit Printers;
to:
unit NewPrint;
procedure NewPageDC(DM: PDevMode);
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;
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
[email protected]
************************************************************}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.
Last modified 04/09/1998 11:25:50