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

 

  Fórum

  Visual Basic
Voltar
Autor Assunto:  RichTextBox
MAC
IPATINGA
MG - BRASIL
Postada em 27/05/2004 02:38 hs            
Ola pessoal!!
peguei esta dica de como imprimir um RichTextBox, mas estou tendo um
certo problema quanto a chamar a função, ou seja tenho um botão e não estou sabendo como chamar a função neste botão para imprimir o richtextbox, alguem poderia me ajudar por favor!
 
Título da Dica:  Imprimir o conteúdo de um RichTextBox em qualquer parte da página   

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
     
Ama
Pontos: 2843
UBERLÂNDIA
MG - BRASIL
ENUNCIADA !
Postada em 27/05/2004 03:27 hs         
PrintRTF rc1, 3, 3, 6, 6
eu não gostei demora demais transferir conteudo para word e imprimir é mais rápido.
   
Página(s): 1/1    


Seu Nome:

Seu eMail:

ALTERAR PARA MODO HTML
Mensagem:

[:)] = 
[:P] = 
[:(] = 
[;)] = 

HTML DESLIGADO

     
 VOLTAR

  



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