Impresión de campos memos con clase Tprinter

[dobfivewin]

Amigos del Foros

Nuevamente con este tema, ya que no puedo encontrar el Problema de porque no me justifica la Impresión...

Esta es la Funcion que Uso.....

Code: Select all  Expand view

* cTxt  = Texto a Imprimir
* oPrn
* nRow  = Linea
* nCol  = Columna
* nWid  = Tope de Columa a la Derecha
* oFont = Letra
* nSkp  = Tamaño de Salto de Linea
* nClr  =

FUNCTION Imp_MemoW(cTxt,oPrn,nRow,nCol,nWid,oFont,nSkp,nClr)

local cLin        ,;
      lCont:=.T.  ,;
      nP:=0       ,;
      lNext       ,;
      cC          ,;
      nW

DEFAULT nSkp:=0.4, nClr:=0

cTxt := Alltrim(cTxt)
nW   := nWid-0.2
nRow-=nSkp

oPrn:Cmtr2Pix(0,@nWid)

WHILE lCont              // un desmadre para separar
  cLin  := cC := ""      // y justificar los memos!!
  lNext := .T.

  WHILE oPrn:GetTextWidth(cLin,oFont)<nWid ;
       .AND. nP<=Len(cTxt) .AND. lNext
    nP++
    cC:=Substr(cTxt,nP,1)
    IF Asc(cC)<>13
      cLin+=cC
    ELSE
       nP++
       lNext:=.F.
    ENDIF
  ENDDO

  IF Asc(cC)<>13 .AND. Asc(cC)<>0
    cC:=Substr(cTxt,nP+1,1)
    IF " "$cLin .AND. cC<>" "
      WHILE cC<>" " .AND. Len(cLin)>0
        cLin:=Substr(cLin,1,Len(cLin)-1)
        cC:=Right(cLin,1)
        nP--
      ENDDO
    ELSE
      cLin:=Substr(cLin,1,Len(cLin)-2)+"-"
      cC:=Right(cLin,1)
      nP-=2
    ENDIF
    oPrn:CmSay(nRow+=nSkp,nCol,Alltrim(cLin),oFont,nW,nClr,,3)
  ELSE
    oPrn:CmSay(nRow+=nSkp,nCol,Alltrim(cLin),oFont,,nClr)
  ENDIF
  IF nP>=Len(cTxt)
    lCont:=.F.
  ENDIF
ENDDO
RETURN (nRow)

y la llamo así

Code: Select all  Expand view

        line :=  Imp_MemoW((ECOINTE)->V_TEXT ,;
                            oPrn ,;
                            line ,;
                            If((ECOINMO)->IMP_IMDE==0 , 5.5 , 2+Espacio) ,;
                            19 ,;
                            oFont2 ,;
                            0.5)

(ECOINTE)->V_TEXT es la variable o campo MEMO.

Desde Ya muchas gracias...

Saludos

David
Argentina

[Alfredo Arteaga]

Esa función no trabaja sola, ahí solo se hace la separación de la cadena a imprimir.

Para la distribución debe agregarse esté código en la clase TPrinter, METOD Say()

Code: Select all  Expand view

 
   IF nWidth > 0 .AND. oFont != Nil              // AAL 20/05/2002
        cText:=Alltrim(cText)
        DO WHILE ::GetTextWidth( cText, oFont ) > nWidth
           IF   nPad == PAD_RIGHT
              cText:=Substr(cText,2,Len(cText))
           ELSE
              cText:=Substr(cText,1,Len(cText)-1)
           ENDIF
        ENDDO
        IF nPad=PAD_BOTH .AND. " "$cText  // Justificado a ambos lados -> #define PAD_BOTH          3
           nP:=1
           DO WHILE ::GetTextWidth( cText, oFont ) < nWidth
              FOR nI=nP TO Len(cText)
                 nP++
                 cC:=SubStr(cText,nI,1)
                 IF cC=" "
                    cText:=Substr(cText,1,nI)+Substr(cText,nI,Len(cText))
                    nI:=Len(cText)+1
                    nP++
                 ENDIF
              NEXT nI
              IF nP>=Len(cText)-1
                 nP:=1
              ENDIF
           ENDDO
        ENDIF
   ENDIF
 

[dobfivewin]

Estimado Alfredo

Ante todo muchas gracias por turespuesta...

Te comento que esa correccion ya la habia hecho y el problema que me generaba un renglon un blanco cuando tenia que imprimir el renglon justificado.

Testeando ese agregado encontré que cuando entra acá:

Code: Select all  Expand view

       DO WHILE ::GetTextWidth( cText, oFont ) > nWidth
           IF   nPad == PAD_RIGHT
              cText:=Substr(cText,2,Len(cText))
           ELSE
              cText:=Substr(cText,1,Len(cText)-1)
           ENDIF
        ENDDO

en ese momento me deja la variable cText queda en blanco....

David
Argentina

[dobfivewin]

Hola de nuevo....

