DATA REPORT TEXTO JUSTIFICADO

MARCIOR 11/10/2009 18:05:36
#325052

Estou tentando fazer que o data report imprima um label justificado igual á um texto justificado pelo word, ou seja o texto fica sem nenhum espaço em branco na sua direita. abaixo têm uma funcção que retirei da net (planet source) mas ele soemnet justifica um Richtext, tentei madpatar para o rptlabel do data report mas não consegui. alguem poderia ajudar? ou alguma outra sugestão? mas gostaria que fosse justificado no data report..



Option Explicit
Dim crt As clsRichTextJustify

Private Sub cmdJustify_Click()
crt.Justify RTB.hwnd, 0, Len(RTB.Text)
End Sub

Private Sub Form_Load()
RTB.Text = [Ô]After considerable delay, the party proceeded to some ponds in the Bogan about five miles lower down. We were now nearly opposite to the scene of Mr. Cunningham[ô]s disasters: [Ô]
RTB.Text = RTB.Text & [Ô]I had recognised, amongst the first hills I saw when on the Goobang Creek, the hill which I had named Mount Juson, at his request, after the maiden name of his mother. The little pyramid of bushes was no longer there, but the name of Cunningham was so identified with the botanical history of almost all the shrubs in the very peculiar scenery of that part of the country, that no other monument seemed necessary. Other recollections recalled Cunningham to my mind; his barbarous murder, and the uncertainty which still hung over the actual circumstances attending it. The shrubs told indeed of Cunningham; of both brothers, both now dead; but neither the shrubs named by the one, nor the gloomy <I/>casuarinæ</I> trees that had witnessed the bloody deed, could tell more. There the <I/>Acacia pendula</I>, first discovered and described by Allan, could only[Ô]
Set crt = New clsRichTextJustify

End Sub

