Aê galera, beleza?
Não sei se será útil para alguém, mas eu precisei dessa coisa e num achei em lugar nenhum. Então, depois de feito, é hora de compartilhar...
Justificar parágrafo em VB com objeto PRINTERVocê vai precisar de um arquivo de módulo. No meu caso, chamei-o de modPrinter.bas
Public Const PHYSICALHEIGHT = 111
Public Const PHYSICALWIDTH = 110
Public Const PHYSICALOFFSETX = 112
Public Const PHYSICALOFFSETY = 113
Public Type SIZE
cx As Long
cy As Long
End Type
Public Declare Function _
GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" ( _
ByVal hdc As Long, _
ByVal lpsz As String, _
ByVal cbString As Long, _
lpSize As SIZE _
) As Long
Public Declare Function _
SetTextJustification Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nBreakExtra As Long, _
ByVal nBreakCount As Long _
) As Long
Public Declare Function _
TextOut Lib "gdi32" Alias "TextOutA" ( _
ByVal hdc As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal lpString As String, _
ByVal nCount As Long _
) As Long
Public Declare Function _
GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nIndex As Long _
) As Long
E aqui vai o arquivo de classe, que chamei de CPrinter.cls
Option Explicit
Private m_hDC As Double
Private m_LeftMargin As Long
Private m_RightMargin As Long
Private m_LineSize As Long
Private m_LineHeight As Long
Private Function getLineSpaces(ByVal szText As String) As Long
getLineSpaces = UBound(Split(szText, " "))
End Function
Public Property Let hdc(ByVal lngParm As Double)
m_hDC = lngParm
End Property
Public Property Get hdc() As Double
hdc = m_hDC
End Property
'Selectiona a impressora desejada pelo nome. Retorna o nome da impressora anteriormente selecionada
Public Function setPrinterDevice(ByVal szDeviceName) As String
Dim sz As SIZE
Dim lPtr As Printer
setPrinterDevice = Printer.DeviceName
Printer.KillDoc
If (szDeviceName <> "") Then
For Each lPtr In Printers
If (lPtr.DeviceName = szDeviceName) Then
Set Printer = lPtr
Exit For
End If
Next
End If
m_hDC = Printer.hdc
m_LeftMargin = GetDeviceCaps(m_hDC, PHYSICALOFFSETX)
m_RightMargin = GetDeviceCaps(m_hDC, PHYSICALWIDTH) - (GetDeviceCaps(m_hDC, PHYSICALOFFSETX) * 2)
m_LineSize = m_RightMargin - m_LeftMargin
GetTextExtentPoint32 m_hDC, "X", 1, sz
m_LineHeight = sz.cy
Printer.Print
End Function
Public Function PrintText(ByVal szText As String)
Dim sz As SIZE
Dim iPos As Long
Dim iOldPos As Long
Dim szBuffer As String
Do While (szText <> "")
iPos = 0
szBuffer$ = ""
sz.cx = 0: sz.cy = 0
Do While (sz.cx <= m_LineSize And iPos < Len(szText) And iPos <> -1)
iOldPos = iPos
iPos = InStr(iPos + 1, szText, " ")
If (iPos = 0) Then
szBuffer$ = szText$
iPos = -1
Else
szBuffer$ = Left(szText$, iPos - 1)
End If
GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
Loop
If (iPos = -1) Then
szBuffer$ = szText$
szText$ = ""
Else
szBuffer$ = Left$(szText$, iOldPos - 1)
szText$ = Mid$(szText$, iOldPos + 1)
End If
If (iPos <> -1) Then
GetTextExtentPoint32 m_hDC, szBuffer$, Len(szBuffer$), sz
SetTextJustification m_hDC, m_LineSize - sz.cx, getLineSpaces(szBuffer$)
Else
SetTextJustification m_hDC, 0, 0
End If
TextOut m_hDC, 0, Printer.CurrentY, szBuffer$, Len(szBuffer$)
SetTextJustification m_hDC, 0, 0
Printer.CurrentY = Printer.CurrentY + sz.cy
Loop
End Function
Public Sub newLine(Optional ByVal intLines As Integer = 1)
Printer.CurrentX = 0
Printer.CurrentY = Printer.CurrentY + (m_LineHeight * intLines)
End Sub
Public Sub EndDoc()
Printer.EndDoc
End Sub
E agora, um exemplo de utilização. Crie um form e coloque um botão no mesmo. No evento de click do botão, coloque algo como isto:
Private Sub Command2_Click()
Dim oPtr As New CPrinter
Dim szBuffer As String
'Seleciona a impressora desejada
oPtr.setPrinterDevice "" 'Sem informar nada, assume a impressora padrão configurada
szBuffer = "Coloque qualquer texto aqui. A função PrintText quebra as linhas e justifica para você"
oPtr.PrintText szBuffer$
'A função newLine salta um determinado número de linhas. Quando não for informado o número, assume o padrão de saltar 1 linha.
'IMPORTANTE: A função PrintText já salta para a próxima linha. Utilize newLine apenas para saltar mais linhas
oPtr.newLine 'Salta 1 linha
oPtr.newLine 1 'Salta 1 linha
oPtr.newLine 5 'Salta 5 linhas
szBuffer$ = "Coloque qualquer outro texto aqui"
oPtr.PrintText szBuffer$
Printer.EndDoc 'Finaliza impressão e despeja para a impressora
End Sub
É isso aê... espero ter ajudado alguém. Funcionou direitinho em uma HP DeskJet, em uma HP Laserjet e jogando para PDF via Easy PDF Creator.
Abs,
Roney
Editado por Claudio Neto, 27 julho 2009 - 15:29 .
Trocadas tags <div> por [code] para deixar padronizado
