|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Impressões/Impressoras)
|
|
 |
Título da Dica: Imprimir o conteúdo de um RichTextBox em qualquer parte da página
|
 |
|
|
|
Postada em 8/2/2001 por RCO
rcop@uol.com.br
De os créditos ao Progamador abaixo, pois vale a pena esta função,
Ela permite imprimir o conteúdo de um RichTextBox em qualquer parte da página de uma forma muito simples:
' NomeRichEdit, MargemEsq, MargemSuperior, MargemDireita, MargemSuperior
printRtf Richedit1, 3000,9000, 100, 100
Ideal pra quem precisa mexer com .RTF sem usar o Word, pois dá pra exportar/importar, formatar e até colocar figura no richEdit da MS.
Com o Word, estas operações ficam demoradas;
'veja com *** os locais que eu precisei alterar;
' #VBIDEUtils#*********************************************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 28/06/99
' * Time : 13:01
' ************************************************************
' * Comments : Print RichTextBox contents
' *
' *
' ***************************************************************
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 GetDeviceCaps Lib "GDI32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const WM_USER = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113
Private Type RECT
left As Long
tOp As Long
Right As Long
Bottom As Long
End Type
Private Type CharRange
cpMin As Long
cpMax As Long
End Type
Private Type FormatRange
hdc As Long
hdcTarget As Long
rc As RECT
rcPage As RECT
chrg As CharRange
End Type
Public Function PrintRTF(rtf As RichTextBox, nnLeftMarginWidth _
As Long, nnTopMarginHeight As Long, nnRightMarginWidth As _
Long, nnBottomMarginHeight As Long, Optional vgObj As Printer) As Boolean
*** Optional vgObj As Printer, coloquei aqui pra pegar o objeto
*** printer Default(usado nos relatórios, via Printer)
' #VBIDEUtils#************************************************
' * Programmer Name : Waty Thierry
' * Web Site : www.geocities.com/ResearchTriangle/6311/
' * E-Mail : waty.thierry@usa.net
' * Date : 30/10/98
' * Time : 14:43
' * Module Name : Main_Module
' * Module Filename : Main.bas
' * Procedure Name : PrintRTF
' * Parameters :
' * rtf As RichTextBox
' * nnLeftMarginWidth As Long
' * nnTopMarginHeight As Long
' * nnRightMarginWidth As Long
' * nnBottomMarginHeight As Long
' ***************************************************************
' * Comments :
' *
' *
' *************************************************************
On Error GoTo ErrorHandler
Dim nLeftOffset As Long
Dim nTopOffset As Long
Dim nLeftMargin As Long
Dim nTopMargin As Long
Dim nRightMargin As Long
Dim nBottomMargin As Long
Dim fr As FormatRange
Dim rcDrawTo As RECT
Dim rcPage As RECT
Dim nTextLength As Long
Dim nNextCharPos As Long
Dim nRet As Long
'*** Defini vgObj caso não o passem;
If (vgObj Is Nothing) Then
Set vgObj = Printer
End If
vgObj.Print Space(1)
vgObj.ScaleMode = vbTwips
nLeftOffset = vgObj.ScaleX(GetDeviceCaps(vgObj.hdc, _
PHYSICALOFFSETX), vbPixels, vbTwips)
nTopOffset = vgObj.ScaleY(GetDeviceCaps(vgObj.hdc, _
PHYSICALOFFSETY), vbPixels, vbTwips)
nLeftMargin = nnLeftMarginWidth - nLeftOffset
nTopMargin = nnTopMarginHeight - nTopOffset
nRightMargin = (vgObj.Width - nnRightMarginWidth) _
- nLeftOffset
nBottomMargin = (vgObj.Height - nnBottomMarginHeight) _
- nTopOffset
rcPage.left = 0
rcPage.tOp = 0
rcPage.Right = vgObj.ScaleWidth
rcPage.Bottom = vgObj.ScaleHeight
rcDrawTo.left = nLeftMargin
rcDrawTo.tOp = nTopMargin
rcDrawTo.Right = nRightMargin
rcDrawTo.Bottom = nBottomMargin
fr.hdc = vgObj.hdc
fr.hdcTarget = vgObj.hdc
fr.rc = rcDrawTo
fr.rcPage = rcPage
fr.chrg.cpMin = 0
fr.chrg.cpMax = -1
nTextLength = Len(rtf.Text)
Do
fr.hdc = vgObj.hdc
fr.hdcTarget = vgObj.hdc
nNextCharPos = SendMessage(rtf.hWnd, EM_FORMATRANGE, _
True, fr)
If nNextCharPos >= nTextLength Then Exit Do
fr.chrg.cpMin = nNextCharPos
vgObj.NewPage
vgObj.Print Space(1)
Loop
'vgObj.EndDoc
nRet = SendMessage(rtf.hWnd, EM_FORMATRANGE, _
False, ByVal CLng(0))
PrintRTF = True
Exit Function
ErrorHandler:
PrintRTF = False
End Function
|
|
|
|
|