Option Explicit
Private Const WM_USER = &H400
Private Const EM_EXSETSEL = (WM_USER + 55)
Private Const EM_SETSEL = &HB1
Private Const EM_GETSEL = &HB0
Private Const EM_GETPARAFORMAT = (WM_USER + 61)
Private Const EM_SETPARAFORMAT = (WM_USER + 71)
Private Const EM_GETSELTEXT = (WM_USER + 62)
Private Const EM_SETTYPOGRAPHYOPTIONS = (WM_USER + 202)
Private Const EM_GETTYPOGRAPHYOPTIONS = (WM_USER + 203)
Private Const TO_ADVANCEDTYPOGRAPHY = &H1
Private Const TO_SIMPLELINEBREAK = &H2&
Private Const PFM_ALIGNMENT = &H8
Private Const PFM_TABSTOPS = &H10
Private Const PFM_STYLE = &H400
Private Const PFA_LEFT = 1
Private Const PFA_RIGHT = 2
Private Const PFA_CENTER = 3
Private Const PFA_JUSTIFY = &H4
Private Const PS_SOLID = 0
Private Const PFA_FULL_GLYPHS = 7
Private Const mZERO = &H0&
Private Declare Function SendMessageLong Lib [Ô]user32[Ô] Alias [Ô]SendMessageA[Ô] (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#If UNICODE Then
Private Declare Function SendMessage Lib [Ô]user32[Ô] Alias [Ô]SendMessageW[Ô] (ByVal hwnd As Long, ByVal uMgs As Long, ByVal wParam As Long, lParam As Any) As Long
#Else
Private Declare Function SendMessage Lib [Ô]user32[Ô] Alias [Ô]SendMessageA[Ô] (ByVal hwnd As Long, ByVal uMgs As Long, ByVal wParam As Long, lParam As Any) As Long
#End If

Private Type Charrange
cpMin As Long
cpMax As Long
End Type



Private Type PARAFORMAT2
cbsize As Integer
dwpad As Integer
dwMask As Long
wNumbering As Integer
wReserved As Integer
dxStartIndent As Long
dxRightIndent As Long
dxOffset As Long
wAlignment As Integer
cTabCount As Integer
lTabstops(0 To 31&) As Long
dySpaceBefore As Long
dySpaceAfter As Long
dyLineSpacing As Long
sStyle As Integer
bLineSpacingRule As Byte
bOutlineLevel As Byte
wShadingWeight As Integer
wShadingStyle As Integer
wNumberingStart As Integer
wNumberingStyle As Integer
wNumberingTab As Integer
wBorderSpace As Integer
wBorderWidth As Integer
wBorders As Integer

End Type
Public Sub Justify(hwndr As Long, intStart As Integer, intEnd As Integer)
Dim myparaf As PARAFORMAT2
Dim cr As Charrange
Dim lngRet As Long
myparaf.cbsize = Len(myparaf)
[ô] paragraph selection points to character before and
[ô] character after position from beginning of the RichText Box
cr.cpMax = intEnd
cr.cpMin = intStart
[ô] Select the text if you don[ô]t want to see it make the RichText invisible first
SendMessage hwndr, EM_EXSETSEL, mZERO, cr
lngRet = SendMessageLong(hwndr, EM_SETTYPOGRAPHYOPTIONS, TO_ADVANCEDTYPOGRAPHY, TO_ADVANCEDTYPOGRAPHY)

If lngRet = 1 Then [ô]only do this if version 3.0

lngRet = SendMessageLong(hwndr, EM_GETTYPOGRAPHYOPTIONS, mZERO, mZERO)
lngRet = SendMessage(hwndr, EM_GETPARAFORMAT, mZERO, myparaf)
If myparaf.wAlignment = PFA_LEFT Then
myparaf.dwMask = PFM_ALIGNMENT
myparaf.wAlignment = PFA_JUSTIFY

lngRet = SendMessage(hwndr, EM_SETPARAFORMAT, mZERO, myparaf)
Else
Debug.Print [Ô]Centre[Ô]
End If
Else
Debug.Print [Ô]FAIL[Ô]
End If
cr.cpMin = 0
cr.cpMax = 0
SendMessage hwndr, EM_EXSETSEL, mZERO, cr
End Sub
Public Sub Settabs(hwndr As Long, lngArrTabs() As Long, rwidth As Long, Optional lngstart As Long, Optional lngEnd As Long)
[ô]sets tabs in twips careful not to exceed the width of the rich text box rwidth
[ô] pass in the tabs in an array base 1
Dim myparaf As PARAFORMAT2
Dim lngRet As Long
Dim intCnt As Integer
Dim cr As Charrange
Dim intCum As Integer
Dim lngTabs As Long
lngEnd = lngEnd + 4
[ô]set the selection
If lngstart = 0 And lngEnd = 0 Then
[ô]cr.cpMax = Len(frmName.richtb.Text) [ô]put appropriate source in here
cr.cpMin = 0
Else
cr.cpMax = lngEnd
cr.cpMin = lngstart
End If

[ô]first select all the text or nothing will happen
SendMessage hwndr, EM_EXSETSEL, 0, cr

[ô]setup the tab array
lngTabs = UBound(lngArrTabs)
myparaf.cbsize = Len(myparaf)
lngRet = SendMessage(hwndr, EM_GETPARAFORMAT, 0, myparaf)

For intCnt = 0 To lngTabs - 1
If lngArrTabs(intCnt + 1) <= rwidth Then [ô](rwidth * Screen.TwipsPerPixelX) - lngSize Then
myparaf.lTabstops(intCnt) = lngArrTabs(intCnt + 1)
myparaf.cTabCount = intCnt + 1
End If
Next intCnt

[ô]Now do the tabs
myparaf.dwMask = PFM_TABSTOPS
lngRet = SendMessage(hwndr, EM_SETPARAFORMAT, 0, ByVal myparaf)
cr.cpMax = 0
cr.cpMin = 0

[ô]clean up setting selection to zero
SendMessage hwndr, EM_EXSETSEL, 0, cr


End Sub