Need to print out RTF text into a PictureBox in VB.NET

  • Thread starter Thread starter Neal
  • Start date Start date
N

Neal

Hi,

I saw the VB6 Code to do this at this link:

http://www.dotnet247.com/247reference/msgs/11/56581.aspx

The VB6 Code reads as follows:

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 Declare Function SendMessage Lib "USER32"
Alias "SendMessageA"
_
(ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long,
_
lp As Any) As Long

Public Sub PrintRTF(RTF As RichTextBox, PB As PictureBox)

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 PB.hDC
PB.Cls
PB.ScaleMode = vbTwips

' Calculate the Left, Top, Right, and Bottom margins

' Set printable area rect
rcPage.Left = 0
rcPage.Top = 0
rcPage.Right = PB.ScaleWidth
rcPage.Bottom = PB.ScaleHeight

' Set rect in which to print (relative to printable area)
rcDrawTo.Left = 0
rcDrawTo.Top = 0
rcDrawTo.Right = PB.Width
rcDrawTo.Bottom = PB.Height

' Set up the print instructions
fr.hdc = PB.hdc ' Use the same DC for measuring and
rendering
fr.hdcTarget = PB.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

fr.hdc = PB.hdc
fr.hdcTarget = PB.hdc
Loop

' Allow the RTF to free up memory
r = SendMessage(RTF.hWnd, EM_FORMATRANGE, False, ByVal
CLng(0))

End Sub


What changes do I need to make to this code to port it to
VB.NET?

Thanks,

Neal
 
To be more specific. Use the CreateGraphics method of the form to allow you
to draw on it.

Dim g as Graphics = FormName.CreateGraphics()

Regards - OHM
 
Hi,

Here you go.
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _

ByVal lParam As Integer) As Integer

Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

(ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _

ByRef lParam As FormatRange) As Integer



Public Structure Rect

Dim Left As Integer

Dim Top As Integer

Dim Right As Integer

Dim Bottom As Integer

End Structure

Public Structure CharRange

Dim cpMin As Integer ' First character of range (0 for start of doc)

Dim cpMax As Integer ' Last character of range (-1 for end of doc)

End Structure

Public Structure FormatRange

Dim hdc As Integer ' Actual DC to draw on

Dim hdcTarget As Integer ' Target DC for determining text formatting

Dim rc As Rect ' Region of the DC to draw to (in twips)

Dim rcPage As Rect ' Region of the entire DC (page size) (in twips)

Dim chrg As CharRange ' Range of text to draw (see above declaration)

End Structure

Private Const WM_USER As Integer = &H400S

Private Const EM_FORMATRANGE As Integer = WM_USER + 57



Public Sub PrintRTF(ByRef RTF As RichTextBox, ByRef PB As
System.Windows.Forms.PictureBox)

Dim fr As FormatRange

Dim rcDrawTo As Rect

Dim rcPage As Rect

Dim TextLength As Integer

Dim NextCharPosition As Integer

Dim r As Integer

Dim g As Graphics = PB.CreateGraphics

g.Clear(Color.White)

Dim hdc As IntPtr = g.GetHdc

' Start a print job to get a valid PB.hDC

rcPage.Left = 0

rcPage.Top = 0

rcPage.Right = PB.ClientRectangle.Width

rcPage.Bottom = PB.ClientRectangle.Height

' Set rect in which to print (relative to printable area)

rcDrawTo.Left = 0

rcDrawTo.Top = 0

rcDrawTo.Right = VB6.PixelsToTwipsX(PB.Width)

rcDrawTo.Bottom = VB6.PixelsToTwipsY(PB.Height)

' Set up the print instructions

fr.hdc = hdc.ToInt32 ' Use the same DC for measuring and rendering

fr.hdcTarget = hdc.ToInt32 ' 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 = RTF.Text.Length

' Loop printing each page until done

Do

' Print the page by sending EM_FORMATRANGE message

NextCharPosition = SendMessage(RTF.Handle, EM_FORMATRANGE, True, fr)

