Felip
Master
Registrado: 09 Jun 2004Mensajes: 200
|
 Publicado: Jue 15 Sep, 2011 3:45 pm Asunto: VB a C++Builder - justificar el texto en richedit |
 |
|
Alguien sabe cómo traducir VB a C++Builder?
Es un código para justificar el texto en richedit:
| Código: |
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "clsRichTextJustify"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
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
|
fuente: http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=27264&lngWId=1 |
|
FAQ
Buscar
Miembros
Grupos de Usuarios
Registrarse
Perfil
Entra para ver tus mensajes privados
Entrar
