ayúdame a justificar un campo memo en un reporte

[Elver M Salgado Gonzalez]

ayúdame a justificar un campo memo en un reporte

[Miguel A.]

Hola,

Según parece, para esto existe una clase del gran Cesar Chalom, te envío algunos enlaces:

https://groups.google.com/forum/#!msg/publicesvfoxpro/3CMoFmiwLCk/me9_kpk0EsIJ

http://microsoft.public.es.vfoxpro.narkive.com/3Jnu1ArA/justificacion-completa-con-gdiplus-x

Si consigues hacerlo funcionar sería de agradecer que colgaras aquí la solución, es posible que otras personas también deseen implantar algo similar en sus reports.

Saludos,

Miguel A.

[Víctor Hugo Espínola Domínguez]

Hola Miguel

Usando Foxypreviewer es muy fácil:

USE TuReporte.frx

LOCATE FOR UPPER(Expr) = "NOM_CAMPO_MEMO_A_JUSTIFICAR"

REPLACE User WITH "<FJ>" + User

USE

DO Foxypreviewer.app

REPORT FORM  TuReporte PREVIEW

Saludos,

Víctor.

Lambaré - Paraguay.

[Miguel A.]

Gracias Víctor,

No uso Foxypreviewer, pero tampoco lo descarto. ¿Tiene alguna ayuda? ¿es complicado implantarlo?.

Saludos,

Miguel A.

[Víctor Hugo Espínola Domínguez]

Hola Miguel

>No uso Foxypreviewer, pero tampoco lo descarto. ¿Tiene alguna ayuda?

Tiene buena documentación y ejemplos, puedes descargar desde: http://foxypreviewer.codeplex.com/

En esa página se describe otra forma de obtener la justificación de los campos memo.

>¿es complicado implantarlo?.

Simplemente se copia un archivo "Foxypreviewer.app" al directorio de tu proyecto.

Saludos,

Víctor.

Lambaré - Paraguay.

[HernanCano]

>¿es complicado implantarlo?.

Simplemente se copia un archivo "Foxypreviewer.app" al directorio de tu proyecto.

HCano agrega:

Y en tu programa agregas 

DO FOXYPREVIEWER

antes de imprimir algún reporte... o en el prg de inicio.

El miércoles, 4 de febrero de 2015, 15:02:27 (UTC-5), Víctor Hugo escribió:

Hola Miguel

[Miguel A.]

Muchas gracias

[Carton Jeston]

Usando foxtools.dll tambien se puede justificar sobre el editbox en tiempo real. Personalmente pienso que si es para un reporte, la mejor solucion es foxypreviewer tal y como te comentan los compañeros.

No me refiero porque justifique de un modo sencillo, sino porque a estas alturas foxypreviewer es un complemento indispensable para mejorar el fox, de hecho se ha hablado de excomulgar a quien no lo haga, revocando la licencia de foxpro y expulsando de todos los foros de fox :-)

En serio, adapta tu aplicacion a foxypreviewer y tu aplicacion parecera del siglo XXI, lo de justificar es solo la punta del iceberg.

JUSTIFICARTEXTO.PRG

*-- JUSTIFICACIÓN DE TEXTO EN EDITBOX

*-- Autor: Fernando D. Bozzo
*-- Email: fdbozzo@lycos.es
*-- Fecha: 09/04/2003
*-- Versión: 1.00
*-------------------------------------

*-- SINTAXIS: JustificarTexto(oEditBox [,lNoAsignarValor])

*-- Donde:
*-- oEditBox                Es la referencia del control EditBox donde justificar el texto.
*-- [lNoAsignarValor]        (opcional) Indica que NO se desea asignar la propiedad VALUE del control
*--                            con el texto justificado.
#INCLUDE "INCLUDE\FOXPRO.H"

