Re: Printing image control

On 7 Jun, 22:07, "FormulaZ" <formula...@xxxxxxxxxxxx> wrote:

Mike, I had assume that I could get the hDC from
the CommonDiallog and use it for the Printer object,
but after further testing it does not seem possible,
as you stated.

No. It isn't. You need to print directly to the returned DC.

I'm not afraid of writing to the API. I really
prefer the flexibility of them.

Good. The VB Printer Object makes it really easy to perform various
printing jobs, but it is virtually impossible to pass all of the
user's dialog choices onto it. Many of them can be transferred to the
printer object, but many of them cannot. There are lots of other
problems as well with the VB printer object concerning problems with
the default printer settings and various other things. Many of the
problems can be overcome in various different ways, but not all of
them. There are some examples on MSDN showing how to assign many (but
not all) of the dialog properties to the VB printer object, but none
of it is really satisfactory.

Printing directly to the DC returned by the CommonDialog overcomes all
of those problems, and it overcomes them in a way that allows your
user to make any selections he wishes in the dialog, including all of
the sometimes esoteric settings that are impossible to get at with the
VB printer object or the MSDN examples, no matter what you do. Also,
it does this in a way that leaves the standard default printer and its
settings untouched, which is what you should always aim to achieve.

Here's some code to get you started. As with most of the code that I
write, it is unfinished (I never get around to actually finishing
anything!). Generally I discover a problem and I potter around until I
have satisfied myself that I can solve that specific problem and then
I get sidetracked onto something else! Once I have decided in my own
mind that I can actually perform a specific task then that's usually
enough for me, and I lose interest in it and end up with lots of half
finished projects!

Anyway, here's the code as I've got it so far. It shows you how to
print text (at any angle) and rectangles and pictures. Most of the
other things you might want should be fairly easy to add. Paste the
first block into a VB code module and paste the second block into a VB
Form (On the Form you'll need a CommonDialog Control and a Command
Button and an Image Control with a picture assigned to it). The code
is quite "rough and ready" and it needs a fair bit of tidying up. For
example I think I should really be using StretchDIBits rather than
StretchBlt for the pictures, but it seems to work okay. Run the
project and click the button and you will be presented with a dialog
allowing the user to select a printer and any of its various settings.
The code should then print two pages. On the first page it should
print a rectangle outline (one inch page border all around) and a
small 3 x 2 inch picture with some text on top of it. The second page
should just have some text on it. The code takes into account the
different "unprintable margins" on different printers and so
everything should be printed at the exact position on the page
regardless of the printer you are using. The printing should be done
without upsetting the standard default printer or any of its settings.

