'module
Option Explicit
Private 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''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 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
Option Explicit
Private 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''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
' 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
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
object 对象表达式,其值是“应用于”列表中的一个对象。
hdc 设备描述体,是准备用来打印控件内容的设备。
说明如果在 RichTextBox 控件中有选定的文本,则 SelPrint 方法仅将选定的文本发送给目标设备。如果没有选定的文本,则 RichTextBox 的全部内容都将发送给目标设备。SelPrint 方法并不打印 RichTextBox 控件中的文本。而是将格式化文本的一个备份发送给可以打印这个文本的设备。例如,用下列代码可将文本发送给 Printer 对象:RichTextBox1.SelPrint(Printer.hDC)应当知道 Printer 对象的 hDC 属性是用来为 SelPrint 方法指定 设备描述体参数的。注意 如果使用 Printer 对象作为来自 RichTextBox 控件文本的接收端, 必须首先通过打印零长度字符串之类的一些东西,对 Printer 对象的设备描述体进行初始化。
该示例是打印 RichTextBox 控件的格式化文本。要试用此例,应将一个 RichTextBox 控件,一个 CommonDialog 控件,和一个 CommandButton 控件放在窗体上。再将以下代码粘贴到 CommandButton 控件的 Click 事件中。然后运行此例。Private Sub Command1_Click()
CommonDialog1.Flags = cdlPDReturnDC + cdlPDNoPageNums
If RichTextBox1.SelLength = 0 Then
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDAllPages
Else
CommonDialog1.Flags = CommonDialog1.Flags + cdlPDSelection
End If
CommonDialog1.ShowPrinter
RichTextBox1.SelPrint CommonDialog1.hDC
End Sub
The SelPrint method of the RichTextBox control does not allow a programmer to set the position of the output on the printer. In addition, the RichTextBox control does not provide a method for displaying its contents as they would show up on the printer. This article explains how to set up a RichTextBox with a WYSIWYG (What You See Is What You Get) display and then how to print it. MORE INFORMATION
The Visual Basic RichTextBox control is a sub-classed control based on the RichTextBox provided by the Win32 operating system. The operating system control supports many messages that are not exposed in Visual Basic. One of these messages is EM_SETTARGETDEVICE. The EM_SETTARGETDEVICE message is used to tell a RichTextBox to base its display on a target device such as a printer. Another message that is not fully exposed by Visual Basic is EM_FORMATRANGE. The EM_FORMATRANGE message sends a page at a time to an output device using the specified coordinates. Using these messages in Visual Basic, it is possible to make a RichTextBox support WYSIWYG display and output.