Justificar el texto de un memo, listbox, etc

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;

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.