Justificar el texto de un memo, listbox, etc

Por Saiyine el 2006-02-21 20:07:00 - Secciones: DELPHI - Enlace permanente: 481

procedure Justifica(cadenas : tstrings; fuente : TFont; ancho : integer);
var
i : integer;
aux : string;
begin
  for i:=0 to cadenas.count-1 do
  while Distancia(LargoTexto(cadenas[i],fuente),ancho)>10 do
  begin
    aux:=cadenas[i];
    Insert(' ',aux,MenorEspacioEntrePalabras(aux));
    cadenas[i]:=aux;
  end;
end;

Este procedimiento se podria usar asi:

procedure TForm1.Button1Click(Sender: TObject);
begin
Justifica(ListBox1.Items,ListBox1.font,ListBox1.width);
end;

Y llama a las siguientes funciones:

function MenorEspacioEntrePalabras(cad : string) : integer;
var
menor,actual,i : integer;
enespacio : boolean;
begin
  actual:=0;
  menor:=50;
  result:=0;
  enespacio:=false;
  for i:=1 to length(cad) do
  begin
    if cad[i]=' ' then
    begin
      if enespacio
      then actual:=actual+1
      else
      begin
        enespacio:=true;
        actual:=1;
      end;
    end
    else
    if enespacio then
    begin
      enespacio:=false;
      if actual<menor then
      begin
        menor:=actual;
        result:=i-actual;
        actual:=0;
      end;
    end;
  end;
end;

function LargoTexto(texto : string; f : TFont) : integer;
var
aux : TFont;
begin
  aux:=Screen.ActiveForm.Canvas.font;
  Screen.ActiveForm.Canvas.font:=f;
  result:=Screen.ActiveForm.Canvas.textwidth(texto);
  Screen.ActiveForm.Canvas.font:=aux;
end;

function Distancia(a,b : integer) : integer;
begin
  result:=abs(a-b);
end;

Otras entradas de la web que podrian interesarte:

(441) ene 01 DELPHI Borrar un elemento de un listbox/combobox sabiendo el texto, usar indexof
(472) nov 30 DELPHI Dada una cadena con palabras y separadores, mostrar cada palabra en una linea de un memo
(495) nov 30 DELPHI Procedimiento que ordena una lista de cadenas (los lines de los richedit, meno, listbox, ...) usando el algoritmo de la burbuja
(466) nov 30 DELPHI Como imprimir texto
(432) ene 01 DELPHI Añadir lineas a un fichero de texto

200

Alfredo (2006-02-20 18:28:00)

En el truco de Justificar el texto de un memo, listbox, etc; la línea:

if actual<menor then

me da un error, como puedo subsanarlo.

Un saludo y gracias

203

Saiyine (2006-02-21 20:07:00)

Asegurate de que es realmente un simbolo de menor que (<) y no una etiqueta de html como '<'.

206

Alfredo (2006-02-22 08:25:00)

En el truco de Justificar el texto de un memo, listbox, etc; la línea:
for i:=0 to cadenas.count-1 do
prueba a poner:
for i:=0 to cadenas.count-2 do
ya que la última línea no tienes porque justificarla, se supone que ya está justificada a la izquierda.

Un saludo y de nuevo gracias

208

Saiyine (2006-02-22 23:10:00)

Tienes toda la razón, aunque te ha faltado un detalle para la matricula de honor: ¿y si el texto solo tiene una linea?

Entonces tendriamos un bucle que va desde cero hasta menos uno, es decir, un programa colgado. Necesitamos una comprobación previa al for, o quizás un condicional dentro del mismo bucle...

Nada, lo es mejor es comprobar la "sanidad" de la entrada antes de tocar el texto, y nos evitamos historias extrañas.

1588

ABGAME (2007-11-22 06:18:54)

Te felicito amigo, la implemente con muy buenos resultados. Gracias

1806

49ers (2008-02-07 06:48:30)

Felicidades Saiyine funciona perfecto men..buen aporte

2481

arturkaiser (2008-07-07 10:37:15)

Llevo una semana la manera de justificar un texto en quick report y tu código hace lo más cercano a lo que quiero, pero no es exacto el jutificado, de todas formas gracias, voya a ver si puedo mejorarlo.

3724

Lino (2009-09-10 05:03:10)

Hola que tal, prove tu rutina para justificar y esta muy bien
pero tengo un problema cuando la ejecuto y veo un preview me lo hace muy bien
pero al mandar a imprimir
me imprimne varias hojas y sin justificar
me podrias ayudar a resolver este problema
Gracias de antemano

5311

SUSY (2011-06-02 00:45:35)

Holaaa¡¡¡
Me sirvio mucho tu rutina, pero.. sabes, yo tengo que justificar el texto en el Power PDF, un objeto PRText, y no tiene la propiedad del Font, como tal.

Sabes como la puedo obtener...

Momentaneamente lo estoy haciendo pasando todo a un memo y que me regrese el texto con los espacios del justificado, y trato que la letra del memo y tel objeto que te menciono sean iguales, sabes como le puedo hacer??

Mil gracias

¡¡¡¡

5312

Saiyine (2011-06-02 01:11:56)

Prueba con la propiedad Align, con la que quizás puedas justificar el texto:

TPRText properties
property Align: TAlign;

5339

SUSY (2011-06-24 19:28:40)

Hola¡¡

Que cres ya lo cheque pero nada

solo viene la propiedad AlignJustified, para PRLabel...

5706

Alvareto (2012-05-18 00:35:36)

Buenas,
Lino... el procedimiento:
Justifica(ListBox1.Items,ListBox1.font,ListBox1.width);

lo ubicas también en el BeforePrint o AfterPrint del QuickRep, para que mejore al momento de Imprimir.

espero q t funcione

o o o o