LPARAMETERS toEditbox, tlNoAsignarValor
LOCAL lnCantPalabrasParrafo, lnAnchoMedioCaracter, lnPalabra, lcPalabra, lcPalabraActual, ;
    lnAnchoAcumulado, lnAnchoAnterior, lcTexto, lnAnchoSobrante, lnAnchoDecimal, lnEspacio, ;
    lcFontName, lnFontSize, lnAnchoMaximo, lcNuevoTexto, lnParrafos, lnParrafo, lcFontStyle, ;
    lnAnchoEspacio, lnEspaciosSobrantes, lnEspaciosEntrePalabras, lnEspacioResto, lnPal, lnLineas, ;
    lnPalabraActual, lnAnchoAcumuladoReal, lnAnchoAnteriorReal, lnAnchoPalabraPixels

LOCAL ARRAY laParrafos(1), laPalabrasLineaVisual(1), laEspacios(1), laLineas(1)

IF NOT "FOXTOOLS.FLL" $ SET("LIBRARY")
    IF FILE("FOXTOOLS.FLL")
        SET LIBRARY TO "FOXTOOLS.FLL" ADDITIVE
    ELSE
        =MESSAGEBOX("El método para justificar texto necesita la librería FOXTOOLS.FLL de Visual FoxPro", MB_OK + MB_ICONEXCLAMATION, PROGRAM())
        RETURN ""
    ENDIF
ENDIF

IF toEditbox.BASECLASS # "Editbox"
    =MESSAGEBOX("El método para justificar texto sólo es para controles EditBox!", MB_OK + MB_ICONEXCLAMATION, PROGRAM())
    RETURN ""
ENDIF

