USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  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      Clique aqui para enviar email para o autor  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
 


CyberWEB Network Ltda.    © Copyright 2000-2022   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página