[散分+提问] RTF所见即所得显示和分页打印源码＋捉虫！！！

Question

下面的例子是MSDN上关于RTF所见即所得显示和分页打印的源码，最近正好在研究分页打印RTF文档，不过这个官方资料还是有很多缺陷，大家一起来解决吧！～～相信对大家都很有帮助！！～～--------------------------------------------------------------------------------------
EXAMPLE
Start a new project in the Visual Basic 32-bit edition. Form1 is created by default. 
Put a CommandButton and a RichTextBox control on Form1. 
Add the following code to Form1: 
Private Const AnInch As Long = 1440   '1440 twips per inch
Private Const QuarterInch As Long = 360Private Sub Form_Load()
   Dim PrintableWidth As Long
   Dim PrintableHeight As Long
   Dim x As Single   ' Initialize Form and Command button
   Me.Caption = "Rich Text Box WYSIWYG Printing Example"
   Command1.Move 10, 10, 600, 380
   Command1.Caption = "&Print"   ' Set the font of the RTF to a TrueType font for best results
   RichTextBox1.SelFontName = "Arial"
   RichTextBox1.SelFontSize = 10
   
   'initialize the printer object
   x = Printer.TwipsPerPixelX
   Printer.Orientation = vbPRORPortrait  'vbPRORLandscape   ' Tell the RTF to base it's display off of the printer
   Call WYSIWYG_RTF(RichTextBox1, QuarterInch, QuarterInch, QuarterInch, QuarterInch, PrintableWidth, PrintableHeight) '1440 Twips=1 Inch   ' Set the form width to match the line width
   Me.Width = PrintableWidth + 200
   Me.Height = PrintableHeight + 800
End SubPrivate Sub Form_Resize()
   ' Position the RTF on form
   RichTextBox1.Move 100, 500, Me.ScaleWidth - 200, Me.ScaleHeight - 600
End SubPrivate Sub Command1_Click()
   ' Print the contents of the RichTextBox with a one inch margin
   PrintRTF RichTextBox1, AnInch, AnInch, AnInch, AnInch
End Sub
 
Insert a new standard module into the project, Module1.bas is created by default. 
Add the following code to Module1: 
Option ExplicitPrivate Type Rect
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End TypePrivate 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 TypePrivate 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 TypePrivate 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 = 113Private 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

Answer 1

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' WYSIWYG_RTF - Sets an RTF control to display itself the same as it
'               would print on the default printer
'
' RTF - A RichTextBox control to set for WYSIWYG display.
'
' LeftMarginWidth - Width of desired left margin in twips
'
' RightMarginWidth - Width of desired right margin in twips
'
' Returns - The length of a line on the printer in twips
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub WYSIWYG_RTF(RTF As RichTextBox, LeftMarginWidth As Long, RightMarginWidth As Long, TopMarginWidth As Long, BottomMarginWidth As Long, PrintableWidth As Long, PrintableHeight As Long)
   Dim LeftOffset As Long
   Dim LeftMargin As Long
   Dim RightMargin As Long
   Dim TopOffset As Long
   Dim TopMargin As Long
   Dim BottomMargin As Long
   Dim PrinterhDC As Long
   Dim r As Long   ' Start a print job to initialize printer object
   Printer.Print Space(1)
   Printer.ScaleMode = vbTwips
   
   ' Get the left offset to the printable area on the page in twips
   LeftOffset = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETX)
   LeftOffset = Printer.ScaleX(LeftOffset, vbPixels, vbTwips)
   
   ' Calculate the Left, and Right margins
   LeftMargin = LeftMarginWidth - LeftOffset
   RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
   
   ' Calculate the line width
   PrintableWidth = RightMargin - LeftMargin
   
   ' Get the top offset to the printable area on the page in twips
   TopOffset = GetDeviceCaps(Printer.hdc, PHYSICALOFFSETY)
   TopOffset = Printer.ScaleX(TopOffset, vbPixels, vbTwips)
   
   ' Calculate the Left, and Right margins
   TopMargin = TopMarginWidth - TopOffset
   BottomMargin = (Printer.Height - BottomMarginWidth) - TopOffset
   
   ' Calculate the line width
   PrintableHeight = BottomMargin - TopMargin
    
   
   ' Create an hDC on the Printer pointed to by the Printer object
   ' This DC needs to remain for the RTF to keep up the WYSIWYG display
   PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)   ' Tell the RTF to base it's display off of the printer
   '    at the desired line width
   r = SendMessage(RTF.hWnd, EM_SETTARGETDEVICE, PrinterhDC, _
      ByVal PrintableWidth)   ' Abort the temporary print job used to get printer info
   Printer.KillDoc