If NextCharPosition >= TextLength Then Exit Do

fr.chrg.cpMin = NextCharPosition ' Starting position for next page()

fr.hdc = hdc.ToInt32

fr.hdcTarget = hdc.ToInt32

Loop

' Allow the RTF to free up memory

r = SendMessage(RTF.Handle, EM_FORMATRANGE, False, 0)

g.ReleaseHdc(hdc)

End Sub

Ken

-----------------------------
 
Dim g As Graphics

g = PictureBox1.CreateGraphics

Dim drawString As [String] = "Sample Text"
' Create font and brush.
Dim drawFont As New Font("Arial", 16)
Dim drawBrush As New SolidBrush(Color.Black)
' Create point for upper-left corner of drawing.
Dim x As Single = 50.0F
Dim y As Single = 50.0F
' Set format of string.
Dim drawFormat As New StringFormat
drawFormat.FormatFlags = StringFormatFlags.DirectionRightToLeft
' Draw string to screen.
 
Hi Herfried,

I saw a very nice sample two lines above, I asume OHM did test it, so it is
in my HKW box with the addition "made by OHM"

Cor
 
+

g.DrawString(drawString, drawFont, drawBrush, x, y, drawFormat)



Regards - OHM

Dim g As Graphics

g = PictureBox1.CreateGraphics

Dim drawString As [String] = "Sample Text"
' Create font and brush.
Dim drawFont As New Font("Arial", 16)
Dim drawBrush As New SolidBrush(Color.Black)
' Create point for upper-left corner of drawing.
Dim x As Single = 50.0F
Dim y As Single = 50.0F
' Set format of string.
Dim drawFormat As New StringFormat
drawFormat.FormatFlags =
StringFormatFlags.DirectionRightToLeft ' Draw string to
screen.
Click to expand...
 
* "Cor said:
I saw a very nice sample two lines above, I asume OHM did test it, so it is
in my HKW box with the addition "made by OHM"
Click to expand...

Yep. The sample will work, nevertheless the RichTextBox provides some
really nice features for formatting/... text and other content.

;-)
 
Hi Herfried,

Can you be a little bit precise because till now I never used the RTB?

The sample you did send looks for me more to C++ than to VB.net

To more precise, do you have one or two real managed code rows that replaces
the sample of OHM?

Cor
 
* "Cor said:
Can you be a little bit precise because till now I never used the RTB?

The sample you did send looks for me more to C++ than to VB.net

To more precise, do you have one or two real managed code rows that replaces
the sample of OHM?
Click to expand...

No. You cannot print the contents of a richtextbox to a picturebox with
managed code.
 
Hi, thanks for the revision.

However, the VB6.TwipsToPixelsX is coming up undefined.

What do I have to Import to enable this?

Thanks,

Neal
 
I did try to reference
Microsoft.VisualBasic.Compatibility.VB6.TwipsToPixelsX,
but it still comes up as undefined. What else do I need
to do?

Neal
 
Another, probably better way of dealing with this issue
to get a version of the TwipsToPixels logic as a function
that I can use in VB.NET.

If a version of that is available anywhere, that would be
great too.

Thanks,

Neal
 
Hi Neal,

To use the VB6.TwipsToPixelsX, you may need to add a reference to Microsoft
Visual Basic .NET Compatibility Runtime.
and
Imports Microsoft.VisualBasic.Compatibility in your project.

Here is an article, you may take a look.
ScaleMode is not supported
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/vbcon/html/
vbup2038.asp

If you have any concern on this issue, please post here.

Regards,
Peter Huang
Microsoft Online Partner Support
Get Secure! www.microsoft.com/security
This posting is provided "as is" with no warranties and confers no rights.
 
Thank you, the reason that this was not apparent was that
the width of the column in the References window was too
narrow to see it properly.

Neal
 
Hi,

Sorry. I didnt get right back to you yesterday. Here is a improved
method. Draws on bitmap and set pictureboxes image to the bitmap so it will
automatically redraw. Alternate method to convert to twips is to multiply by
1440/ g.dpix.


