Show multiline Text in a TCombobox

Spread the love

Show multiline Text in a TCombobox

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
      var Height: Integer);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Combobox1.Style := csOwnerDrawVariable;
  // fill the combobox with some examples
  with Combobox1.Items do
  begin
    Add('Short, kurzer String');
    Add('A long String. / Ein langer String.....');
    Add('Another String');
    Add('abcd defg hijk lmno');
    Add('..-.-.-.-.-.-.-.-.-');
  end;
end;

procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
  var Height: Integer);
  // Calculates the required height for a multiline text
var
  i, PosSp: Integer;
  strVal: string;
  strTmp: string;
begin
  if Index >= 0 then
  begin
    strVal := Combobox1.Items[Index];
    // wrap string to multiple lines, each line separated by #$D#$A
    strTmp := WrapText(strVal, 20);

    // Number of line separators + 1 = number of lines
    i := 1;
    while Pos(#$D#$A, strTmp) > 0 do
    begin
      i      := i + 1;
      strTmp := Copy(strTmp, Pos(#13#10, strTmp) + 2, Length(strTmp));
    end;

    // calcualte the height for the text
    Height := i * Combobox1.ItemHeight;
  end;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
  // Writes a text to the combobox. If the text is too long, then it will be
  // wrapped
var
  strVal: string;
  strTmp: string;
  intPos: Integer;
  i: Integer;
  rc: TRect;
begin
  // wrap the text
  strVal := WrapText(Combobox1.Items[Index], 20);
  i      := 0;
  Combobox1.Canvas.FillRect(Rect);

  // output each single line
  while Pos(#$D#$A, strVal) > 0 do
  begin
    intPos := Pos(#$D#$A, strVal);

    // copy current line from string
    if intPos > 0 then
      strTmp := Copy(strVal, 1, intPos - 1)
    else
      strTmp := strVal;
    rc     := Rect;
    rc.Top := Rect.Top + i * Combobox1.ItemHeight;
    ComboBox1.Canvas.TextRect(rc, Rect.Left, Rect.Top + i * Combobox1.ItemHeight,
      strTmp);

    // delete the written line from the string
    strVal := Copy(strVal, intPos + 2, Length(strVal));
    Inc(i);
  end;
  rc     := Rect;
  rc.Top := Rect.Top + i * Combobox1.ItemHeight;

  // write the last line
  ComboBox1.Canvas.TextRect(rc, Rect.Left, Rect.Top + i * Combobox1.ItemHeight, strVal);
  Combobox1.Canvas.Brush.Style := bsClear;

  // surround the text with a rectangle
  Combobox1.Canvas.Rectangle(Rect);
end;

end.