Justificar el texto de un memo, listbox, etc
2006-02-21 20:07:00
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;
Rollos antiguos
0000-00-00 00:00:00 - Filtrar entrada en los edit.
0000-00-00 00:00:00 - Hacer un mismo codigo para varios controles.
0000-00-00 00:00:00 - Hacer un edit con filtro, por ejemplo, que solo acepte numeros hexadecimales..
0000-00-00 00:00:00 - Filtrar la entrada de los edit.
0000-00-00 00:00:00 - Hacer que el programa espere un tiempo, como con el delay del turbo pascal.