如何捕捉打印对象 Printer 中的图片？

你的图片是怎么来得直接传给PictureBox不就可以了?

使用袁飞打印预览控件

  兼容   Printer   对象,完全免费.

  下载地址:   http://d.download.csdn.net/down/1077508/rwj
不知道对你是否有用

API可以在Printer中重建Richtextbox控件，重设页边距、分页等，最后打印出来。这些在PictureBox中做不了的。要预览就只有直接捕捉Printer中的图片了。代码如下，请高手看看，这样的打印怎样才能预览？  '模块：
   Option Explicit
    Private Type Rect
          Left As Long
          Top As Long
          Right As Long
          Bottom As Long
    End Type
    Private Type CharRange
     cpMin As Long     ' First character of range (0 for start of doc)
     cpMax As Long     ' Last character of range (-1 for end of doc)
   End Type
   Private Type FormatRange
     hdc As Long       ' Actual DC to draw on
     hdcTarget As Long ' Target DC for determining text formatting
     rc As Rect        ' Region of the DC to draw to (in twips)
     rcPage As Rect    ' Region of the entire DC (page size) (in twips)
     chrg As CharRange ' Range of text to draw (see above declaration)
   End Type

   Private Const WM_USER As Long = &H400
   Private Const EM_FORMATRANGE As Long = WM_USER + 57
   Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
   Private Const PHYSICALOFFSETX As Long = 112
   Private Const PHYSICALOFFSETY As Long = 113
   Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
   Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) 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       Public Sub PrintRTF(RTF As RichTextBox, LeftMarginWidth As Long, _
       TopMarginHeight, RightMarginWidth, BottomMarginHeight)
       Dim LeftOffset As Long, TopOffset As Long
       Dim LeftMargin As Long, TopMargin As Long
       Dim RightMargin As Long, BottomMargin As Long
       Dim fr As FormatRange
       Dim rcDrawTo As Rect
       Dim rcPage As Rect
       Dim TextLength As Long
       Dim NextCharPosition As Long
       Dim r As Long
       ' Start a print job to get a valid Printer.hDC
       Printer.Print Space(1)
       Printer.ScaleMode = vbTwips
       ' Get the offsett to the printable area on the page in twips
       LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX), vbPixels, vbTwips)
       TopOffset = Printer.ScaleY(GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY), vbPixels, vbTwips)
       ' Calculate the Left, Top, Right, and Bottom margins
       LeftMargin = LeftMarginWidth - LeftOffset
       TopMargin = TopMarginHeight - TopOffset
       RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
       BottomMargin = (Printer.Height - BottomMarginHeight) - TopOffset
       ' Set printable area rect
       rcPage.Left = 0
       rcPage.Top = 0
       rcPage.Right = Printer.ScaleWidth
       rcPage.Bottom = Printer.ScaleHeight
       ' Set rect in which to print (relative to printable area)
       rcDrawTo.Left = LeftMargin
       rcDrawTo.Top = TopMargin
       rcDrawTo.Right = RightMargin
       rcDrawTo.Bottom = BottomMargin
       ' Set up the print instructions
       fr.hdc = Printer.hdc   ' Use the same DC for measuring and rendering
       fr.hdcTarget = Printer.hdc  ' Point at printer hDC
       fr.rc = rcDrawTo            ' Indicate the area on page to draw to
       fr.rcPage = rcPage          ' Indicate entire size of page
       fr.chrg.cpMin = 0           ' Indicate start of text through
       fr.chrg.cpMax = -1          ' end of the text
       ' Get length of text in RTF
       TextLength = Len(RTF.Text)
       ' Loop printing each page until done
       Do
          ' Print the page by sending EM_FORMATRANGE message
          NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr)
          If NextCharPosition >= TextLength Then Exit Do  'If done then exit
          fr.chrg.cpMin = NextCharPosition ' Starting position for next page
          Printer.NewPage                  ' Move on to next page
          Printer.Print Space(1) ' Re-initialize hDC
          fr.hdc = Printer.hdc
          fr.hdcTarget = Printer.hdc
       Loop
       ' Commit the print job
       Printer.EndDoc
       ' Allow the RTF to free up memory
       r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal CLng(0))
    End Sub  '窗体中：
   Private Sub Command1_Click()
     ' Print the contents of the RichTextBox with a one inch margin
     PrintRTF RichTextBox1, 1440, 1440, 1440, 1440 ' 1440 Twips = 1 Inch
   End Sub

你何必要用API呢?
用对象直接画PicutreBox,可以预览,预览好后,用对象再传给printer不就行了.给你个简单的例子(picture的放大缩小,自动重画的打开自动做吧):Option Explicit

  Const UNIT_CM = 567 '-------------------------设置每厘米等于567个缇
  Const TABLE_TOP = 800 '-----------------------表上边距
  Const hs = 34 '-------------------------------表的总行数Private Sub Command1_Click()
     drawTable Picture1, "高压电网远程监控参数" '送图片框

