VB Forum / General 2 / April 2004

I've (almost!) given up answering questions about printing, because there
are so many systems and so many variations (most of which I don't have
access to) and they all behave in different ways when it comes to accessing
the printer. Makes it a little difficult for a simple hobbyist to check out
his code samples before posting. The one thing I would definitely advise
though is that you give up the VB printer object completely. There are far
too many problems with it. Instead you should print your stuff to the handle
returned by the CommonDialog control using the various API print output
methods. Personally, I'd also advise getting rid of the standard
CommonDialog control as well, but I haven't got to that stage (yet). Most
printer object problems relate to the failure to take account of the
settings made by the user without "messing up" the system default printer
settings, although there are many other problems as well.

Try out the following code, which solves those problems and works well on
the systems that I can test it on (Win 98 under all user variations and Win
XP with either a single user or where the user has administrator privileges.
I haven't been able to test it on XP systems where the user does not have
administator privileges, or on any other version of Windows. (Perhaps some
people here may be able to test it for me and let me know the result). To
try it out properly you should deliberately set your system so that the
"Windows default printer" is *not* the printer that you intend to use for
your test printing (perhaps another printer or a fax driver or something).
Then run the code (click the Command Button) and when the dialog box appears
select any printer other than the current "Windows default printer" and
alter its parameters (orientation, print quality etc) to the desired output
settings. You should (hopefully) find that the output prints exactly as you
have selected. Then, use Control Panel to have a look if anything has
changed. You should find that the "Windows default printer" has *not*
changed from its previous setting (even though your output was sent to your
selected printer which is different from the Windows default). You should
also find that the printer that you actually printed your stuff to has *not*
had its default settings altered by the print job. For example, if the
default seting was Portrait and you selected Landscape when printing, the
act of printing should *not* have caused your default settings to change
from their original Portrait (even though your actual output was in
Landscape, as selected). Paste the following code into a VB Form containing
one CommonDialog control and one Command Button. The code is quite long, but
it does a bit more than you have asked (for example, it prints output to
exact locations on the page regardless of the "unprintable margins" of the
selected printer). Feedback would be appreciated:

Option Explicit
Private Declare Function StartDoc Lib "gdi32" Alias _
 "StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
Private Declare Function EndDoc Lib "gdi32" _
 (ByVal hdc As Long) As Long
Private Declare Function StartPage Lib "gdi32" _
 (ByVal hdc As Long) As Long
Private Declare Function EndPage Lib "gdi32" _
 (ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
 (ByVal hdc As Long, ByVal nindex As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
 (ByVal hdc As Long) As Long
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const PHYSICALOFFSETX = 112
Private Const PHYSICALOFFSETY = 113
Private Const LF_FACESIZE = 32
Private Type LOGFONT
   lfHeight As Long
   lfWidth As Long
   lfEscapement As Long
   lfOrientation As Long
   lfWeight As Long
   lfItalic As Byte
   lfUnderline As Byte
   lfStrikeOut As Byte
   lfCharSet As Byte
   lfOutPrecision As Byte
   lfClipPrecision As Byte
   lfQuality As Byte
   lfPitchAndFamily As Byte
   lfFaceName As String * LF_FACESIZE
End Type
Private Declare Function CreateFontIndirect Lib "gdi32" _
Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias _
"TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal _
y As Long, ByVal lpString As String, ByVal nCount _
As Long) As Long
Private Type DOCINFO
 cbSize As Long
 lpszDocName As String
 lpszOutput As String
 lpszDatatype As String
 fwType As Long
End Type
Private Type MyPrinterInfo
 Handle As Long
 dpiX As Long
 dpiY As Long
 OffsetX As Long ' the position of the top left corner of the
 OffsetY As Long ' "printable area" of the page
End Type
Private MyPrinter As MyPrinterInfo

Private Function GetMyPrinter() As Boolean
CommonDialog1.PrinterDefault = False
CommonDialog1.Flags = cdlPDReturnDC
CommonDialog1.CancelError = True
On Error GoTo UserCancel
CommonDialog1.ShowPrinter
MyPrinter.Handle = CommonDialog1.hdc
MyPrinter.dpiX = GetDeviceCaps _
 (MyPrinter.Handle, LOGPIXELSX)
MyPrinter.dpiY = GetDeviceCaps _
 (MyPrinter.Handle, LOGPIXELSY)
MyPrinter.OffsetX = GetDeviceCaps _
 (MyPrinter.Handle, PHYSICALOFFSETX)
MyPrinter.OffsetY = GetDeviceCaps _
 (MyPrinter.Handle, PHYSICALOFFSETY)
GetMyPrinter = True
Exit Function
UserCancel:
GetMyPrinter = False
End Function

Private Sub PrinterText(s1 As String, x As Single, y As Single)
Dim xpos As Long, ypos As Long
xpos = x * MyPrinter.dpiX - MyPrinter.OffsetX
ypos = y * MyPrinter.dpiY - MyPrinter.OffsetY
TextOut MyPrinter.Handle, xpos, ypos, s1, Len(s1)
End Sub

Private Sub Command1_Click()
Dim iret As Long
Dim s1 As String, xpos As Long, ypos As Long
Dim docinf As DOCINFO
' set up an initial font
Dim log_font As LOGFONT, new_font As Long, old_font As Long
If Not GetMyPrinter Then Exit Sub
With log_font
 .lfEscapement = 0 ' desired rotation in tenths of a degree
 .lfHeight = 12 * (-MyPrinter.dpiY / 72) ' 12 points
 .lfFaceName = "Times New Roman" & vbNullChar
 .lfWeight = 400 ' standard (bold = 700)
 .lfItalic = False
 .lfUnderline = False
End With
new_font = CreateFontIndirect(log_font)
old_font = SelectObject(MyPrinter.Handle, new_font)
' start a document
docinf.cbSize = Len(docinf) ' Size of DOCINFO structure
iret = StartDoc(MyPrinter.Handle, docinf) 'Start new document
iret = StartPage(MyPrinter.Handle)    'Start a new page
'
' print a simple line of text at position (1, 1) (inches)
PrinterText "Hello World.", 1, 1
' end page
iret = EndPage(MyPrinter.Handle) 'End the page
' end the document
SelectObject MyPrinter.Handle, old_font
DeleteObject new_font ' clear up the font
iret = EndDoc(MyPrinter.Handle) 'End the print job
iret = DeleteDC(MyPrinter.Handle)
End Sub