|
|
Const NEWFRAME = 1
Private Declare Function Escape Lib "gdi32" (ByVal hdc As Long, ByVal nEscape As Long, ByVal nCount As Long, ByVal lpInData As String, lpOutData As Any) As Long
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 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
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Dim hMemoryDC As Long
Private Sub Command1_Click()
'KPD-Team 1999
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'API uses pixels
Picture1.ScaleMode = vbPixels
Printer.ScaleMode = vbPixels
'Take paper
Printer.Print ""
'Create a compatible device context
hMemoryDC = CreateCompatibleDC(Picture1.hdc)
'Select Picture1's picture into our new device context
hOldBitMap = SelectObject(hMemoryDC, Picture1.Picture)
'Stretch our picture to the height and width of the paper
StretchBlt Printer.hdc, 0, 0, Printer.ScaleWidth, Printer.ScaleHeight, hMemoryDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
'Select the original bitmap into our DC
hOldBitMap = SelectObject(hMemoryDC, hOldBitMap)
'Delete our memorydc
DeleteDC hMemoryDC
'Access our printer device
Escape Printer.hdc, NEWFRAME, 0, 0&, 0&
'End of document
Printer.EndDoc
End Sub
|
|
