Como exibir linhas longas em um ListBox sem a utilização da barra de rolamento

 

O ListBox não dá nenhuma possibilidade de exibir uma linha longa quebrada em várias linhas de exibição. Se houver uma linha longa, esta será invisível quando a barra de rolamento estiver habilitada. Com a ajuda de dois eventos do ListBox, é possível exibir linhas quebradas sem alterar o número de linhas totais. 

O ListBox nos dá a possibilidade de desenhar os itens. Existe também a possibilidade de fixar uma altura personalizada para cada item único. Para fazer isto, temos que configurar a propriedade Style, para lbOwnerDrawVariable. Utilizaremos dois eventos:

·         OnMeasureItem - que diz ao Delphi altura do item

·         OnDrawItem - para desenhar o item.

Agora poderemos exibir as linhas longas quebradas em mais de uma linha de exibição. Em primeiro lugar, é necessário obter o tamanho atual de quebra de linha. Em segundo lugar, o texto tem que ser desenhado na área do ListBox. Nem o item nem o número de itens do ListBox, devem ser alterados, ou seja, o resto do arquivo fonte não deve ser mudado.

Eis aqui o código:

 

type

  TWrapRecord = record

    Height: Integer;

    Lines: array of string;

  end;

 

function WrapText(Canvas:TCanvas; Text:string;

  const MaxWidth:integer):TWrapRecord;

var

  S: string;

  CurrWidth:integer;

begin

  SetLength(Result.Lines,0);

  Result.Height := 0;

  CurrWidth := MaxWidth;

  Text := Text+' ';

  repeat

    S := copy(Text, 1, pos(' ',Text)-1);

    Delete(Text, 1, pos(' ',Text));

    if (Canvas.TextWidth(S+' ')+CurrWidth) <= MaxWidth then

    begin

      with Result do

        Lines[High(Lines)] := Lines[High(Lines)] + ' ' +S;

      Inc(CurrWidth, Canvas.TextWidth(S+' '));

    end

    else

      with Result do

      begin

        if length(Lines) > 0 then

          Inc(Height,Canvas.TextHeight(Lines[High(Lines)]));

        SetLength(Lines,length(Lines)+1);

        Lines[High(Lines)] := S;

      CurrWidth := Canvas.TextWidth(S);

    end;

  until length(TrimRight(Text)) = 0;

  with Result do

    Inc(Height,Canvas.TextHeight(Lines[High(Lines)]));

end;

 

procedure TForm1.ListBoxMeasureItem(Control: TWinControl; Index: Integer;

  var Height: Integer);

var

  WrapRecord:TWrapRecord;

begin

  with Control as TListBox do

  begin

    Canvas.Font.Assign(Font);

    WrapRecord := WrapText(Canvas,Items[Index],ClientWidth);

    if WrapRecord.Height < ItemHeight then

      WrapRecord.Height := ItemHeight;

  end;

  Height := WrapRecord.Height;

end;

 

procedure TForm1.ListBoxDrawItem(Control: TWinControl; Index: Integer;

  Rect: TRect; State: TOwnerDrawState);

var

  WrapRecord: TWrapRecord;

  i,y: integer;

begin

  with Control as TListBox do

  begin

    Canvas.Font.Assign(Font);

    Canvas.FillRect(Rect);

    WrapRecord := WrapText(Canvas,Items[Index],ClientWidth);

    Y := Rect.Top;

    for i := Low(WrapRecord.Lines) to High(WrapRecord.Lines) do

    begin

      Canvas.TextOut(Rect.Left, y, WrapRecord.Lines[i]);

      Inc(y, Canvas.TextHeight(WrapRecord.Lines[i]));

    end;

  end;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

  ListBox1.OnMeasureItem := ListBoxMeasureItem;

  ListBox1.OnDrawItem := ListBoxDrawItem;

  ListBox1.Style := lbOwnerDrawVariable;

end;