Copying PictureBox to Printer

[John G Duffy]

WITHOUT USING THE PRINTER OBJECT, which precludes using the PAINTPICTURE method, How can I print a Picturebox on the Printer.
Currently I am using the following APIS to produce text on the printer (successfully I might add)
StartDoc
EndDoc
StartPage
EndPage
TextOut

But I can't figure out how to put a Picture image on the printer. BITBLT doesn't like my attempts for some reason. Here is my BitBlt. picHdc is the printer and pmask is a Picturebox.
Pmask is correct because when I use the printer Objects .PaintPicture, I get a picture on the printer but it's on a seperate page from one that I am building.

BitBlt pichdc, 0, 0, pMask.Width, pMask.Height, pMask.hdc, 0, 0, SRCCOPY



'
What stupid thing am I doing wrong????????

John G

[John G Duffy]

To answer my own question, Here is a working sample of how to "Print" a Picturebox and text without using the Printer object.
1) Add a Command button and a PictureBox to a form.
2) Add a picture to the PictureBox. Make it a picture so it shows about 1" by 1" on the screen.
3) Set AutoRedraw and AutoSize to true in the PictureBox
4) Paste the attached code into the Form.
5) Run the program and click the button.
'
Viola. No more Printer object bugs/ restrictions to contend with. This program uses APis STARTDOC, STARTPAGE etc to manage the printer.

option Explicit
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
'
Dim lf as LOGFONT
'
private Type DOCINFO
cbSize as Long
lpszDocName as string
lpszOutput as string
lpszDatatype as string
fwType as Long
End Type
'
Dim di as DOCINFO 'Structure for print Document info
'
private Declare Function CreateCompatibleDC Lib "gdi32" (byval hdc as Long) as Long

private Declare Function SelectObject Lib "gdi32" (byval hdc as Long, byval hObject as Long) as Long

private Declare Function StretchBlt Lib "gdi32" (byval hdc as Long, byval x as Long, _
byval y as Long, byval nWidth as Long, byval nHght 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

private Declare Function DeleteDC Lib "gdi32" (byval hdc as Long) as Long

private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
(byval lpDriverName as string, byval lpDeviceName as string, _
byval lpOutput as Long, byval lpInitData as Long) as Long

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 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 SetTextColor Lib "gdi32" _
(byval hdc as Long, byval crColor as Long) as Long

private Declare Function CreateFontIndirect Lib "gdi32" Alias _
"CreateFontIndirectA" (lpLogFont as LOGFONT) as Long

private Declare Function DeleteObject Lib "gdi32" _
(byval hObject as Long) as Long
'
Sub Command1_Click()
Const SRCCOPY = &HCC0020
Dim hMemoryDC as Long
Dim hOldBitMap as Long
Dim APIError as Long
Dim hPrintDC as Long
Dim lret as Long
'* Display hour glass.
MousePointer = vbHourglass
'
' Make sure we have a Picture
Picture1.Picture = Picture1.Image
'
'* StretchBlt requires pixel coordinates.
Picture1.ScaleMode = vbPixels
Printer.ScaleMode = vbPixels
' Create a printer device context
hPrintDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
' Start a new Document and Page in the Document
lret = StartDoc(hPrintDC, di) 'Start a new print document
lret = StartPage(hPrintDC) 'Start a new page
'
' print some text
DrawText hPrintDC, 4500, 10500, "This is RED TEXT printed using TEXTOUT API", 90, _
"Times new Roman", vbRed, 12
'
' Do some Magic
hMemoryDC = CreateCompatibleDC(Picture1.hdc)
hOldBitMap = SelectObject(hMemoryDC, Picture1.Picture)
'
' Copy picture to the printer
lret = StretchBlt(hPrintDC, 0, 0, Picture1.ScaleWidth + 1000, _
Picture1.ScaleHeight + 1000, hMemoryDC, 0, 0, Picture1.ScaleWidth, _
Picture1.ScaleHeight, SRCCOPY)
'
' Restore the magic
hOldBitMap = SelectObject(hMemoryDC, hOldBitMap)
' Cleanup
lret = DeleteDC(hMemoryDC)
' close the document
lret = EndPage(hPrintDC) 'End the page
lret = EndDoc(hPrintDC) 'End the print job
lret = DeleteDC(hPrintDC) 'Delete the printer device context
MousePointer = vbNormal
End Sub
'
' Draw some text on the object.
Sub DrawText(obj as Long, _
x as Long, y as Long, _
Text, Angle, FontName, _
fColor, FontSize)

Dim OutString as string
Dim Result as Long
Dim hOldfont as Long
Dim hPrintDC as Long
Dim hFont as Long
Dim l, t ' left and top
l = x / Printer.TwipsPerPixelX
t = y / Printer.TwipsPerPixelY
hPrintDC = obj
SetTextColor hPrintDC, fColor
lf.lfEscapement = Angle * 10 ' Rotation
lf.lfWeight = 400 ' Duplicate Printer.print default
lf.lfCharSet = 1 ' Default
lf.lfClipPrecision = 0 ' Default
lf.lfOutPrecision = 0 ' Default
lf.lfQuality = 0 ' Default
lf.lfPitchAndFamily = 0 ' Default
lf.lfFaceName = FontName ' Font Name
lf.lfHeight = (FontSize * -20) / -Printer.TwipsPerPixelY

hFont = CreateFontIndirect(lf)
hOldfont = SelectObject(hPrintDC, hFont)

Result = TextOut(hPrintDC, l, t, Text, len(Text))

Result = SelectObject(hPrintDC, hOldfont)
Result = DeleteObject(hFont)

End Sub




John G