borderAndreaVB free resources for Visual Basic developersborder

borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2007 Andrea Tincaniborder

AndreaVB | Forum | News | Downloads | Register | Help | Member List | Statistics | Search | PM | Profile

Print This Topic
Previous Topic (select default printer in VB?)Next Topic (Numbering data items) New Topic New Poll Post Reply
AndreaVB Forum : Printing : Printing
Poster Message
kibzama
Level: Big Cheese


Registered: 05-09-2005
Posts: 28

icon Printing

Please help, I have used a RichTextBox in my application, its working really well. I am now able to embade excel ranges and images. What I cant do now is printing the same. When i print, i get only the text without the formats. Please help
My code is something like this

dim prt as Printer
prt.Print rtfText.Text
prt.EndDoc

05-09-2005 at 10:40 AM
View Profile Send Email to User Show All Posts | Quote Reply
TJ_01
Level: VB Lord


Registered: 24-08-2005
Posts: 320
icon Re: Printing

Hi.

Check this code and try to modify it. I got this from one of my reference.

Add this code to a module:

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 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

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
Add this code to a form:

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 the 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 the contents of the RichTextBox with a one inch margin
PrintRTF RichTextBox1, 1440, 1440, 1440, 1440 ' 1440 Twips = 1 Inch
End Sub




____________________________
Im JAMES  

06-09-2005 at 01:05 AM
View Profile Send Email to User Show All Posts | Quote Reply
kibzama
Level: Big Cheese


Registered: 05-09-2005
Posts: 28
icon Re: Printing

Thanx James (TJ_o1)

I'l try this.

07-09-2005 at 10:45 AM
View Profile Send Email to User Show All Posts | Quote Reply
AndreaVB Forum : Printing : Printing
Previous Topic (select default printer in VB?)Next Topic (Numbering data items) New Topic New Poll Post Reply
Surf To:


Not Logged In? Username: Password: Lost your password?
Partners: Download Actual Software | Free Software Download
borderAndreaVB free resources for Visual Basic developersborder

borderAndreaVB Visual Basic and VB.NET source code resources - Copyright © 1999-2007 Andrea Tincaniborder