WITH toEditbox
    lcTexto = ALLTRIM(REDUCE(.VALUE, " "))
    lcFontName = .FONTNAME
    lnFontSize = .FONTSIZE
    lcFontStyle = Get_EstiloFuente(.FONTBOLD, .FONTITALIC, .FONTUNDERLINE, .FONTSTRIKETHRU)
    lnAnchoMaximo = .WIDTH - 2 - (.BORDERSTYLE * 2) - IIF(.BORDERSTYLE = 1 AND .SPECIALEFFECT = 0, 2, 0) - (.MARGIN * 2) - IIF(.SCROLLBARS = 0, 0, SYSMETRIC(5) + 1)
    lnParrafos = ALINES(laParrafos, lcTexto, .T.)
    lnLineas = 0

    *-- Ancho medio del caracter
    lnAnchoMedioCaracter = FONTMETRIC(6, lcFontName, lnFontSize, lcFontStyle)
    lnAnchoEspacio = TXTWIDTH(" ", lcFontName, lnFontSize, lcFontStyle) * lnAnchoMedioCaracter

    *-- Recorro los párrafos
    FOR lnParrafo = 1 TO lnParrafos
        *-- Verifico si es un párrafo vacío
        laParrafos(lnParrafo) = ALLTRIM(laParrafos(lnParrafo))
        IF EMPTY(laParrafos(lnParrafo))
            lnLineas = lnLineas + 1
            DECLARE laLineas(lnLineas)
            laLineas(lnLineas) = ""
        ELSE
            *-- Cantidad de Palabras
            lnCantPalabrasParrafo = WORDS(laParrafos(lnParrafo))
            lnPalabra = 1
            lcPalabraActual = ""

            *-- Recorro todas las palabras del párrafo
            DO WHILE lnPalabra <= lnCantPalabrasParrafo
                lnAnchoAcumulado = 0
                lnAnchoAnterior = 0
                lnAnchoAcumuladoReal = 0
                lnAnchoAnteriorReal = 0
                lcPalabra = ""
                lnPalabraActual = 0

                FOR lnPalabra = lnPalabra TO lnCantPalabrasParrafo
                    lnPalabraActual = lnPalabraActual + 1
                    lnAnchoAnterior = lnAnchoAcumulado
                    lnAnchoAnteriorReal = lnAnchoAcumuladoReal
                    lcPalabraActual = WORDNUM(laParrafos(lnParrafo), lnPalabra, " ")
                    DECLARE laPalabrasLineaVisual(lnPalabraActual)
                    laPalabrasLineaVisual(lnPalabraActual) = lcPalabraActual
                    *lcPalabraActual = WORDNUM(laParrafos(lnParrafo), lnPalabra, " ")
                    lnAnchoPalabraPixels = TXTWIDTH(lcPalabraActual, lcFontName, lnFontSize, lcFontStyle) * lnAnchoMedioCaracter
                    lnAnchoAcumuladoReal = lnAnchoAcumuladoReal + lnAnchoPalabraPixels
                    lnAnchoAcumulado = lnAnchoAcumulado + lnAnchoPalabraPixels + lnAnchoEspacio

                    IF (lnAnchoAcumulado - lnAnchoEspacio) > lnAnchoMaximo
                        lnPalabraActual = lnPalabraActual - 1
                        lnPalabra = lnPalabra - 1
                        lnLineas = lnLineas + 1
                        DECLARE laLineas(lnLineas)
                        laLineas(lnLineas) = ""
                        *-- Calculo espacio sobrante en forma de 'espacios'
                        lnEspaciosSobrantes = INT((lnAnchoMaximo - lnAnchoAnteriorReal) / lnAnchoEspacio)
                        *-- Calculo cantidad de espacios entre palabras
                        lnEspaciosEntrePalabras = INT(lnEspaciosSobrantes / (lnPalabraActual - 1))
                        *-- Calculo espacios sobrantes
                        lnEspacioResto = lnEspaciosSobrantes - lnEspaciosEntrePalabras * (lnPalabraActual - 1)
                        *-- Distribuyo el espacio restante
                        DECLARE laEspacios(lnPalabraActual)
                        laEspacios = SPACE(lnEspaciosEntrePalabras)
                        FOR lnEspacio = 1 TO lnEspacioResto
                            laEspacios(lnEspacio) = laEspacios(lnEspacio) + " "
                        ENDFOR
                        *-- Formo la línea visual
                        FOR lnPal = 1 TO lnPalabraActual
                            lcPalabra = laPalabrasLineaVisual(lnPal)
                            laLineas(lnLineas) = laLineas(lnLineas) + lcPalabra + laEspacios(lnPal)
                        ENDFOR
                        laLineas(lnLineas) = RTRIM(laLineas(lnLineas)) + " "
                        *-- Especifico la próxima palabra donde comenzar
                        lnPalabra = lnPalabra + 1
                        DECLARE laPalabrasLineaVisual(1)
                        laPalabrasLineaVisual(1) = ""
                        EXIT
                    ENDIF
                ENDFOR
            ENDDO

            *-- Agrego en una nueva línea las palabras sobrantes
            IF NOT EMPTY(laPalabrasLineaVisual(1))
                lnLineas = lnLineas + 1
                DECLARE laLineas(lnLineas)
                laLineas(lnLineas) = ""

                FOR lnPal = 1 TO ALEN(laPalabrasLineaVisual, 1)
                    lcPalabra = laPalabrasLineaVisual(lnPal)
                    laLineas(lnLineas) = laLineas(lnLineas) + lcPalabra + SPACE(1)
                ENDFOR
            ENDIF
            laLineas(lnLineas) = RTRIM(laLineas(lnLineas)) + CHR(13) + CHR(10)
        ENDIF
    ENDFOR
   
    *-- Con el array de líneas obtenido genero un nuevo texto
    lcNuevoTexto = ""
    FOR lnLinea = 1 TO lnLineas
        lcNuevoTexto = lcNuevoTexto + IIF(EMPTY(laLineas(lnLinea)), CHR(13) + CHR(10), laLineas(lnLinea))
    ENDFOR
    lcNuevoTexto = RTRIM(lcNuevoTexto)
   
    IF NOT tlNoAsignarValor
        .VALUE = lcNuevoTexto
    ENDIF
    .ALIGNMENT = 0
    RETURN lcNuevoTexto
ENDWITH




