Re: test printer code

Tech Tip: Click here to run a free scan for Windows Errors and optimize PC performance


Ok , I tested :-)

It printed on my HP 6P local laser
Did not print on my network printer

The print out had the rectangle:

left margin - 1 inch
top margin - 16/16 ths of inch
right margin - just a tad under an inch ~1/32"
bottom margin - 1 1/16 inch

Regards
Saga

"Mike Williams" <Mike@xxxxxxxxxxxxxxxxx> wrote in message
news:e02QPiGSGHA.5656@xxxxxxxxxxxxxxxxxxxxxxx
Hi All

I would really appreciate it if any of you would do me a favour and
kindly test the following printer code for me. It should enable you to
print (using the API instead of the VB printer object) to any printer
you select, and it should do so without messing up the default printer
settings. I am particularly interested in finding out if it works
reliably with printers on a network, in as many different network
configurations as possible. If you would like to help me then please
paste the code into a VB Form containing a CommonDialog Control and a
Command Button and run the code and click the button and let me know
whether or not it works for you.

By the way, I'm sorry for posting to clbvm and to the microsoft public
vb group separately, but I don't know how to post properly to two
groups that are on different servers on my machine :-(

Mike

Option Explicit
' Printing without using the VB printer object.
' Code by Mike Williams (Whisky & Coke®).
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 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 Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nindex As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" _
(ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function Rectangle Lib "gdi32" _
(ByVal hdc As Long, ByVal x1 As Long, ByVal y1 As Long, _
ByVal x2 As Long, ByVal y2 As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Private Const LF_FACESIZE = 32
Private Const LOGPIXELSX = 88
Private Const LOGPIXELSY = 90
Private Const PHYSICALOFFSETX = 112
Private Const PHYSICALOFFSETY = 113
Private Const PHYSICALWIDTH = 110
Private Const PHYSICALHEIGHT = 111
Private Const POINTSPERINCH = 72
Private Const NORMAL = 400
Private Const BOLD = 700
Private Const TRANSPARENT = 1
Private Const OPAQUE = 2
Private Type DOCINFO
cbSize As Long
lpszDocName As String
lpszOutput As String
lpszDatatype As String
fwType As Long
End Type
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 Type PrinterInfo
Handle As Long
PixPerInchX As Long
PixPerInchY As Long
OffsetX As Long
OffsetY As Long
PageWidthInches As Single
PageHeightInches As Single
End Type
Private MyPrinter As PrinterInfo
Private UserCancelled As Boolean
Private myFont As LOGFONT
Private hOldfont As Long
Private hNewFont As Long

Private Sub GetMyPrinter()
UserCancelled = False
CommonDialog1.PrinterDefault = False
CommonDialog1.CancelError = True
CommonDialog1.Flags = cdlPDReturnDC
On Error GoTo dlgError
CommonDialog1.ShowPrinter
On Error GoTo 0
MyPrinter.Handle = CommonDialog1.hdc
MyPrinter.PixPerInchX = GetDeviceCaps _
(MyPrinter.Handle, LOGPIXELSX)
MyPrinter.PixPerInchY = GetDeviceCaps _
(MyPrinter.Handle, LOGPIXELSY)
MyPrinter.OffsetX = GetDeviceCaps _
(MyPrinter.Handle, PHYSICALOFFSETX)
MyPrinter.OffsetY = GetDeviceCaps _
(MyPrinter.Handle, PHYSICALOFFSETY)
MyPrinter.PageWidthInches = CSng(GetDeviceCaps _
(MyPrinter.Handle, PHYSICALWIDTH)) / _
MyPrinter.PixPerInchX
MyPrinter.PageHeightInches = CSng(GetDeviceCaps _
(MyPrinter.Handle, PHYSICALHEIGHT)) / _
MyPrinter.PixPerInchY
' GetDeviceCaps can get lots of other info which we
' haven't yet bothered with here.
' Set up a default font to Times new Roman size 12
myFont.lfFaceName = "Times New Roman" + Chr$(0)
myFont.lfEscapement = 0 ' rotation in tenths of a degree
myFont.lfHeight = 12 * (-MyPrinter.PixPerInchY / _
POINTSPERINCH) ' 12 point text
myFont.lfWeight = NORMAL
hNewFont = CreateFontIndirect(myFont) 'Create the font
' Select our font structure and save previous font info
hOldfont = SelectObject(MyPrinter.Handle, hNewFont)
SetBkMode MyPrinter.Handle, TRANSPARENT ' FontTransparent
Exit Sub
dlgError:
UserCancelled = True
End Sub

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

Private Sub RectPrint(x1 As Single, y1 As Single, _
x2 As Single, y2 As Single)
Rectangle MyPrinter.Handle, _
x1 * MyPrinter.PixPerInchX - MyPrinter.OffsetX, _
y1 * MyPrinter.PixPerInchY - MyPrinter.OffsetY, _
x2 * MyPrinter.PixPerInchX - MyPrinter.OffsetX, _
y2 * MyPrinter.PixPerInchY - MyPrinter.OffsetY
End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim lret As Long
If MyPrinter.Handle <> 0 Then
' Reset font back to original and delete font we created
lret = SelectObject(MyPrinter.Handle, hOldfont)
lret = DeleteObject(hNewFont) 'Delete the font object
' delete the device context (I'm not sure whether the VB
' CommonDialog will automatically delete the dc it
' created, but I don't suppose it can do any harm to
' delete it here).
DeleteDC MyPrinter.Handle
End If
End Sub

Private Sub Command1_Click()
Dim lret As Long, s1 As String, docinf As DOCINFO
GetMyPrinter
If UserCancelled Then
Exit Sub
End If
' start a document
docinf.cbSize = 20 ' Size of DOCINFO structure
lret = StartDoc(MyPrinter.Handle, docinf) 'Start new document
lret = StartPage(MyPrinter.Handle) 'Start a new page
' print a rectangle using the default pen to show a
' full page one inch border
RectPrint 1, 1, MyPrinter.PageWidthInches - 1, _
MyPrinter.PageHeightInches - 1
' now print some text
s1 = "Text is positioned so that the top left corner "
TextPrint s1, 2, 2 ' print some text at position (2, 2)
s1 = "of the *character cell* of the first character is "
TextPrint s1, 2, 2.2
s1 = "at the specified position. This example code also "
TextPrint s1, 2, 2.4
s1 = "prints a rectangle with an exact one inch border."
TextPrint s1, 2, 2.6
' end page and document
lret = EndPage(MyPrinter.Handle) 'End the page
lret = EndDoc(MyPrinter.Handle) 'End the document
End Sub




.

Quantcast