Let me know how it goes. You'll have to excuse the rather rough edged
code. I really should get around to deciding what parts should
properly be in the module and what parts should properly be in the
Form and sorting out what stuff should remain as Public and what stuff
should really be Private and various other things. I never seem to
have the tenacity to stick at things long enough to get around to such
details :-(

Mike

' ***** START OF MODULE CODE *****
Option Explicit
Public Declare Function StartDoc Lib "gdi32" Alias _
"StartDocA" (ByVal hdc As Long, lpdi As DOCINFO) As Long
Public Declare Function EndDoc Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function StartPage Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function EndPage Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function CreateFontIndirect Lib "gdi32" _
Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long
Public Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
Public 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
Public Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nindex As Long) As Long
Public Declare Function SetBkMode Lib "gdi32" _
(ByVal hdc As Long, ByVal nBkMode As Long) As Long
Public 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
Public Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) As Long
Public Declare Function SetStretchBltMode Lib "gdi32" _
(ByVal hdc As Long, ByVal nStretchMode As Long) As Long
Private Declare Function LoadImage Lib "User32.dll" _
Alias "LoadImageA" (ByVal hInst As Long, ByVal _
lpsz As String, ByVal un1 As Long, ByVal n1 As Long, _
ByVal n2 As Long, ByVal un2 As Long) As Long
Public Declare Function StretchBlt Lib "gdi32" _
(ByVal hdc As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal hSrcDC As Long, ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
Public Const LF_FACESIZE = 32
Public Const LOGPIXELSX = 88
Public Const LOGPIXELSY = 90
Public Const PHYSICALOFFSETX = 112
Public Const PHYSICALOFFSETY = 113
Public Const PHYSICALWIDTH = 110
Public Const PHYSICALHEIGHT = 111
Public Const POINTSPERINCH = 72
Public Const NORMAL = 400
Public Const BOLD = 700
Public Const TRANSPARENT = 1
Public Const OPAQUE = 2
Public Const IMAGE_BITMAP As Long = &H0
Public Const LR_LOADFROMFILE As Long = &H10
Public Const LR_CREATEDIBSECTION As Long = &H2000
Public Const STRETCH_ANDSCANS = 1
Public Const STRETCH_ORSCANS = 2
Public Const STRETCH_DELETESCANS = 3
Public Const STRETCH_HALFTONE = 4
Public Type DOCINFO
cbSize As Long
lpszDocName As String
lpszOutput As String
lpszDatatype As String
fwType As Long
End Type
Public 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
Public 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
' ***** END OF MODULE CODE *****
'
'
'
' ***** START OF FORM CODE *****
Option Explicit
' Printing without using the VB printer object.
' Code by Mike Williams (Whisky & Coke®).
' Code still in development stage
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.Min = 1
CommonDialog1.Max = 2
CommonDialog1.Flags = cdlPDReturnDC 'Or cdlPDPrintSetup
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
' I haven't yet bothered with here.
' Set up a default font to Times new Roman size 16
myFont.lfFaceName = "Times New Roman" + Chr$(0)
myFont.lfEscapement = 0 ' rotation in tenths of a degree
myFont.lfHeight = 16 * (-MyPrinter.PixPerInchY / _
POINTSPERINCH) ' 16 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
' Set the stretch mode
SetStretchBltMode MyPrinter.Handle, STRETCH_DELETESCANS
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 Function PrintImage(p1 As StdPicture, _
x As Single, y As Single, _
wide As Single, high As Single) As Boolean
Dim hOldBitmap As Long, hMemoryDC As Long
hMemoryDC = CreateCompatibleDC(Me.hdc)
hOldBitmap = SelectObject(hMemoryDC, p1)
StretchBlt MyPrinter.Handle, _
x * MyPrinter.PixPerInchX - MyPrinter.OffsetX, _
y * MyPrinter.PixPerInchY - MyPrinter.OffsetY, _
wide * MyPrinter.PixPerInchX, _
high * MyPrinter.PixPerInchY, _
hMemoryDC, _
0, 0, _
Me.ScaleX(p1.Width, vbHimetric, vbPixels), _
Me.ScaleY(p1.Height, vbHimetric, vbPixels), _
vbSrcCopy
hOldBitmap = SelectObject(hMemoryDC, hOldBitmap)
DeleteDC hMemoryDC
End Function

Private Sub Command2_Click()
Print Me.ScaleX(Image1.Picture.Width, vbHimetric, vbPixels)
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
If lret < 0 Then
MsgBox "Failed to start document!"
Exit Sub
End If
lret = StartPage(MyPrinter.Handle) 'Start a new page
If lret < 0 Then
MsgBox "Failed to start page!"
EndDoc MyPrinter.Handle
Exit Sub
End If
RectPrint 1, 1, MyPrinter.PageWidthInches - 1, _
MyPrinter.PageHeightInches - 1
' print image at 1,1 size 3 x 2
PrintImage Image1.Picture, 1, 1, 3, 2
' now print some text
s1 = "This is some text on page ONE "
TextPrint s1, 1, 1 ' print some text at position (2, 2)
lret = EndPage(MyPrinter.Handle) 'End the page
lret = StartPage(MyPrinter.Handle)
s1 = "And this is on page Two"
TextPrint s1, 1, 1
lret = EndPage(MyPrinter.Handle) 'End the page
lret = EndDoc(MyPrinter.Handle) 'End the document
lret = DeleteDC(MyPrinter.Handle)
End Sub
' ***** END OF FORM CODE *****





.

Relevant Pages