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.
'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;
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;
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;
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: "James D. Rofkar" <jim_rofkar%lotusnotes1@instinet.com>
For those of you who are sick and tired of mucking around with ReportSmith, only to find limitations, drawbacks, etc. And have grown tired of trying to find that perfect WYSIWYG report generator.
Well...
Chances are you've got a good one already. It's called MS-Word! That's right! Use Word for report generation. It's actually quite easy with OLE Automation. I know that word (OLE) scares some of you, but check-out this code:
var
Word: Variant;
begin
Word := CreateOleObject('Word.Basic');
with Word do
begin {Pure WordBASIC commands follow...}
FileNew('Normal');
Insert('This is the first line'#13);
Insert('This is the second line'#13);
FileSaveAs('c:\temp\test.txt', 3);
end;
end;
Simple, isn't it? If you notice, there's no need for SendMessage(), or PostMessage(), or DDE, or Word's C-API, or some proprietary DOS-based batch programming that requires text files to be written. In fact, none of that junk!
Another benefit of OLE Automation is that it doesn't require the darned app to launch. That's right! Word does not show-up using this technique. Instead, just the WordBASIC engine is used. The speed improvements and lower memory footprint kick the livin' crap out of the techniques listed in the previous paragraph.
A wild side-benefit is that if you startup Word while your program is using OLE Automation, you can watch it work. Yup! Word realizes that "documents" are opened and being editing, and hence, displays them like regular old Word documents.
Now all you need to do is generate a Word template with Bookmarks! Then, using the WordBASIC commands "EditBookmark .Goto" and "Insert", you're ready to rock!
I've given-up on report generators. They suck compared to Word's WYSIWYG output!
- Jim Rofkar.
P.S. - If you use this technique, try to incorporate my name somewhere in your source comments. Thanks. I'll return the favor if I use one of your cool hacks!
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.
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.
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;
"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.
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 theTry this:bitmap regions, making them almost gray. This is an obvius undesired effect. Does anybody knows some approach to help me?
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;
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.