Hola a todos,
Antes de nada muchas gracias por los aportes, he podido solucionar mi problema (lo estaba haciendo mal).
Esto lo ha aplicado a la clase TImprime de The Full (perdona, no te he pedido permiso).
El caso es que ahora con esta clase puedo imprimir párrafos justificados con/sin salto de línea intercalado con tipos de letra proporcional.
He realizado estos cambios:
12/05/2024 C.Gelabert
+ Agefit METHOD AnchoText( cText,oFont ) per saber l'amplada d'un text en base a la oFont (de oPrinter)
Útil per poder justificar amb tipus de lletra proporcional.
És igual al METHOD AnchoMayor( cText,oFont ) de UTILPRN.PRG
* Canviat nom de METHOD MEMO (original de la clase) a METHOD MEMO_20011212
+ Afegit nou METHOD MEMO per indicar si es vol justificar el text i l'amplada en centímetres.
* El METHOD MEMO permet justificar el text en una amplada en centímetres (per servir
per a tipus de lletra proporcional), permet traballar per defecte amb el METHOD MEMO_20011212 (original
de la clase).
METHOD MEMO treballa en nombre de caràcters ( nLine ), o en CENTÍMETRES ( nCm )(*).
(*) nCm debe ser mayor de 2 para usarse.
* Al UtilPrn.ch afegida possibilitat de JUSTIFY i centímetres pel MEMO.
#xcommand IMPRIME ;
MEMO <cText> ;
[ COL <nCol> ] ;
[ LINES <nLine> ];
[ FONT <oFont> ] ;
[ COLOR <nClrText> ];
[ SEPARATOR <nSeparator> ] ;
[ <lJump :JUMP> ];
[ <lJustify :JUSTIFY> ];
[ CM <nCm> ] ;
=>;
::MEMO( <nCol>, <cText>, <nLine>, <nSeparator>, <oFont>, <nClrText>, <.lJump.>, <.lJustify.>, <nCm> )
- Code: Select all Expand view
*******************************************************************************
METHOD MEMO( nCol, cText, nLine, nSeparator, oFont, nColor, lJump, lJustifica, nCm ) CLASS TIMPRIME
Local nLineas := 0
Local nLineastotal := 0
Local aTextLines := {}
Local nLenaTextLines := 0
Local nPoscText := 1
Local nDummy := 1
Local nEspais := 1
DEFAULT nLine := 60,;
nCol := 1,;
oFont := ::oFnt5,;
lJump := .F., ;
lJustifica := .F., ;
nCm := 2 // Podía haber indicado otro valor, me pareció adecuado.
IF Empty( cText )
Return NIL
ENDIF
IF lJump
::Separator( nSeparator )
ENDIF
// traza( 1, "lJustifica=", lJustifica )
If lJustifica .or. nCm > 2
If ::AnchoText( cText,oFont ) <= nCm
UTILPRN ::oUtil Self:nLinea,nCol SAY cText FONT oFont COLOR nColor
::Separator( nSeparator )
Else
AADD( aTextLines, "" )
nLenaTextLines := Len( aTextLines )
While nPoscText <= Len( RTrim( cText ) )
// CRLF Chr(13)+Chr(10)
// Els 2 següents caràcters són un salt de línia.
If AT( CRLF, SubStr( cText, nPosctext, 2 ) ) > 0
AADD( aTextLines, "" )
nLenaTextLines := Len( aTextLines )
nPosctext := nPosctext + 2
ElseIf AT( Chr(13), SubStr( cText, nPosctext, 1) ) > 0
AADD( aTextLines, "" )
nLenaTextLines := Len( aTextLines )
nPosctext := nPosctext + 1
ElseIf AT( Chr(10), SubStr( cText, nPosctext, 1) ) > 0
AADD( aTextLines, "" )
nLenaTextLines := Len( aTextLines )
nPosctext := nPosctext + 1
// Els 2 següents caràcters NO són un salt de línia.
Else
// Si afegeixo el següent caràcter superaré el límit del text.
If ( ::AnchoText( aTextLines[nLenaTextLines] + SubStr( cText, nPosctext, 1 ), oFont ) > nCm )
// Cerco el darrer espai de la cadena i així no parteixo paraules.
While Right( aTextLines[nLenaTextLines], 1 ) <> " "
aTextLines[nLenaTextLines] := SubStr( aTextLines[nLenaTextLines], 1, Len( aTextLines[nLenaTextLines] ) - 1 )
nPosctext := nPosctext - 1
End
If lJustifica
// Es justificarà el text afegin un espai a on hi hagi un altre, mentre no s'arribi al límit de la longitud establerta.
While ::AnchoText( aTextLines[nLenaTextLines], oFont ) < nCm
// Es recorre el text des del primer caràcter cercant espais en blanc,començant a cercar per 1 espai, 2 espais, 3 espais,...
While nDummy < Len( aTextLines[nLenaTextLines] )
// Es trova el espai en blanc a on s'inserirà un espai addicional.
If SubStr( aTextLines[nLenaTextLines], nDummy, nEspais ) = Space( nEspais )
aTextLines[nLenaTextLines] := Left( aTextLines[nLenaTextLines], nDummy ) + SubStr( aTextLines[nLenaTextLines], nDummy, Len( aTextLines[nLenaTextLines] ) )
nDummy++
If ::AnchoText( aTextLines[nLenaTextLines], oFont ) >= nCm
Exit
EndIf
// Estic al final de la línia, s'afegeix un espai al final i es tornarà a cercar més espais des del inici del text.
ElseIf Len( SubStr( aTextLines[nLenaTextLines], nDummy, nEspais ) ) < nEspais
aTextLines[nLenaTextLines] := aTextLines[nLenaTextLines] + " "
Exit
EndIf
nDummy++
End
nEspais++
nDummy := 1
End
EndIf
AADD( aTextLines, "" )
nLenaTextLines := Len( aTextLines )
// Si afegeixo el següent caràcter NO superaré el límit.
Else
aTextLines[nLenaTextLines] := aTextLines[nLenaTextLines] + SubStr( cText, nPosctext, 1 )
nPosctext := nPosctext + 1
EndIf
EndIf
End
nLineastotal := Len( aTextLines )
FOR nLineas := 1 TO nLineastotal
UTILPRN ::oUtil Self:nLinea,nCol SAY aTextLines[nLineas] FONT oFont COLOR nColor
::Separator( nSeparator )
NEXT
EndIf
Else
::MEMO_20011212( nCol,cText,nLine,nSeparator,oFont,nColor,lJump )
EndIf
Return NIL
*******************************************************************************
Seguro que se puede mejorar, a mi ya me vale así.
Muchas gracias,