Memo - justificando monospace

Este código justifica um memo, desde que esteja com fontes monoespacadas

========================================================================

// Para textos que nao sao monospace existe outro metodo visto em outra

// dica 

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;

function PadR(Cadeia: string; Tamanho : integer; Caractere: string): string;

begin

  while Length(Cadeia) < Tamanho do Cadeia := Cadeia + Caractere;

  Result := Copy(Cadeia, 1, Tamanho)

end;

function JstString (StringInicial : string; TamanhoFinal : byte) : string;

var

  AUXString        : string;

  TamanhoAUXString ,

  i                : byte;

begin

  AUXString := Trim(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;

    while (Copy(AUXString, i, 1) = ' ') and (i > 0) do Dec(i);

    if i = 0 then i := TamanhoAUXString

  end;

  Result := AUXString

end;

function JstParagrafo (Paragrafo : string; Largura : word) : string;  var Inicio, Fim : word;

begin

  if Largura = 0 then Largura := 1;

  Paragrafo := Trim(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 Fim >= Length(Paragrafo) then

      Result := Result + PadR(Trim(Copy(Paragrafo, Inicio, Fim-Inicio+1)), Largura, ' ')

    else

      Result := Result + Trim(JstString(Copy(Paragrafo, Inicio, Fim-Inicio+1), Largura)) + #13+#10;

    Inicio := Fim + 1

  end

end;

// Para o teste, coloque 2 memos na tela junto com um Botao.

// No memo1 deixe a fonte normal no outro deixe a fonte mono (courier new)

procedure TForm1.Button1Click(Sender: TObject);

begin

  Memo2.Text := JstParagrafo(Memo1.Text, StrToInt(Edit1.Text))

end;

--------------------- OUTRO -------------------------

Justificar Texto

function Justifica(mCad:string;mMAx:integer):string;

var

mPos,mPont,mTam,mNr,mCont:integer;

mStr:string;

begin

mTam:=Length(mCad);

if mTam>=mMax then

Result:=copy(mCad,1,mMax)

else

mStr:='';

mCont:=0;

mPont:=1;

mNr:=mMax-mTam;

while mCont<mNr do

begin

mPos:=pos(mStr,copy(mCad,mPont,100));

if mPos=0 then

begin

mStr:=mStr+' ';

mPont:=1;

continue;

end

else

begin

mCont:=mCont+1;

Insert(' ',mCad,mPos+mPont);

mPont:=mPont+mPos+length(mStr);

end;

Result:=mCad;

end;

end;

EX.: 

Memo1.lines[i]:=(justifica(memo1.lines[i]{String},60 {Nº de caracteres possiveis da linha});