Re: add text to bottom of richtextbox, simple method? Solved

"Mike Scirocco" <mscir@xxxxxxxxx> wrote in message news:f9adndnGt-Sb4DnZnZ2dnUVZ_qmdnZ2d@xxxxxxxxxxxxxxxxx

I apologize for not being clearer. I want to add text to the bottom
of a richtextbox so it prints on the bottom of an 8.5" x 11" page, as
a "footer".

Right. Well that of course is a different matter. You haven't said exactly how you are printing the RTB and how many pages of text it contains (one page or more?) and without that information it is difficult to provide the most appropriate solution . . . but I'll give it a go. I never actually print RTBs myself, preferring to position the various text block and graphics and things myself using either the standard VB printer object methods or the alternative API methods. However, the kind of things I usually print are posters and packaging box templates and stuff like that and obviously different printing methods suit different printing requirements. I've just had a quick look at the RTB methods and all I can see is the SelPrint method, which doesn't give you any control at all regarding the position of the output and which closes the print job automatically when it is done. Is that the method you are using? If so. and if you are printing just one page, then you could probably knock up a simple solution. You'd have to bear in mind that the SelPrint method closes the print job, so anything else you want to print on the same page has to be printed first. Something like:

Printer.ScaleMode = vbInches
Dim s1 As String
s1 = "This is a footer"
Printer.CurrentX = (Printer.ScaleWidth - Printer.TextWidth(s1)) / 2
Printer.CurrentY = Printer.ScaleHeight - Printer.TextHeight(s1)
Printer.Print s1
RichTextBox1.SelPrint Printer.hdc

However, that's not a very nice way of doing it, and it severely limits your choices regarding positioning your output. I once downloaded some nice WYSIWYG RTB printing code from the MSDN web site, but I've never actually used it because, as I've said, I never have the need for printing RTBs. I've just tried it out now though and it it quite nice. In fact very nice. It allows you to print the contents of a RichTextBox with selectable left, right, top and bottom page margins, and it works fine whether the RTB text runs to just one page or to several pages. It does not include any functionality for printing page footers though, so as it stands it won't suit your purposes. It is fairly easy to modify though, and I've just done so and tried it out again. With the modifications I have made it can print footers on every page (or just on some pages if you wish). Rather than post a link to the MSDN site and then describe the required code modifications I think it will be simpler to just post the full modified code here. I'm sure the bods at Microsoft will not mind me doing that, because my modifications do add some useful functionality to their code. As I've said, this is just a very quick initial modification and if I were doing it properly I would probably do it in a much neater way. At the moment its a bit "messy" and it would be better to change it so that prints the footers to the Printer hDC. Also, at the moment it prints the footers at the very bottom of the "printable area" of the page, but you can of course print them higher up if you want, simply by adjusting the CurrentY property to something other thaqn the value I have used. It works fine though. Give it a try. There are two blocks of code. One for the module and one for the Form. You'll need a RichTextBox and a Command Button on the Form. When you run the project type (or paste) some text into the RTB, preferably enough to extend over more than one page so that you can see it working properly. Let me know how it works on your own system

Mike

' ***** START OF FORM CODE *****
Option Explicit

Private Sub Form_Load()
Dim LineWidth As Long
' Initialize Form and Command button
Me.Caption = "Rich Text Box WYSIWYG Printing Example"
Command1.Move 10, 10, 600, 380
Command1.Caption = "&Print"
' Set font of the RTF to a TrueType font for best results
RichTextBox1.SelFontName = "Arial"
RichTextBox1.SelFontSize = 10
' Tell the RTF to base it's display off of the printer
LineWidth = WYSIWYG_RTF(RichTextBox1, 1440, 1440)
'1440 Twips=1 Inch
' Set the form width to match the line width
Me.Width = LineWidth + 200
End Sub

Private Sub Form_Resize()
' Position the RTF on form
RichTextBox1.Move 100, 500, Me.ScaleWidth - 200, _
Me.ScaleHeight - 600
End Sub

Private Sub Command1_Click()
' Print contents of the RichTextBox with a one inch margin
PrintRTF RichTextBox1, 1440, 1440, 1440, 1440
End Sub
' ***** END OF FORM CODE *****

' ***** START OF MODULE CODE *****
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

' 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 Function WYSIWYG_RTF(RTF As RichTextBox, _
LeftMarginWidth As Long, RightMarginWidth As Long) As Long
Dim LeftOffset As Long, LeftMargin As Long, RightMargin As Long
Dim LineWidth 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 offset to the printable area on the page in twips
LeftOffset = Printer.ScaleX(GetDeviceCaps(Printer.hdc, _
PHYSICALOFFSETX), vbPixels, vbTwips)
' Calculate the Left, and Right margins
LeftMargin = LeftMarginWidth - LeftOffset
RightMargin = (Printer.Width - RightMarginWidth) - LeftOffset
' Calculate the line width
LineWidth = RightMargin - LeftMargin
' 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 LineWidth)
' Abort the temporary print job used to get printer info
Printer.KillDoc
WYSIWYG_RTF = LineWidth
End Function

'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
' MIKE WILLIAMS' MODIFICATION FOR FOOTERS(1)
Dim s1 As String, pageNum As Long
' END OF MIKE WILLIAMS MODIFICATION FOR FOOTERS(1)
' 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
' MIKE WILLIAMS' MODIFICATION FOR FOOTERS(2)
Printer.ScaleMode = vbInches
Printer.Font.Name = "Times New Roman"
Printer.Font.Size = 12
pageNum = pageNum + 1
s1 = "This is the footer of page number " & Format(pageNum)
Printer.CurrentX = (Printer.ScaleWidth - Printer.TextWidth(s1)) / 2
Printer.CurrentY = Printer.ScaleHeight - Printer.TextHeight(s1)
Printer.Print s1
' END OF MIKE WILLIAMS' MODIFICATION(2)
' 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
' ***** END OF MODULE CODE *****




.

Loading