Public Sub PrintRTF(ByRef RTF As RichTextBox, ByRef PB As
System.Windows.Forms.PictureBox)

Dim fr As FormatRange

Dim rcDrawTo As Rect

Dim rcPage As Rect

Dim TextLength As Integer

Dim NextCharPosition As Integer

Dim r As Integer

Dim bm As New Bitmap(PB.Width, PB.Height)

Dim g As Graphics = Graphics.FromImage(bm)

g.Clear(Color.White)

Dim intScaleX As Single = 1440 / g.DpiX

Dim intScaleY As Single = 1440 / g.DpiY

Dim hdc As IntPtr = g.GetHdc

' Start a print job to get a valid PB.hDC

rcPage.Left = 0

rcPage.Top = 0

rcPage.Right = (PB.ClientRectangle.Width)

rcPage.Bottom = (PB.ClientRectangle.Height)

' Set rect in which to print (relative to printable area)

rcDrawTo.Left = 0

rcDrawTo.Top = 0

rcDrawTo.Right = PB.Width * intScaleX

rcDrawTo.Bottom = PB.Height * intScaleY

' Set up the print instructions

fr.hdc = hdc.ToInt32 ' Use the same DC for measuring and rendering

fr.hdcTarget = hdc.ToInt32 ' 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 = RTF.Text.Length

' Loop printing each page until done

Do

' Print the page by sending EM_FORMATRANGE message

NextCharPosition = SendMessage(RTF.Handle, EM_FORMATRANGE, True, fr)

fr.chrg.cpMin = NextCharPosition ' Starting position for next page()

fr.hdc = hdc.ToInt32

fr.hdcTarget = hdc.ToInt32

Loop Until NextCharPosition >= TextLength

' Allow the RTF to free up memory

r = SendMessage(RTF.Handle, EM_FORMATRANGE, False, 0)

g.ReleaseHdc(hdc)

PB.Image = bm

End Sub

Public Sub PrintRTF(ByRef RTF As RichTextBox, ByRef PB As
System.Windows.Forms.PictureBox)

Dim fr As FormatRange

Dim rcDrawTo As Rect

Dim rcPage As Rect

Dim TextLength As Integer

Dim NextCharPosition As Integer

Dim r As Integer

Dim bm As New Bitmap(PB.Width, PB.Height)

Dim g As Graphics = Graphics.FromImage(bm)

g.Clear(Color.White)

Dim intScaleX As Single = 1440 / g.DpiX

Dim intScaleY As Single = 1440 / g.DpiY

Dim hdc As IntPtr = g.GetHdc

' Start a print job to get a valid PB.hDC

rcPage.Left = 0

rcPage.Top = 0

rcPage.Right = (PB.ClientRectangle.Width)

rcPage.Bottom = (PB.ClientRectangle.Height)

' Set rect in which to print (relative to printable area)

rcDrawTo.Left = 0

rcDrawTo.Top = 0

rcDrawTo.Right = PB.Width * intScaleX

rcDrawTo.Bottom = PB.Height * intScaleY

' Set up the print instructions

fr.hdc = hdc.ToInt32 ' Use the same DC for measuring and rendering

fr.hdcTarget = hdc.ToInt32 ' 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 = RTF.Text.Length

' Loop printing each page until done

Do

' Print the page by sending EM_FORMATRANGE message

NextCharPosition = SendMessage(RTF.Handle, EM_FORMATRANGE, True, fr)

fr.chrg.cpMin = NextCharPosition ' Starting position for next page()

fr.hdc = hdc.ToInt32

fr.hdcTarget = hdc.ToInt32

Loop Until NextCharPosition >= TextLength

' Allow the RTF to free up memory

r = SendMessage(RTF.Handle, EM_FORMATRANGE, False, 0)

g.ReleaseHdc(hdc)

PB.Image = bm

End Sub



Ken
-----------------
 
Back
Top