Esta clase ya la publiqué en Junio del 98 y también en la librería gsAxDLL, e incluso la he usado tanto en la utilidad para generar eBooks compatibles con Microsoft Reader (gsListGen) como en la calculadora gsCalc, en estos dos casos he usado la clase para "alinear" correctamente el texto mostrado en los mensajes "Acerca de..", además de que ya usaba la versión de Octubre de 2002 que es la que te muestro aquí.
No esperes "virguerías", ya que en la parte de "justificar" texto, sólo lo hace si el tipo de fuente usada no es proporcional (de tamaño fijo), aunque con un poco de "investigación", seguro que se puede hacer... pero... tendrás que hacerlo tu por tu cuenta... aunque las pistas pueden ir usando TextWidth de la clase Form, que nos da el tamaño del texto que le indicamos como parámetro...
Antes de nada, decirte que puedes hacer con esta clase, primero te explico todo lo que contiene y después tres ejemplos prácticos de dos de los métodos.
Estos son los métodos de la clase y para que sirven:
| Justificar | Justifica la cadena, añadiendo espacios hasta conseguir la longitud deseada |
| PropperJust | Justifica la
cadena según los caracteres indicados Esto sólo será útil si el resultado se muestra con fuente no proporcional |
| PropperWrap | Es como las siguientes, pero se debe especificar por dónde empezar a contar los caracteres. |
| PropperLeft | Como Left$(Cadena, longitud) pero sin cortar palabras |
| PropperMid | Como Mid$(Cadena, longitud) pero sin cortar palabras |
| PropperRight | Como Right$(Cadena, longitud) pero sin cortar palabras |
| Separadores | Para indicar
los separadores a usar Por defecto los separadores serán: " ªº\!|@#$%&/()=?¿'¡[]*+{}<>,.-;:_", además de vbCr, vbLf, vbTab y Chr$(34) |
Tres ejemplos prácticos para usar esta clase.
Lo único que voy a hacer aquí es mostrarte tres casos en los que puedes usar esta clase:
- Uno de ellos es "justificar" un texto (recuerda que el tipo de letra debe ser de tamaño fijo, como el Courier New).
- El segundo es para pasar un texto con un tamaño indefinido y poder mostrarlo en trozos de x caracteres, el ejemplo que utilizo es el de un texto para usarlo en un MsgBox, de forma que dicho cuadro de mensaje no sea excesivamente largo.
- El tercero (quizás más interesante), es para ajustar el texto según un ancho indicado y con una sangría determinada, es decir, le indicamos cuantos caracteres queremos en cada línea y además le indicamos que cierta cantidad debe ser de espacios en blanco. En esta ocasión utilizo el método LoopPropperWrap
Este es el formulario en tiempo de diseño y el código tanto de la clase como del formulario lo tienes al final.
El formulario en tiempo de diseño
Aquí tienes dos capturas del "Acerca de..." justificado y sin justificar:
El Acerca de... justificado
El Acerca de... normal (sin justificar)
Pues nada, espero que te sea de utilidad y que, aunque tarde, puedas aprovecharte de algunas de las cosillas que contiene.
Aquí tienes el ZIP con el código de la clase y del formulario: cWrapPrueba.zip - 5.78 KB
Nos vemos.
Guillermo
El código del formulario y de la clase cWrap.
La clase:
'------------------------------------------------------------------------------
' cWrap (13/Jun/98)
' Clase para efectuar "cortes" de palabras de forma apropiada
'
' Revisado el 4/Ene/1999
' Revisado el 20/Ago/2001 Nueva función: LoopPropperWrap
' Revisado el 08/Oct/2002 Algunos ajustes cuando la cadena contiene intro
'
' ©Guillermo 'guille' Som, 1998-2002
'
' Esta clase tiene los siguientes métodos (funciones)
' Justificar Justifica la cadena,
' añadiendo espacios hasta conseguir la longitud deseada
' PropperJust Justifica la cadena según los caracteres indicados
' Esto sólo será útil si el resultado se muestra con fuente
' no proporcional
' PropperWrap Es como las siguientes, pero se debe especificar por dónde
' empezar a contar los caracteres.
' PropperLeft como Left$(Cadena, longitud) pero sin cortar palabras
' PropperMid como Mid$(Cadena, longitud) pero sin cortar palabras
' PropperRight como Right$(Cadena, longitud) pero sin cortar palabras
'
' Separadores Para indicar los separadores a usar
'------------------------------------------------------------------------------
Option Explicit
Const cSeparadores = " ªº\!|@#$%&/()=?¿'¡[]*+{}<>,.-;:_"
Private sSeparadores As String
'Alineación para usar con PropperWrap
Public Enum ePropperWrapConstants
pwLeft = 0
pwMid = 1
pwRight = 2
' pwIzquierda = 0
' pwCentro = 1
' pwDerecha = 2
End Enum
Public Function PropperWrap(ByVal sCadena As String, _
ByVal nCaracteres As Long, _
Optional ByVal DesdeDonde As ePropperWrapConstants = pwLeft) As String
'Devuelve la cadena que habría que imprimir para mostrar los
'caracteres indicados, sin cortar una palabra.
'Esto es para los casos en los que se quiera usar:
'Left$(sCadena,nCaracteres) o Mid$/Right$(sCadena,nCaracteres)
'pero sin cortar una palabra
Dim i As Long
Dim sChar As String
'
i = InStr(sCadena, vbCrLf)
If i > 0 And i < nCaracteres Then
sCadena = Left$(sCadena, i + 1)
ElseIf nCaracteres > Len(sCadena) Then
i = InStr(sCadena, vbCrLf)
If i Then
sCadena = Left$(sCadena, i - 1)
End If
'PropperWrap = sCadena
Else
For i = nCaracteres To 1 Step -1
If InStr(sSeparadores, Mid$(sCadena, i, 1)) Then
'Si se especifica desde la izquierda
If DesdeDonde = pwLeft Then
sCadena = Left$(sCadena, i)
Else
'lo mismo da desde el centro que desde la derecha
sCadena = Mid$(sCadena, i + 1)
End If
Exit For
End If
Next
End If
PropperWrap = sCadena
End Function
Public Function PropperRight(ByVal sCadena As String, ByVal nCaracteres As Long) As String
PropperRight = PropperWrap(sCadena, nCaracteres, pwRight)
End Function
Public Function PropperMid(ByVal sCadena As String, ByVal nCaracteres As Long, Optional ByVal RestoNoUsado As Long) As String
PropperMid = PropperWrap(sCadena, nCaracteres, pwMid)
End Function
Public Function PropperLeft(ByVal sCadena As String, ByVal nCaracteres As Long) As String
PropperLeft = PropperWrap(sCadena, nCaracteres, pwLeft)
End Function
Public Function PropperJust(ByVal Cadena As String, _
Optional ByVal Longitud As Long = 70&, _
Optional ByVal Justificar As Boolean = True) As String
'--------------------------------------------------------------------------
' Justifica la cadena según los caracteres indicados ( 3/Ene/99)
' Esto sólo será útil si el resultado se muestra con fuente no proporcional
' Valores de entrada:
' Cadena Cadena a manipular
' Longitud Longitud de cada línea, por defecto 70 caracteres
' Justificar Si se justifica, rellenando con espacios, por defecto Si
' Devuelve:
' La cadena una vez manipulada
'--------------------------------------------------------------------------
Dim sLinea As String
Dim sTmp As String
Dim sTmp2 As String
Dim i As Long
Do
'Los cambios de línea se consideran por separado
i = InStr(Cadena, vbCrLf)
If i Then
sTmp = Left$(Cadena, i - 1)
Cadena = Mid$(Cadena, i + 2)
Else
sTmp = Cadena
Cadena = ""
End If
Do
sLinea = Me.PropperWrap(sTmp, Longitud, pwLeft)
If sTmp = sLinea Then
'no justificar cuando es el final de línea
sTmp = ""
Else
sTmp = Mid$(sTmp, Len(sLinea) + 1)
If Justificar Then
sLinea = Me.Justificar(sLinea, Longitud)
End If
End If
sTmp2 = sTmp2 & sLinea & vbCrLf
Loop While Len(sTmp)
Loop While Len(Cadena)
PropperJust = sTmp2
End Function
Public Function Justificar(ByVal Cadena As String, _
Optional ByVal Longitud As Long = 70&) As String
' Justifica la cadena, añadiendo espacios hasta conseguir la longitud deseada
Dim i As Long
Dim j As Long
Dim k As Long
Dim Hallado As Boolean
Dim n As Long
Cadena = Trim$(Cadena)
If Len(Cadena) < Longitud Then
k = 1
n = 0
'
Hallado = False
Do
For i = 1 To Len(sSeparadores)
j = InStr(k, Cadena, Mid$(sSeparadores, i, 1))
If j Then
Cadena = Left$(Cadena, j) & " " & Mid$(Cadena, j + 1)
k = j + 1
'Buscar el siguiente caracter que no sea un separador
For j = k + 1 To Len(Cadena)
If InStr(sSeparadores, Mid$(Cadena, j, 1)) = 0 Then
k = j
Exit For
End If
Next
Hallado = True
n = n + 1
Exit For
Else
k = 1
Hallado = False
End If
Next
If Not Hallado Then
k = 1
If n = 0 Then
Cadena = Cadena & " "
End If
End If
Loop While Len(Cadena) < Longitud
End If
Justificar = Left$(Cadena, Longitud)
End Function
Private Sub Class_Initialize()
'sSeparadores = cSeparadores & vbCr & vbLf & vbTab & Chr$(34)
' Añadir los intros y tabuladores antes del resto de caracteres (08/Oct/02)
sSeparadores = vbCr & vbLf & vbTab & cSeparadores & Chr$(34)
End Sub
Public Property Get Separadores() As String
Separadores = sSeparadores
End Property
Public Property Let Separadores(ByVal NewSeparadores As String)
sSeparadores = NewSeparadores
End Property
Public Function LoopPropperWrap(Optional ByVal sCadena As String, _
Optional ByVal nCaracteres As Long = 70&, _
Optional ByVal DesdeDonde As ePropperWrapConstants = pwLeft) As String
' Repite la justificación hasta que la cadena esté vacia (20/Ago/01)
' Devolviendo cada vez el número de caracteres indicados
Static sCadenaCopia As String
Static nCaracteresCopia As Long
Static DesdeDondeCopia As ePropperWrapConstants
Dim s As String
'
' Si la cadena es una cadena vacía, es que se continua "partiendo"
' sino, es la primera llamada
If Len(sCadena) Then
sCadenaCopia = sCadena
nCaracteresCopia = nCaracteres
DesdeDondeCopia = DesdeDonde
Else
' Asignar los valores que había antes
sCadena = sCadenaCopia
nCaracteres = nCaracteresCopia
DesdeDonde = DesdeDondeCopia
End If
'
' ESTO NO ES NECESARIO
' (además de que se queda "colgao")
' ' ya que los cambios de líneas se consideran separadores
' ' Si hay un vbCrLf, mostrar hasta ese caracter
' Dim i As Long
' i = InStr(sCadena, vbCrLf)
' If i Then
' If i < nCaracteres Then
' nCaracteres = i '- 1
' sCadena = Left$(sCadena, i - 1) & " " & Mid$(sCadena, i)
' End If
' End If
'
'
s = PropperWrap(sCadena, nCaracteres, DesdeDonde)
sCadenaCopia = Mid$(sCadena, Len(s) + 1)
' Si termina con vbCrLf quitárselo... (08/Oct/02)
If Right$(s, 2) = vbCrLf Then
s = Left$(s, Len(s) - 2)
End If
'
LoopPropperWrap = s
End Function
El formulario:
'------------------------------------------------------------------------------
' Prueba para la clase cWrap (26/Dic/04)
' Clase para efectuar "cortes" de palabras de forma apropiada
' e incluso para justificar texto usando tipos de letras de tamaño fijo
'
' ©Guillermo 'guille' Som, 1998-2004
'------------------------------------------------------------------------------
Option Explicit
Private Sub Check1_Click()
Text1(1) = justificarTexto(Text1(0), Text2, Check1.Value)
End Sub
Private Function justificarTexto(ByVal texto As String, ByVal num As Long, just As Boolean) As String
Dim tWrap As cWrap
Set tWrap = New cWrap
'
If num < 1 Or num > Len(texto) Then
num = 34
End If
'
justificarTexto = tWrap.PropperJust(texto, num, just)
'
Set tWrap = Nothing
End Function
Private Sub cmdAcercaDe_Click()
' normalmente uso esta clase para el texto a mostrar en Acerca de...
' Acerca de... (se usa la clase cWrap para ajustar el texto a 60 caracteres
Dim s As String
Dim tWrap As cWrap
Set tWrap = New cWrap
'
s = s & "Prueba de mensaje en Acerca de..." & vbCrLf & vbCrLf
s = s & tWrap.PropperJust("Aquí se escribirá todo el texto que queramos 'justificar' o, en este caso, alinear para que no se corte al mostrarlo o sea el propio MsgBox el que corte las palabras en la posición que le venga bien... En este caso he indicado que se 'justifique a los 60 caracteres.", 60, False) & vbCrLf
s = s & tWrap.PropperJust("cWrap, clase para justificar y alinear texto versión del 08/Oct/2002", 40) & vbCrLf & vbCrLf
s = s & Space$(10) & "©Guillermo 'guille' Som, 1998-2204" & vbCrLf & vbCrLf
'
MsgBox s, vbInformation, Caption
'
Set tWrap = Nothing
End Sub
Private Sub cmdAcercaNormal_Click()
Dim s As String
'
s = s & "Prueba de mensaje en Acerca de..." & vbCrLf & vbCrLf
s = s & "Aquí se escribirá todo el texto que queramos 'justificar' o, en este caso, alinear para que no se corte al mostrarlo o sea el propio MsgBox el que corte las palabras en la posición que le venga bien... En este caso he indicado que se 'justifique a los 60 caracteres." & vbCrLf
s = s & "cWrap, clase para justificar y alinear texto versión del 08/Oct/2002" & vbCrLf & vbCrLf
s = s & Space$(10) & "©Guillermo 'guille' Som, 1998-2204" & vbCrLf & vbCrLf
'
MsgBox s, vbInformation, Caption
End Sub
Private Sub cmdLoopPropperWrap_Click()
' Prueba con LoopPropperWrap
Dim s As String
Dim sCabecera As String
Dim margenIzq As Long, longTotal As Long
Dim tWrap As cWrap
Set tWrap = New cWrap
'
margenIzq = Val(txtMargenIzq)
If margenIzq < 0 Or margenIzq > 40 Then
margenIzq = 10
End If
longTotal = Val(Me.txtLongTotal)
If longTotal < margenIzq Or longTotal > 136 Then
longTotal = 70
End If
sCabecera = Text1(2)
s = tWrap.LoopPropperWrap(sCabecera, longTotal, pwLeft)
sCabecera = ""
Do While Len(s) > 0
' Añadirle el margen izquierdo
sCabecera = sCabecera & Space$(margenIzq) & s & vbCrLf
s = tWrap.LoopPropperWrap()
Loop
Text1(3) = sCabecera
End Sub
Private Sub cmdTestWrap_Click()
' Prueba para uar la clase cWrap
Dim sTmp As String
'
If Text1(0) = "" Then
sTmp = "Érase una vez un pueblo llamado Monteoscuro, " & _
"situado en un mundo fantástico. Este ancestral " & _
"pueblo estaba dividido en dos bandos, los Gorrinos " & _
"y los Berzotas. " & vbCrLf & _
"Texto extraido de: El anillo verde de Alberto Vázquez-Figueroa."
Text1(0) = sTmp
End If
'
Text1(1) = justificarTexto(Text1(0), Text2, Check1.Value)
End Sub
Private Sub Form_Load()
Dim sTmp As String
sTmp = "Érase una vez un pueblo llamado Monteoscuro, " & _
"situado en un mundo fantástico. Este ancestral " & _
"pueblo estaba dividido en dos bandos, los Gorrinos " & _
"y los Berzotas. " & vbCrLf & _
"Texto extraido de: El anillo verde de Alberto Vázquez-Figueroa."
'
Text1(0) = sTmp
Text1(2) = sTmp
End Sub