End Sub''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' PrintRTF - Prints the contents of a RichTextBox control using the
'            provided margins
'
' RTF - A RichTextBox control to print
'
' LeftMarginWidth - Width of desired left margin in twips
'
' TopMarginHeight - Height of desired top margin in twips
'
' RightMarginWidth - Width of desired right margin in twips
'
' BottomMarginHeight - Height of desired bottom margin in twips
'
' Notes - If you are also using WYSIWYG_RTF() on the provided RTF
'         parameter you should specify the same LeftMarginWidth and
'         RightMarginWidth that you used to call WYSIWYG_RTF()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
 
Save the project. 
Run the project. 
Enter or paste some text into the RichTextBox. 
Press the Print command button. Note that the printed output should word-wrap at the same locations as displayed on the screen. Also, the output should be printed with the specified one-inch margin all around. 

Answer 2

BUG1：对于内容较长的RTF文件，越到后面打印的高度就越短，页面数量也不对！～～      这个问题已经被我解决BUG2：所见即所得居然和打印机是相关的，不同的打印机其显示结果居然不同，打印的结果也不同      这个问题需要大家一起来解决？BUG3：NextCharPosition = SendMessage(RTF.hWnd, EM_FORMATRANGE, True, fr)这条语句，其返回的值应该指的是本页最后一个文本的位置，但是与实际分页的结果不符！      这个问题需要大家一起来解决？

Answer 3

看看。＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
免费的学习交流网站，欢迎大家访问！
http://www.j2soft.cn/

Answer 4

BUG1的解决方法公布：
-----------------------------------------------------------------------------------
    Dim lngTmp As Long             
    Do
        lngNextPos = SendMessage(RTF.hWnd, EM_FORMATRANGE, 0, fr)   '只计算，不打印
        If lngNextPos <= lngTmp Then Exit Do 
        lngNextPos = SendMessage(RTF.hWnd, EM_FORMATRANGE, 1, fr)   '实际打印
        lngTmp = lngNextPos       
        fr.chrg.cpMin = lngNextPos                      
        picBuff.Print Space(1)                          
        fr.hdc = Printer.hdc
        fr.hdcTarget =  Printer.hdc
        fr.rc = rcDrawTo                                             '恢复可打印区域
    Loop

Answer 5

//BUG2：所见即所得居然和打印机是相关的，不同的打印机其显示结果居然不同，打印的结果也不同PrinterhDC = CreateDC(Printer.DriverName, Printer.DeviceName, 0, 0)
 r = SendMessage(RTF.hWnd, EM_SETTARGETDEVICE, PrinterhDC, _
ByVal PrintableWidth)这两句你指定了打印机的关联

Answer 6

//BUG2：所见即所得居然和打印机是相关的，不同的打印机其显示结果居然不同，打印的结果也不同看来楼主误会了“所见即所得”的词义
“所见即所得”的词义是：在屏幕上的效果（所见）与 打印机输出效果（所得）一致
所以必然是设备相关的
要想实现“设备无关”
得自己定义一整套排版规则
如Adobe的PDF标准
这也是“Word一直被称为文字处理工具，而不是排版工具”的原因只不过最新版Word加强了排版能力
这就是侯捷为什么花那么大功夫写了本《Word排版艺术》的原因

Answer 7

to zyl910(910：分儿，我又来了！) :    请问为什么Word可以做到不同打印机其打印效果都一致的呢？是不是它自己带了一个通用打印驱动程序呢？

Answer 8

Mark.这个问题确实有待解决,好多地方都会用到.