to Sam_E: '执行一下 Picture1.Print "aa" Form1.Print "aa" '你就知道是干嘛的了 'Clipboard 和 Printer.PaintPicture Option Explicit Private Const HORZRES = 8 Private Const VERTRES = 10 Private Const CF_BITMAP = 2 Private Const SRCCOPY = &HCC0020 Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function CreateCompatibleDC 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Private Sub Command1_Click() Dim hScrDC As Long hScrDC = GetDC(Picture1.hwnd) Dim hMemDC As Long hMemDC = CreateCompatibleDC(hScrDC) Dim xScrn As Integer Dim yScrn As Integer Picture1.ScaleMode = vbPixels xScrn = Picture1.ScaleWidth '+ 200 yScrn = Picture1.ScaleHeight '+ 200 Dim hBitmap As Long hBitmap = CreateCompatibleBitmap(hScrDC, xScrn, yScrn) Dim hOldmap As Long hOldmap = SelectObject(hMemDC, hBitmap) BitBlt hMemDC, 0, 0, xScrn, yScrn, hScrDC, 0, 0, SRCCOPY hBitmap = SelectObject(hMemDC, hOldmap) DeleteDC hScrDC DeleteDC hMemDC OpenClipboard hwnd EmptyClipboard SetClipboardData CF_BITMAP, hBitmap CloseClipboard Dim pictureX As Picture Set pictureX = Clipboard.GetData() Printer.Print " " Printer.PaintPicture pictureX, 0, 0 Printer.EndDoc End Sub
to playyer: 谢谢,您的方法我试过了,可以的。只是打印出来的效果是图像拷贝的效果。 有没有更好的办法,能忠实的复制pictbox的样子,同时又保持持打印分辨率呢? 还有个问题,如果用pictbox作打印预览。应该怎么做呢? 刚才的程序我试过了,如果把取得的图像放在image里,可以作简单的预览效果,但是由于图像质量差,效果不好。如果缩放picbox,如何缩放里面的控件大小?算法是怎样呢?
'执行一下
Picture1.Print "aa"
Form1.Print "aa"
'你就知道是干嘛的了
'Clipboard 和 Printer.PaintPicture
Option Explicit
Private Const HORZRES = 8
Private Const VERTRES = 10
Private Const CF_BITMAP = 2
Private Const SRCCOPY = &HCC0020
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CreateCompatibleDC 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 CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Sub Command1_Click()
Dim hScrDC As Long
hScrDC = GetDC(Picture1.hwnd)
Dim hMemDC As Long
hMemDC = CreateCompatibleDC(hScrDC)
Dim xScrn As Integer
Dim yScrn As Integer
Picture1.ScaleMode = vbPixels
xScrn = Picture1.ScaleWidth '+ 200
yScrn = Picture1.ScaleHeight '+ 200
Dim hBitmap As Long
hBitmap = CreateCompatibleBitmap(hScrDC, xScrn, yScrn)
Dim hOldmap As Long
hOldmap = SelectObject(hMemDC, hBitmap)
BitBlt hMemDC, 0, 0, xScrn, yScrn, hScrDC, 0, 0, SRCCOPY
hBitmap = SelectObject(hMemDC, hOldmap)
DeleteDC hScrDC
DeleteDC hMemDC
OpenClipboard hwnd
EmptyClipboard
SetClipboardData CF_BITMAP, hBitmap
CloseClipboard
Dim pictureX As Picture
Set pictureX = Clipboard.GetData()
Printer.Print " "
Printer.PaintPicture pictureX, 0, 0
Printer.EndDoc
End Sub
谢谢,您的方法我试过了,可以的。只是打印出来的效果是图像拷贝的效果。
有没有更好的办法,能忠实的复制pictbox的样子,同时又保持持打印分辨率呢?
还有个问题,如果用pictbox作打印预览。应该怎么做呢?
刚才的程序我试过了,如果把取得的图像放在image里,可以作简单的预览效果,但是由于图像质量差,效果不好。如果缩放picbox,如何缩放里面的控件大小?算法是怎样呢?