Fórum Justificar o texto do Memo ou Rich. #182597

Prezado amigo:
Desvendo o caminho das pedras:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Memo2: TMemo;
Button1: TButton;
Edit1: TEdit;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}



function SubstituiCaractere (vString, vStr1, vStr2 : string) : string;
begin
while Pos(vStr1, vString) <> 0 do
vString := Copy(vString, 1, Pos(vStr1, vString)-1)+vStr2+
Copy(vString, Pos(vStr1, vString)+Length(vStr1), Length(vString)-(Pos(vStr1, vString)+Length(vStr1)-1));
Result := vString
end; { SubstituiCaractere }
//
function PadR (Cadeia : string; Tamanho : integer; Caractere : string) : string;
begin
while Length(Cadeia) < Tamanho do
Cadeia := Cadeia + Caractere;
Result := Copy(Cadeia, 1, Tamanho)
end; { PadR }
//
function Alltrim (Cadeia : string) : string;
var Inicio, Fim : integer;
begin
Inicio := 1;
while (Copy(Cadeia, Inicio, 1) = ´ ´) and (Inicio < Length(Cadeia)) do
Inc(Inicio);
Fim := Length(Cadeia);
while (Copy(Cadeia, Fim, 1) = ´ ´) and (Fim > Inicio) do
Dec(Fim);
Result := Copy(Cadeia, Inicio, Fim-Inicio+1)
end; { Alltrim }



function JstString (StringInicial : string; TamanhoFinal : byte) : string;
var
AUXString : string;
TamanhoAUXString ,
i : byte;
begin
AUXString := Alltrim(StringInicial);
AUXString := SubstituiCaractere(AUXString, ´ ´, ´ ´);
TamanhoAUXString := Length(AUXString);
i := TamanhoAUXString;
while (TamanhoAUXString < TamanhoFinal) and (Pos(´ ´, AUXString)<>0) do
begin
while (Copy(AUXString, i, 1) <> ´ ´) and (i > 0) do
Dec(i);
if i > 0 then
begin
AUXString := Copy(AUXString, 1, i-1)+´ ´+Copy(AUXString, i, TamanhoAUXString+1);
Inc(TamanhoAUXString)
end; { if }
while (Copy(AUXString, i, 1) = ´ ´) and (i > 0) do
Dec(i);
if i = 0 then
i := TamanhoAUXString
end; { while }
Result := AUXString
end; { JstString }
//
function JstParagrafo (Paragrafo : string; Largura : word) : string;
var Inicio, Fim : word;
begin
if Largura = 0 then
Largura := 1;
Paragrafo := Alltrim(Paragrafo);
Paragrafo := SubstituiCaractere(Paragrafo, #10, ´´);
Paragrafo := SubstituiCaractere(Paragrafo, 13, ´´);
Paragrafo := SubstituiCaractere(Paragrafo, ´ ´, ´ ´);
Inicio := 1;
Result := ´´;
while Inicio <= Length(Paragrafo) do begin
while (Inicio <= Length(Paragrafo)) and (Copy(Paragrafo, Inicio, 1) = ´ ´) do
Inc(Inicio);
Fim := Inicio + Largura; // -1;
if Fim <= Length(Paragrafo) then
begin
while (Fim > Inicio) and (Copy(Paragrafo, Fim, 1) <> ´ ´) do
Dec(Fim);
while (Fim > Inicio) and (Copy(Paragrafo, Fim, 1) = ´ ´) do
Dec(Fim);
if Fim = Inicio then
Fim := Inicio + Largura-1
end; { if }
if Fim >= Length(Paragrafo) then
Result := Result + PadR(Alltrim(Copy(Paragrafo, Inicio, Fim-Inicio+1)), Largura, ´ ´)
else
Result := Result + Alltrim(JstString(Copy(Paragrafo, Inicio, Fim-Inicio+1), Largura)) + #13+10;
Inicio := Fim+1
end { while }
end; { JstParagrafo }



procedure TForm1.Button1Click(Sender: TObject);
begin
Memo2.Text := JstParagrafo(Memo1.Text, StrToInt(Edit1.Text))
end;



procedure TForm1.Edit1Change(Sender: TObject);
begin

end;

end.


Todo o código está ai, testado e funcional.
MMTOOR2003