End SubPrivate Sub Command2_Click()
    drawTable Printer, "高压电网远程监控参数" '送打印机
    Printer.EndDoc '立即打印

End SubPrivate Sub drawTable(ByVal obj As Object, ByVal table_Header As String)
'*----------------------------------------------------------*
'| 入口参数:                                                |
'|          obj 发送的对象                                  |
'|          table_Header 发送的表头                         |
'| 出口参数:                                                |
'|          无                                              |
'*----------------------------------------------------------*
    If obj Is Picture1 Then
        Picture1.Cls
    End If
'*=====================   画报表   ========================*    Dim iRows As Single '------------------------表行总高度
    Dim iRow(0 To hs + 1) As Single '------------表的每行高
    Dim iCols As Single  '-----------------------表列总宽度
    Dim iCol(0 To 14) As Single  '---------------表的每列宽
    Dim table_Col(0 To 11) As String  '----------表头列变量
    Dim iCol_centre As Single '------------------表头居中处理

    Dim j As Byte

    table_Col(0) = "电网电压(V)":           table_Col(1) = "电网功率因数"
    table_Col(2) = "单级电容容量(KVar)":    table_Col(3) = "电容投切状态"
    table_Col(4) = "投切延时时间(s)":       table_Col(5) = "日  期  时  间"
    table_Col(6) = "　站　点　名　称　":    table_Col(7) = "站点代码"

'-----初始化列宽变量
    For j = 0 To 7
        iCol(j) = UNIT_CM * 2.8
        DoEvents
    Next j
    iCol(2) = UNIT_CM * 3.7: iCol(4) = UNIT_CM * 3.2  '特殊列处理
    iCol(5) = UNIT_CM * 3.7: iCol(6) = UNIT_CM * 6    '特殊列处理
    iCol(7) = UNIT_CM * 1.5

'-----统计总列宽
    For j = 0 To 7
      iCols = iCols + iCol(j)
      DoEvents
    Next j

'-----初始化行高变量
    For j = 0 To hs
       iRow(j) = UNIT_CM * 0.5
       DoEvents
    Next j

'-----统计总行高
    iRows = TABLE_TOP
    For j = 0 To hs
      iRows = iRows + iRow(j)
      DoEvents
    Next j'-----决定表的大小---------------
If obj Is Picture1 Then
    obj.ScaleMode = 1
    obj.Width = 14991
    obj.ScaleWidth = 16361
    obj.Height = 9260
    obj.ScaleHeight = 11366
ElseIf obj Is Printer Then
    obj.PaperSize = vbPRPSA4
    obj.Orientation = 2 '横向打印End If'---========画表的列开始========----
    Dim table_Centre As Single
    table_Centre = (obj.ScaleWidth - iCols) / 2
    iCols = table_Centre
    For j = 0 To 13
        obj.Line (iCols, TABLE_TOP)-(iCols, iRows), QBColor(0)
        iCols = iCols + iCol(j)
        DoEvents
    Next j'---========画表的行开始========---
    iRows = TABLE_TOP
    For j = 0 To hs + 1
        obj.Line (table_Centre, iRows)-(iCols, iRows), QBColor(0)
        iRows = iRows + iRow(j)
        DoEvents
    Next j

'---========打印表头标题=======-----
    obj.FontName = "宋体"
    obj.FontSize = 12
    obj.FontBold = 1
    obj.CurrentX = (obj.ScaleWidth - obj.TextWidth(table_Header)) / 2
    obj.CurrentY = (TABLE_TOP - obj.TextHeight(table_Header)) / 2
    obj.Print table_Header
    obj.FontSize = 9
    obj.FontBold = 0

'--------- 打印表头列 ------------
    iCols = table_Centre
    Dim Char_Y As Long
    Char_Y = TABLE_TOP + (iRow(0) - obj.TextHeight(table_Col(0))) / 2 + 15

    For j = 0 To 11
        iCol_centre = (iCol(j) - obj.TextWidth(table_Col(j))) / 2 + 15
        obj.CurrentX = iCols + iCol_centre
        obj.CurrentY = Char_Y
        obj.Print table_Col(j) '/*---------------------------prn*/
        iCols = iCols + iCol(j)
        DoEvents
    Next j

'--------- 决定表在屏幕上的位置 -----------
    If obj Is Picture1 Then
        If obj.Width < Form1.Width Then
            obj.Left = (Form1.Width - obj.Width) / 2
        Else
            obj.Left = 0
        End If

        If obj.Height < Form1.Height Then
            obj.Top = (Form1.Height - obj.Height) / 2
        Else
            obj.Top = 0
        End If
    End If

End Sub

调试易

如何捕捉打印对象 Printer 中的图片？

解决方案 »