*-- LIBRERÍA DE COMANDOS Y FUNCIONES REFERIDAS A FUENTES DE LETRA
FUNCTION Get_EstiloFuente(tlFontBold, tlFontItalic, tlFontUnderline, tlFontStrikeThru)
    *-- Devuelve un código de Estilo de Fuente para uso de FONTMETRIC u otras
    *-- funciones que requieren este tipo de código.
    *-- PARAMETROS:
    *-- tlFontBold            Referencia de Objeto del control de edición o letra Negrita
    *-- tlFontItalic        Si tlFontBold indica letra Negrita, indica letra Itálica (Cursiva)
    *-- tlFontUnderline        Si tlFontBold indica letra Negrita, indica letra Subrayada
    *-- tlFontStrikeThru    Si tlFontBold indica letra Negrita, indica letra Tachada
    LOCAL ;
        lcEstilo, ;
        llFontBold, ;
        llFontItalic, ;
        llFontUnderline, ;
        llFontStrikeThru
   
    lcEstilo = ""

    DO CASE
    CASE PCOUNT() = 0
        =MESSAGEBOX("No se indicaron parámetros", MB_OK + MB_ICONEXCLAMATION, PROGRAM())

    CASE VARTYPE(tlFontBold) = "O" AND NOT PEMSTATUS(tlFontBold, "FONTNAME", 5)
        =MESSAGEBOX("El objeto indicado no es un control de Edición de datos", MB_OK + MB_ICONEXCLAMATION, PROGRAM())

    CASE VARTYPE(tlFontBold) = "O"
        *-- Se indicó un Objeto
        llFontBold            = tlFontBold.FONTBOLD
        llFontItalic        = tlFontBold.FONTITALIC
        llFontUnderline        = tlFontBold.FONTUNDERLINE
        llFontStrikeThru    = tlFontBold.FONTSTRIKETHRU
    OTHERWISE
        *-- Se indicó un Nombre de Fuente
        llFontBold            = tlFontBold
        llFontItalic        = tlFontItalic
        llFontUnderline        = tlFontUnderline
        llFontStrikeThru    = tlFontStrikeThru
    ENDCASE
    lcEstilo    = lcEstilo + IIF(llFontBold, "B", "")
    lcEstilo    = lcEstilo + IIF(llFontItalic, "I", "N")
    lcEstilo    = lcEstilo + IIF(llFontUnderline, "U", "")
    lcEstilo    = lcEstilo + IIF(llFontStrikeThru, "-", "")
   
    RETURN lcEstilo
ENDFUNC

[Carton Jeston]

P.D. No estaria mal adaptar esta funcion para ser 100% foxpro sin dependencias de dll externas.

[Edwind Cruz]

Aquí mi aporte como posible solución, espero sea de utilidad:

***RUTINA JUSTIFICAR TEXTO

Function JUST_TOT()

Lparameter cadena, long_lin, fuente, altura

** Funcion para justificar izquierda y derecha de un campo memo en reportes

** Ejemplos:

** just_tot(tabla.memo,100, "Courier New", 10)

** just_tot(texto,100, "Arial", 10)

**

** Tanto el font como el size seran los fijados en el campo del diseñador de informes

 

if LEN(cadena)=0 .or. parameters()<2

      return(cadena)

endif

Local n, LineaTexto, espacio, nlineas, i, nueva_cad, subCadena, u_caracter

cadena=Alltrim(m.cadena)

SET MEMOWIDTH to m.long_lin

nlineas = MEMLINES(cadena)

nueva_cad=""

_MLine = 0

For i=1 to nlineas

subCadena=alltrim(MLine(cadena, 1, _MLine))

u_caracter=subs(subcadena,len(subcadena),1)

if  m.i<m.nlineas .and. (ISALPHA(m.u_caracter) .or. m.u_caracter # ".")

n=1

do while TxtWidth(m.subCadena,fuente, altura)<= m.long_lin;

.and. AT(chr(32),m.subcadena)>0

    if substr(subCadena, LEN(subCadena)-n,1)=space(1)

     subcadena = STUFF(subCadena, LEN(subCadena)-n,0,space(1))

        n=n+1

     endif

     n=IIF(n>=LEN(subCadena),1,n+1)

enddo

endif

nueva_cad=nueva_cad+subcadena+chr(13)

ENDFOR

return(m.nueva_cad)

endfunc

_______________________________________________________