Otro dato que encontré

Aparentemente las variables

nWidth = viene en Centímetro
::GetTextWidth( cText, oFont ) = trae en pixel

podrás ser?

David
argentina

[Alfredo Arteaga]

Enviame el texto o la tabla con el dato que pretendes imprimir, veré que puedo hacer.

[Francisco Horta]

dobfivewin,
a ver si te entendi
yo imprimo un campo memo asi con tprinter:

cLeyen := Alltrim(Mi_campo_MEMO)
IF !Empty(cLeyen)
nLines := MLCOUNT(Mi_campo_MEMO,39) // ssco cuantas lineas tiene el campo memo con unalongitud de 39, (esa tu la puedes cambiar)
FOR x := 1 TO nLines
nRow += 0.4
oPrn:CmSay( nRow,0, MEMOLINE(Mi_campo_MEMO,39,x))
NEXT
ENDIF

espero sea lo que buscas
salu2
paco

[dobfivewin]

Estimado Paco

De esa forma que me sugeris, la justificacion del texto sale a la izquierda, y lo que necesito es que dicha justificacion sea en forma total, osea que el texto cubra tanto desde la izquierda como al final, a la derecha...

David

[antolin]

Esta funcion la utilizo para pasar memos a array (me va muy rapido):

Code: Select all  Expand view

FUNCTION ContLins(hDc,cTxt,hFnt,nAnch,nCuantos)
   LOCAL nCnt,nLong,nLins := 0
   LOCAL cTrozo,cRengl,cLins
   LOCAL aLins := {}

   DEFAULT nCuantos := 9999
   *
   FOR nCnt = 1 TO MLCOUNT(cTxt,254)
       cLins := ALLTRIM(MEMOLINE(cTxt,254,nCnt))
       DO WHILE !Empty(cLins) .AND. nCnt < nCuantos
      ++nLins
      IF GetTextWidth(hDc,cLins,hFnt) <= nAnch
         cRengl := ALLTRIM(cLins)
         cLins  := ""
      ELSE
         cRengl := ""
         cTrozo := StrToken(cLins,1)
         nLong  := GetTextWidth(hDc,cTrozo,hFnt)
         DO WHILE nLong <= nAnch .AND. !Empty(cTrozo)
        cRengl += cTrozo+" "
        cLins := LTRIM(STUFF(cLins,1,LEN(cTrozo),""))
        cTrozo:= StrToken(cLins,1)
        nLong := GetTextWidth(hDc,cRengl+cTrozo,hFnt)
         ENDDO
      ENDIF
      AADD(aLins,ALLTRIM(cRengl))
       ENDDO
   NEXT
   SysRefresh()
RETURN aLins

nAnch es el ancho en pixels del espacio en el que voy a imprmir.
nCuantos es el numero maximo de lineas que deseo imprimir (por si me hiciera falta)
hFnt es el handle del font que voy a utilizar

Como veras utilizo STRTOKEN pero si quieres lo puedes hacer caracter a caracter, en ese caso hago:

Code: Select all  Expand view

nLong := GetTextWidth(hDc,"B",hFnt)

Para saber cuanto mide una letra, asi el primer cacho no lo mido con el bucle DO WHILE sino que cojo directamete un trozo equivalente (nAnch/nLong)-1 antes de empezar a medir.

En MLCOUNT y MEMOLINE utilizo 254 porque es lo maximo que admite (creo que son 255, pero por si las moscas), pero tambien detecta los CRLF = CHR(13)+CHR(10). Es decir que separa los trozos de texto en cachos de 254 letras o hasta que encuentra un CRLF.

En cuanto a las alineaciones, yo lo hago asi:

DERECHA:
--------
cText := a la linea que voy a escribir.

Code: Select all  Expand view

oPrn:Say( X1,nAncho-oPrn:GetTextWidth( cText , oFont ),cText,oFont )

CENTRO
-------
cText := a la linea que voy a escribir.

Code: Select all  Expand view

oPrn:Say( X1,(nAncho-oPrn:GetTextWidth( cText , oFont ))/2,cText,oFont )

Espero que te sirva

Un saludo

[antolin]

Bueno, he cometido un pequeño fallo en el apartado justificación, he supuesto que nAnch toma todo el espacio disponible, cuando en realidad dejaras margenes a los lados.

Code: Select all  Expand view

nLMarg := Margen izquierdo
nRMarg := Margen derecho

Con lo cual nAnch := nRMarg - nLMarg + 1

Y por supuesto nAnch ya no sirve para justificar a la derecha, pero si nRMarg.
Las justificaciones quedarían así:

Code: Select all  Expand view

DERECHA:
---------
oPrn:Say( X1,nRMarg-oPrn:GetTextWidth( cText , oFont ),cText,oFont )

CENTRO
--------
oPrn:Say( X1,nLMarg+((nAncho-oPrn:GetTextWidth( cText , oFont ))/2),cText,oFont )

Perdona el error

Un saludo