A dica se aplica quando se usa uma fonte VGA, ou seja, uma fonte onde cada caractere ocupa o mesmo espaço, como "Courier" e "MS Serif".

Segue abaixo a função:

function Justifica(const texto: TStringList; Colunas: integer): TStringList;
var
  Tamanho, x, y, z: Integer;
  Lista: TStringList;
  LinhaCompleta, Inicio, Resto: String;
begin
  Lista := TStringList.Create;
  for x := 0 to Texto.Count - 1 do
  begin
    // Substitui tab por tres espaços
    while Pos(''#9'', Texto.Strings[x]) > 0 do
      Texto.Strings[x] := Copy(Texto.Strings[x], 1,
        Pos(''#9'', Texto.Strings[x]) - 1) +
        ' ' + Copy(Texto.Strings[x], Pos(''#9'', Texto.Strings[x]) + 1,
        Length(Texto.Strings[x]));
    // a última coluna é um espaço
    if Length(TrimRight(Texto.Strings[x])) <= Colunas then
      Lista.Add(TrimRight(Texto.Strings[x]))
    else
    begin
      if Copy(Texto.Strings[x], 1, Colunas + 1) = ' ' then
        Lista.Add(Copy(Texto.Strings[x], 1, Colunas))
      else
      begin
        LinhaCompleta := Texto.Strings[x];
        y := Colunas;
        while (LinhaCompleta <> '') do
        begin
          for y := Colunas downto 1 do
          begin
            Inicio := Copy(LinhaCompleta, 1, y);
            Resto := Copy(LinhaCompleta, y + 1, Length(LinhaCompleta));
            if (Inicio= '') then
              break
            else if Length(TrimRight(LinhaCompleta)) <= Colunas then
            begin
              Lista.Add(TrimRight(Inicio));
              LinhaCompleta := '';
              break;
            end
            else if (Inicio[y] = ' ') then
            begin
              if Inicio <> '' then
              begin
                Inicio := TrimRight(Inicio);
                // justifica o texto
                while Length(Inicio) < Colunas do
                begin
                  if Inicio = '' then
                    break;
                  Tamanho := Length(Inicio);
                  for z := Tamanho downto 1 do
                  begin
                    if inicio[z] = ' ' then
                    begin
                      Inicio := (Copy(Inicio, 1, z) + ' ' +
                         Copy(Inicio, z + 1, Length(Inicio)));
                      if (Length(Inicio) = Colunas) then
                        break;
                    end
                    else if (Pos(' ', Inicio) = 0)then
                    begin
                      Lista.Add(TrimRight(Inicio));
                      Inicio := '';
                      break;
                    end;
                  end;
                end;
                Lista.Add(TrimRight(Inicio));
                LinhaCompleta := Resto;
                break;
              end
              else
                Break;
            end;
          end;
          if LinhaCompleta <> Resto then
            LinhaCompleta := Resto;
        end;
      end;
    end;
  end;
  Result := Lista;
end;

Para testar, adicione 2 Memos e um Button. Em ambos os Memos, desative a propriedade WordWrap, para que ele não quebre as linhas automaticamente. Em seguida, no evento onClick do Button, faça:

  Memo2.Lines := Justifica(TStringList(Memo1.Lines), 48);

Segue abaixo um exemplo de como fica o resultado.

Figura 1 - Exemplo de resultado da função

Até mais!

Por: michelle_araujo
Contato: michelle_araujo@click21.com.br