如何打印picturebox中的全部内容,包括picture,图形方法创建的图形(image)和包含的控件(文本框,标签,图像等等),急!还有如何增加问题的分值

Question

如题!

Answer 1

还有类似的可以包含控件的容器,比如frame,如何使用pinter对象,或者通用对话框打印它们包含的全部内容?

Answer 2

考屏后打印
两个picturebox,一个是要打印其窗口中的图象，另一个做为容器，点击command1就可以打印了
Option Explicit
Option Base 0
Private Type PALETTEENTRY
   peRed As Byte
   peGreen As Byte
   peBlue As Byte
   peFlags As Byte
End Type
Private Type LOGPALETTE
   palVersion As Integer
   palNumEntries As Integer
   palPalEntry(255) As PALETTEENTRY  ' Enough for 256 colors.
End TypePrivate Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(7) As Byte
End TypePrivate Const RASTERCAPS As Long = 38
Private Const RC_PALETTE As Long = &H100
Private Const SIZEPALETTE As Long = 104Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End TypePrivate Declare Function CreateCompatibleDC Lib "GDI32" (ByVal hDC 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 GetDeviceCaps Lib "GDI32" (ByVal hDC As Long, ByVal iCapabilitiy As Long) As Long
Private Declare Function GetSystemPaletteEntries Lib "GDI32" (ByVal hDC As Long, ByVal wStartIndex As Long, ByVal wNumEntries As Long, lpPaletteEntries As PALETTEENTRY) As Long
Private Declare Function CreatePalette Lib "GDI32" (lpLogPalette As LOGPALETTE) 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 hDCDest As Long, ByVal XDest As Long, ByVal YDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hDCSrc 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 GetForegroundWindow Lib "USER32" () As Long
Private Declare Function SelectPalette Lib "GDI32" (ByVal hDC As Long, ByVal hPalette As Long, ByVal bForceBackground As Long) As Long
Private Declare Function RealizePalette Lib "GDI32" (ByVal hDC As Long) As Long
Private Declare Function GetWindowDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetDC Lib "USER32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ReleaseDC Lib "USER32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function GetDesktopWindow Lib "USER32" () As LongPrivate Type PicBmp
   Size As Long
   Type As Long
   hBmp As Long
   hPal As Long
   Reserved As Long
End TypePrivate Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As LongPublic Function CaptureScreen() As Picture
  Dim hWndScreen As Long
  hWndScreen = GetDesktopWindow()  '获得桌面窗口句柄
'呼叫capturewindow函数捕捉整个屏幕，同时把图象赋于picturebox
 Set CaptureScreen = CaptureWindow(hWndScreen, False, 0, 0, Screen.Width \ Screen.TwipsPerPixelX, Screen.Height \ Screen.TwipsPerPixelY)
End Function
'参数的意义
'hWndSrc  欲捕捉窗口的句柄
' Client  如果为TRUE，则函数捕捉窗口的客户区，如果是FALSE，则函数捕捉整个窗口
' LeftSrc, TopSrc, WidthSrc, HeightSrc  欲捕捉窗体的位置，以象素为单位
' 返回值  返回欲捕捉区域的图象
'
 Public Function CaptureWindow(ByVal hWndSrc As Long, ByVal Client As Boolean, ByVal LeftSrc As Long, ByVal TopSrc As Long, ByVal WidthSrc As Long, ByVal HeightSrc As Long) As Picture
 Dim hDCMemory As Long
  Dim hBmp As Long
  Dim hBmpPrev As Long
  Dim r As Long
  Dim hDCSrc As Long
  Dim hPal As Long
  Dim hPalPrev As Long
  Dim RasterCapsScrn As Long
  Dim HasPaletteScrn As Long
  Dim PaletteSizeScrn As Long
  Dim LogPal As LOGPALETTE   ' Depending on the value of Client get the proper device context.
   If Client Then   '如果只捕捉客户区的图象，则只获取给定窗口客户区显示器描述表的句柄
      hDCSrc = GetDC(hWndSrc)
   Else
      hDCSrc = GetWindowDC(hWndSrc)  '如果是要捕捉整个屏幕，则获得整个窗口的显示描述表的内容，包括标题栏，菜单和滚动条
   End If
    hDCMemory = CreateCompatibleDC(hDCSrc)  '创建与指定设备相兼容的内存设备描述表
  
   hBmp = CreateCompatibleBitmap(hDCSrc, WidthSrc, HeightSrc)
   '创建一个与hDCSrc指定的设备兼容的位图，其中WidthSrc为位图的宽度，HeightSrc为位图的高度
   '该位图能被选作任何内存DC（如上面的hDCMemory）的当前位图，次内存DC与由HDC指定的DC相兼容
   hBmpPrev = SelectObject(hDCMemory, hBmp)
'将新创建的位图对象hBmp选进到hDCMemory所指定的内存设备场景，这个新的对象代替了描述表中同类型的哪个旧的对象   RasterCapsScrn = GetDeviceCaps(hDCSrc, RASTERCAPS) '获得显示器的关珊性能
   HasPaletteScrn = RasterCapsScrn And RC_PALETTE     ' 是否有调色板
   PaletteSizeScrn = GetDeviceCaps(hDCSrc, SIZEPALETTE) '调色板的大小   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
    
      LogPal.palVersion = &H300   '创建一份系统调色板的拷贝
      LogPal.palNumEntries = 256
      r = GetSystemPaletteEntries(hDCSrc, 0, 256, LogPal.palPalEntry(0))
      hPal = CreatePalette(LogPal)
      '把刚刚创建的调色板选入到hDCMemory所指定的设备场景中
      hPalPrev = SelectPalette(hDCMemory, hPal, 0)
      r = RealizePalette(hDCMemory)
      '修改显示画面的调色板，以使其与当前选择设备描述表（即hDCMemory）的逻辑调色板相匹配
   End If   ' 把图象考进内存DC中，图象的大小为WidthSrc*HeightSrc，左上角坐标为（LeftSrc，TopSrc）
   r = BitBlt(hDCMemory, 0, 0, WidthSrc, HeightSrc, hDCSrc, LeftSrc, TopSrc, vbSrcCopy)
   '还原hDCMemory中的位图对象
   hBmp = SelectObject(hDCMemory, hBmpPrev)
   '如果对调色板作了改变，则还原它
   If HasPaletteScrn And (PaletteSizeScrn = 256) Then
      hPal = SelectPalette(hDCMemory, hPalPrev, 0)
   End If
   '释放资源到系统
   r = DeleteDC(hDCMemory)
   r = ReleaseDC(hWndSrc, hDCSrc)
   Set CaptureWindow = CreateBitmapPicture(hBmp, hPal)
End Function
'函数功能  从内存位图对象和调色板对象中创建一副位图
' hBmp   位图的句柄
' hPal   调色板句柄  ，如果位图没有用调色板，则为NULL
' 返回值  返回picture对象Public Function CreateBitmapPicture(ByVal hBmp As Long, ByVal hPal As Long) As Picture
  Dim r As Long
  Dim Pic As PicBmp
  Dim IPic As IPicture
   Dim IID_IDispatch As GUID
  With IID_IDispatch
      .Data1 = &H20400
      .Data4(0) = &HC0
      .Data4(7) = &H46
   End With   With Pic
      .Size = Len(Pic)          ' 结构的长度
      .Type = vbPicTypeBitmap   ' picture的类型
      .hBmp = hBmp              ' 位图的句柄
      .hPal = hPal              ' 调色板的句柄
   End With
   ' 创建picture 对象
   r = OleCreatePictureIndirect(Pic, IID_IDispatch, 1, IPic)
   Set CreateBitmapPicture = IPic
End Function
Public Function Capturepic(frmpic As PictureBox) As Picture
  '第二个参数为TRUE
   Set Capturepic = CaptureWindow(frmpic.hWnd, True, 0, 0, frmpic.ScaleX(frmpic.ScaleWidth, frmpic.ScaleMode, vbPixels), frmpic.ScaleY(frmpic.ScaleHeight, frmpic.ScaleMode, vbPixels))
End Function
Private Sub Command1_Click()
    Set Picture1.Picture = Capturepic(Picture2)
    Printer.PaintPicture Picture1.Picture, 0, 0
    Printer.EndDoc
End Sub

Answer 3

对于frame控件，只要把相应的地方该为
Public Function Capturepic(frmpic As Frame) As Picture
  '第二个参数为TRUE
   Set Capturepic = CaptureWindow(frmpic.hWnd, True, 0, 0, frmpic.Width, frmpic.Height)
End Function
Private Sub Command1_Click()
    Set Picture1.Picture = Capturepic(Frame1)
    Printer.PaintPicture Picture1.Picture, 0, 0
    Printer.EndDoc
End Sub
就可以了

Answer 4

对了
对于frame 控件的打印，要把form1的scalemode选为3

Answer 5

谢谢laviewpb，如果 frame或者picture比较大，超出屏幕范围，会不会出现超出部分打不出来的情况？

Answer 6

如果是拷屏打印的话，用这些代码就可以实现，而且部分picture或者是frame（可能两者打印效果不同，我没有做测试）
Private Declare Function BitBlt Lib "gdi32" _
  (ByVal hDCDest As Long, ByVal XDest As Long, _
   ByVal YDest As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long, ByVal hDCSrc As Long, _
   ByVal XSrc As Long, ByVal YSrc As Long, _
   ByVal dwRop As Long) As LongPrivate Declare Function GetWindowDC Lib _
   "user32" (ByVal hWnd As Long) As LongPrivate Declare Function ReleaseDC Lib "user32" _
   (ByVal hWnd As Long, ByVal hdc As Long) As Long
 Private Sub Command1_Click()  PrintRPTEnd Sub
Private Sub PrintRPT()   
  Dim hDCSrc As Long
   
  Dim WidthSrc As Long
  Dim HeightSrc As Long
  
  WidthSrc = Me.Pic_Print.Width \ Screen.TwipsPerPixelX
  HeightSrc = Me.Pic_Print.Height \ Screen.TwipsPerPixelY
   
  hDCSrc = GetWindowDC(Me.Pic_Print.hWnd)
  Printer.Print ""
  Call BitBlt(Printer.hdc, 0, 0, _
              WidthSrc, HeightSrc, hDCSrc, _
              0, 0, vbSrcCopy)  Call ReleaseDC(Me.Pic_Print.hWnd, hDCSrc)
    Printer.EndDoc
End Sub

Answer 7

说明：
不好意思，太着急把“而且部分picture或者是frame（可能两者打印效果不同，我没有做测试）
”这句话打错了，是“不分picturebox 还是frame（可能两者打印效果不同，我没有做测试）”只要将其换为frame的名称即可。那个pic_print就是要打印的picturebox

Answer 8

打印picture是可以只用bjwanghui的方法，我的代码是从一个具有很多考屏功能 的代码中筛选的，所以比较多
如果打印的图片较大，会有部分黑色的边框

Answer 9

自己顶 ，难道没有更好的办法了吗？能不能在printer 中重建控件？

Answer 10

希望对你有帮助:
http://blog.csdn.net/cso/archive/2004/08/19/79084.aspx

Answer 11

谢谢 cso(sjxsoft-天水是我家) ，您介绍的这个方法跟上面laviewpbt和我提的办法类似（原理一样）都解决不了问题，如果textbox没有在屏幕上显示，会怎么样呢？bitblt是拷贝屏幕的，如果你把窗体向下拉一下，把那个textbox 放在屏幕显示不到的地方，看看picturebox里出现什么？

Answer 12

读取picturebox里每一个 控件的属性,在printer里重绘!!!