Necesito saber como hago para justificar texto a ambas
margenes en un campo memo de access-97, solo permite
justificar a la izquierda, derecha o centro pero no a
ambos lados,
gracias por su ayuda
RESPONDE EDUARDO OLAZ
=====================
La función TextoAParrafos, que desarrollé hace 3 años, te devuelve una
cadena con líneas del mismo nº de caracteres.
(El efecto de justificación sólo funciona con fuentes mono-espaciadas, por
ejemplo Courier New )
'************************************************************************
' TextoAParrafos(Texto,Parrafo) --> String
' Función desarrollada por Eduardo Olaz
' Primera versión 4/11/99
' Última revisión 4/11/99
'************************************************************************
' parámetros: Texto (por valor, string) Texto que se quiere convertir
' Parrafo (por valor, long) Longitud máxima del párrafo
' Valor devuelto (String) Cadena transformada
' Método: Recursivo
' Funciones auxiliares: SubParrafo(Texto,Parrafo) --> String
' PosicionCorte(Texto,Parrafo)--> Long
' Devuelve la cadena Texto transformada
' en párrafos de longitud igual a Parrafo
' salvo que se encuentre un salto de línea ó retorno de carro
' que hará que ese párrafo sea más corto.
' Para igualar los párrafos inserta espacios junto a cada espacio
' hasta completar una línea de longitud constante
' esta función se usa de forma recursiva cortando
' la cadena Texto hasta que el último trozo es
' de longitud <= que Parrafo
Public Function TextoAParrafos(ByVal Texto As String, _
ByVal Parrafo As Long) _
As String
Dim lngLongitudTexto As Long
Dim lngPuntoCorte As Long 'punto por donde cortar la cadena
Dim strTextoIzquierda As String 'cadena a la izquierda del corte
Dim strTextoDerecha As String 'cadena a la derecha del corte
Dim strCaracter As String * 1
lngLongitudTexto = Len(Texto)
If lngLongitudTexto <= Parrafo Then
TextoAParrafos = Texto
Else
lngPuntoCorte = PosicionCorte(Texto, Parrafo)
strTextoIzquierda = RTrim(Left$(Texto, lngPuntoCorte))
strCaracter = Mid$(Texto, lngPuntoCorte)
If (strCaracter = vbNewLine Or strCaracter = vbLf) Then
' Se ha detectado final de párrafo
strTextoDerecha = Mid$(Texto, lngPuntoCorte + 1)
TextoAParrafos = strTextoIzquierda & _
TextoAParrafos(LTrim$(strTextoDerecha), Parrafo)
Else
' Añadir espacios en los huecos hasta longitud de parrafo
strTextoIzquierda = SubParrafo(strTextoIzquierda, Parrafo)
strTextoDerecha = Mid$(Texto, lngPuntoCorte + 1)
TextoAParrafos = strTextoIzquierda & vbCrLf & _
TextoAParrafos(LTrim$(strTextoDerecha), Parrafo)
End If
End If
End Function
'************************************************************************
' PosicionCorte(Texto,Parrafo) --> Long
' Función desarrollada por Eduardo Olaz
' Primera versión 4/11/99
' Última revisión 4/11/99
'************************************************************************
' parámetros: Texto (por valor, string) del que obtener pto. de corte
' Parrafo (por valor, long) Longitud máxima del párrafo
' Valor devuelto (Long) Punto por el que cortar la cadena Texto
' Método: Iterativo
Public Function PosicionCorte(ByVal Texto As String, ByVal Parrafo As Long)
As Long
Dim lngLongitudTexto As Long
Dim lngContador As Long
Dim strCaracter As String * 1
Dim strIzquierda As String
lngLongitudTexto = Len(Texto)
' Recorre carácter a carácter la cadena
' hasta la posición Parrafo.
' esta búscqueda se interrumpe si encuentra una carácter
' de retorno de carro o salto de línea o si se acaba la cadena
Do While lngContador < Parrafo And _
lngContador <= lngLongitudTexto _
And strCaracter <> vbNewLine _
And strCaracter <> vbLf
lngContador = lngContador + 1
strCaracter = Mid$(Texto, lngContador, 1)
Loop
If lngContador < Parrafo Then
PosicionCorte = lngContador
Else
Select Case strCaracter
Case vbNewLine, vbLf
PosicionCorte = lngContador
' Si encuentra un espacio en blanco o un tabulador
' en la última posición recorre la cadena hacia la izquierda
' hasta encontrar un carácter
Case " ", vbTab
Do While (strCaracter = " " Or strCaracter = vbTab)
lngContador = lngContador - 1
strCaracter = Mid$(Texto, lngContador, 1)
Loop
PosicionCorte = lngContador + 1
Case Else
' Busca un espacio en blanco o tabulador a la izquierda
' para efectuar el corte en un blanco
PosicionCorte = lngContador
Do While (strCaracter <> " " _
And strCaracter <> vbTab _
And lngContador > 1)
lngContador = lngContador - 1
strCaracter = Mid$(Texto, lngContador, 1)
Loop
'Extrae la cadena sin blancos a la derecha
strIzquierda = RTrim(Left$(Texto, lngContador))
PosicionCorte = Len(strIzquierda)
End Select
End If
End Function
Public Function SubParrafo(ByVal Texto As String, _
ByVal Parrafo As Long) _
As String
' Devuelve una cadena contenida en la parte izquierda de Texto
' de longitud menor ó igual que el valor de parrafo
Dim lngContador As Long
Dim lngLongitudTexto As Long
Dim lngBlancos As Long
Dim lngBlancosPorEspacio As Long
Dim lngEspacios As Long
Dim lngPosicion As Long
Dim strCaracter As String * 1
Dim strLadoIzquierdo As String
Dim strLadoDerecho As String
Dim lngEspacioActual As Long
Dim astrEspacios() As String
lngLongitudTexto = Len(Texto)
If lngLongitudTexto = Parrafo Then
SubParrafo = Texto
Else
lngBlancos = Parrafo - lngLongitudTexto
' Averiguar el nº de espacios en blanco que hay en texto
For lngPosicion = 1 To lngLongitudTexto
strCaracter = Mid$(Texto, lngPosicion, 1)
If strCaracter = " " Then
lngEspacios = lngEspacios + 1
End If
Next lngPosicion
If lngEspacios = 0 Then
SubParrafo = Texto
Else
' Uso la matriz dinámica astrEspacios para almacenar
' los blancos a añadir
ReDim astrEspacios(1 To lngEspacios)
lngBlancosPorEspacio = lngBlancos \ lngEspacios
For lngContador = 1 To lngEspacios
astrEspacios(lngContador) = Space(lngBlancosPorEspacio)
Next lngContador
For lngContador = 1 _
To lngBlancos - lngBlancosPorEspacio * lngEspacios
astrEspacios(lngContador) = astrEspacios(lngContador) & " "
Next lngContador
For lngPosicion = 1 To lngLongitudTexto
strCaracter = Mid$(Texto, lngPosicion, 1)
strLadoIzquierdo = strLadoIzquierdo & strCaracter
If strCaracter = " " Then
lngEspacioActual = lngEspacioActual + 1
strLadoIzquierdo = strLadoIzquierdo _
& astrEspacios(lngEspacioActual)
End If
Next lngPosicion
SubParrafo = strLadoIzquierdo
End If
End If
End Function
_____________________________________
(
geocities.com/es/ensolva/Descargas) (
geocities.com/es/ensolva) (
geocities.com/es)