Programa para justificar texto. ¡Listo!

[Oscar Gonzalez Hernandez]

Hace unas semanas tuve la necesidad de imprimir texto justificado en un
informe de VFP, el cual venia desde un campo memo, al no recibir una
solución, decidi hacerlo yo mismo y ya he terminado. Coloco aqui la clase
que realice y como la utilizo en mi aplicación.

Espero que le puedan dar uso y si es posible que la mejoraran.
Saludos...

Desarrollado por Oscar Gonzalez Hernandez
Mexico D.F
Saludos...

Uso de la Clase:

local loJustify
loJustify = createobject("justify")
loJustify.cSalidaTexto = "salida.txt"
loJustify.set_textmerge_on
loJustify.dojustify(cTexto,nLong)
loJustify.set_textmerge_off

Donde:
cTexto = Texto que se quiere justificar
nLong = Longitud en caracteres a justificar
Despues Revisar el archivo salida.txt

**************************************************
*-- Class: justify (c:\proyecto\clases\utilities.vcx)
*-- ParentClass: custom
*-- BaseClass: custom
*-- Marca de hora: 02/02/04 02:12:11 PM
*
DEFINE CLASS justify AS custom

Height = 15
Width = 16
*-- Contiene el texto ya justificado y se va acumulando hasta contener todo
el texto justificado.
ctextoacumulado = ""
Name = "justify"

*-- Contiene el nombre del archivo que se creará con el texto justificado.
csalidatexto = .F.

*-- Separa el texto pasado como parámetro en diferentes bloques si ses que
se encuentran retornos de carro, sino regresa el texto completo.
PROCEDURE separa
LPARAMETERS tcParrafo,taBloques,tbBloques
lnDimension = 0
FOR i = 1 TO LEN(tcParrafo)
IF ASC(SUBSTR(tcParrafo,i,1)) = 13
lnDimension = lnDimension + 1
DIMENSION laRetornos(lnDimension)
laRetornos(lnDimension) = i
ENDIF
ENDFOR
IF VARTYPE(laRetornos) = "U"
tbBloques = .F.
taBloques = tcParrafo
RETURN @taBloques
ENDIF
lnInicio = 1
FOR k = 1 TO ALEN(laRetornos)
DIMENSION taBloques(k)
taBloques(k) = SUBSTR(tcParrafo,lnInicio,laRetornos(k)-lnInicio)
lnInicio = laRetornos(k)+1
ENDFOR
DIMENSION taBloques(k)
taBloques(k) = SUBSTR(tcParrafo,lnInicio,LEN(tcParrafo)+1-lnInicio)
tbBloques = .T.
RETURN @taBloques
ENDPROC

*-- Ejecuta el proceso de justificado del texto separado en bloques o texto
único regresado por el método separa().
PROCEDURE dojustify
LPARAMETERS tcTextoJustificar,tnLongJustificado
LOCAL lgBloques,lbBloques
This.Separa(tcTextoJustificar,@lgBloques,@lbBloques)
IF lbBloques && Se ha partido el exto en bloques
FOR lnCont = 1 TO ALEN(lgBloques)
This.ctextoacumulado = ""
This.Justificar(lgBloques(lnCont),tnLongJustificado)
TEXT
<<This.ctextoacumulado>>
ENDTEXT
ENDFOR
ELSE
This.ctextoacumulado = ""
This.Justificar(lgBloques,tnLongJustificado)
TEXT
<<This.ctextoacumulado>>
ENDTEXT
ENDIF
RETURN
ENDPROC

*-- Método recursivo que justifica párrafo por párrafo según la longitud de
caracteres que se le indique.
PROCEDURE justificar
LPARAMETERS tcTexto,tnTamaño
IF EMPTY(SUBSTR(tcTexto,tnTamaño,1))
lcTextoJ = ALLTRIM(SUBSTR(tcTexto,1,tnTamaño-1))
IF EMPTY(lcTextoJ)
RETURN
ENDIF
tcTextoAlterno = SUBSTR(tcTexto,tnTamaño+1,LEN(tcTexto))
IF !EMPTY(tcTextoAlterno)
lcTextoAcumular = This.rellena(lcTextoJ,tnTamaño)
This.ctextoacumulado = This.ctextoacumulado + lcTextoAcumular + CHR(13)
tcTexto = SUBSTR(tcTexto,tnTamaño+1,LEN(tcTexto))
This.justificar(tcTexto,tnTamaño)
ELSE
lcTextoAcumular = lcTextoJ
This.ctextoacumulado = This.ctextoacumulado + lcTextoAcumular + CHR(13)
tcTexto = SUBSTR(tcTexto,tnTamaño+1,LEN(tcTexto))
This.justificar(tcTexto,tnTamaño)
ENDIF
ELSE
lcChar = SUBSTR(tcTexto,tnTamaño,1)
lnContador = tnTamaño
DO WHILE !EMPTY(lcChar)
lnContador = lnContador - 1
lcChar = SUBSTR(tcTexto,lnContador,1)
ENDDO
lcTextoJ = ALLTRIM(SUBSTR(tcTexto,1,lnContador))
tcTextoAlterno = SUBSTR(tcTexto,tnTamaño+1,LEN(tcTexto))
IF !EMPTY(tcTextoAlterno)
lcTextoAcumular = This.rellena(lcTextoJ,tnTamaño)
This.ctextoacumulado = This.ctextoacumulado + lcTextoAcumular + CHR(13)
tcTexto = SUBSTR(tcTexto,lnContador+1,LEN(tcTexto))
This.justificar(tcTexto,tnTamaño)
ELSE
lcTextoAcumular = lcTextoJ
This.ctextoacumulado = This.ctextoacumulado + lcTextoAcumular + CHR(13)
tcTexto = SUBSTR(tcTexto,lnContador+1,LEN(tcTexto))
This.justificar(tcTexto,tnTamaño)
ENDIF
ENDIF
ENDPROC

