Texto - justificando

// Este codigo justifica uma string (texto) com fonte normal TTF na form usando

// calculos com canvas. Para textos monospace olhe a outra dica.

type

  TForm1 = class(TForm)

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure FormPaint(Sender: TObject);

    procedure FormResize(Sender: TObject);

  private

    Lista : TStringList;

  end;

var

  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

begin

  Lista := TStringList.Create;

  Lista.LoadFromFile('texto');

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

  Lista.Free;

end;

procedure TForm1.FormPaint(Sender: TObject);

var

  i, IniPal, Quebras, TamY, PosY : Integer;

  Linha, Palavra : String;

begin

  i := 1;

  PosY := 0;

  // pega tamanho da linha

  TamY := Canvas.TextHeight('Wy');

  Linha := '';

  Quebras := 0;

  // modo de desenho transparente

  SetBkMode(Canvas.Handle,Transparent);

  With Lista do

    while i <= Length(Text) do

    begin

      // tira espaços iniciais e CR/LF

      while Text[i] in  [' ',#10,#13] do begin

        Inc(i);

        continue;

      end;

      IniPal := i;

      while (i <= Length(Text)) and not (Text[i] in [' ',#10,#13]) do Inc(i);

      // elimina espaços adicionados

      SetTextJustification(Canvas.Handle,0,0);

      Palavra := Copy(Text,IniPal,i-IniPal);

      // verifica se quebra linha

      if Canvas.TextWidth(Linha) + Canvas.TextWidth(Palavra)  > ClientWidth then

      begin

        // adiciona espaços à linha

        SetTextJustification(Canvas.Handle,ClientWidth-Canvas.TextWidth(Linha),Quebras);

        Canvas.TextOut(0,PosY,Linha);

        Linha := Palavra;

        Quebras := 0;

        // incrementa posição de desenho

        Inc(PosY,TamY);

        continue;

      end;

      if Linha <> '' then

        Linha := Linha + ' ' + Palavra

      else

        Linha := Palavra;

      // fim de Texto ou de Parágrafo - não justifica

      if (i > Length(Text)) or (Text[i] in [#10,#13]) then

      begin

        Canvas.TextOut(0,PosY,Linha);

        inc(PosY,TamY);

        Linha := '';

        Quebras := 0;

        if i > Length(Text) then

          break

        else

          continue;

      end;

      Inc(Quebras);

    end;

end;

procedure TForm1.FormResize(Sender: TObject);

begin

  Invalidate;

end;

end.