*-- Rellena el párrafo cortado por el método justificar() con el número de
espacios correspondientes para crear un parrafo de la longitud deseada.
PROCEDURE rellena
LPARAMETERS tcParrafo,tnLong
IF LEN(tcParrafo) = tnLong
RETURN tcParrafo
ENDIF
lnDimension = 0
lcPalabra = ""
FOR i = 1 TO LEN(tcParrafo)
IF ASC(SUBSTR(tcParrafo,i,1)) = 32
lnDimension = lnDimension + 1
DIMENSION laEspacios(lnDimension)
laEspacios(lnDimension) = i
ENDIF
ENDFOR
IF VARTYPE(laEspacios) = "U"
RETURN tcParrafo
ENDIF
lnInicio = 1
FOR k = 1 TO ALEN(laEspacios)
DIMENSION laPalabras(k)
laPalabras(k) = SUBSTR(tcParrafo,lnInicio,laEspacios(k)-lnInicio)
lnInicio = laEspacios(k)+1
ENDFOR
DIMENSION laPalabras(k)
laPalabras(k) = SUBSTR(tcParrafo,lnInicio,LEN(tcParrafo)+1-lnInicio)

lnTotalEspacios = tnLong - LEN(tcParrafo)
lnEspaciosContados = 0
DO WHILE !EMPTY(lnTotalEspacios)
FOR l = 1 TO ALEN(laPalabras)-1
laPalabras(l) = laPalabras(l) + " "
lnTotalEspacios = lnTotalEspacios - 1
IF EMPTY(lnTotalEspacios)
EXIT
ENDIF
ENDFOR
ENDDO
lcParrafoFormateado = ""
lcParrafoFormateado = laPalabras(1)
FOR j = 2 TO ALEN(laPalabras)
lcParrafoFormateado = lcParrafoFormateado + " " + laPalabras(j)
ENDFOR
RETURN lcParrafoFormateado
ENDPROC

*-- Activa la configuración de salida del texto justificado.
PROCEDURE set_textmerge_on
SET TEXTMERGE TO (This.csalidatexto) NOSHOW
SET TEXTMERGE ON
ENDPROC

*-- Desactiva la configuración de salida del texto justificado.
PROCEDURE set_textmerge_off
SET TEXTMERGE TO
SET TEXTMERGE OFF
ENDPROC

[Luis María Guayán]

Muy bien Oscar, ¿Lo podrias enviar a PortalFox para que lo publiquemos?

Para enviar una noticia a PortalFox debes ira a http://www.portalfox.com ->
Menu -> Colabora -> Enviar noticia

o si nos das tu autorización y nombre de usuario de PortalFox lo añadimos
nosotros.

--
Luis María Guayán
Tucumán, Argentina
________________________________
SysOp de www.PortalFox.com
Microsoft Visual FoxPro MVP
________________________________
La palabra imposible solo figura
en el diccionario de los tontos

"Oscar Gonzalez Hernandez" <skywa...@hotmail.com> escribió en el mensaje
news:O23t5Y16...@TK2MSFTNGP11.phx.gbl...

[Fernando D. Bozzo]

Hola Oscar:

Es posible que no hayas visto la respuesta que te dí en su momento, pero yo
mandé a PortalFox hace algunos meses una rutina que justifica texto en
controles editbox con cualquier fuente y tamaño, que con letra courier new
se puede hacer lo mismo en impresora.

Saludos,

Fernando D. Bozzo

"Oscar Gonzalez Hernandez" <skywa...@hotmail.com> escribió en el mensaje
news:O23t5Y16...@TK2MSFTNGP11.phx.gbl...

[Oscar Gonzalez Hernandez]

Pos supuesto que me gustaria que lo publicaran en PotalFox y aqui mis datos

Nombre de usuario: OSCAR_GLEZ
Correo: the_moonw...@yahoo.com

Fernando, tienes razon, talvex no vi la respuesta que me enviaste pero una
vez más, si no es mucho pedir me la puedes enviar al correo que esta unas
lineas arriba?

Gracias a todos.
Bye

-----------------------------------------------
PortalFox :: Nada corre como un zorro
http://www.portalfox.com

PortalFox - NNTP Forum Gateway
-----------------------------------------------

[Fernando D. Bozzo]

Enviado!

"Oscar Gonzalez Hernandez" <skywa...@hotmail.com> escribió en el mensaje

news:u4FzEuA7...@TK2MSFTNGP12.phx.gbl...

[Luis María Guayán]

El Archivo al que hace referencia Fernando esta para la descarga en
PortalFox:

-- Justificar EditBox --
Autor: Fernando D. Bozzo
http://www.portalfox.com/modules.php?op=modload&name=Downloads&file=index&req=viewdownloaddetails&lid=180&ttitle=Justificar_EditBox

--
Luis María Guayán
Tucumán, Argentina
________________________________
SysOp de www.PortalFox.com
Microsoft Visual FoxPro MVP
________________________________
La palabra imposible solo figura
en el diccionario de los tontos

"Fernando D. Bozzo" <fdb...@lycos.es> escribió en el mensaje
news:estooTA7...@TK2MSFTNGP12.phx.gbl...