...show multiline Text in a TCombobox?

Author: Andreas Rumsch
Homepage: http://www.ardesign.ch

Category: Forms

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;
  // die Combobox mit einigen Beispielen füllen
  // 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);
  // Berechnet die notwendige Höhe für einen mehrzeiligen Text
  // 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];
    // String auf mehrere Zeilen aufteilen, Zeilen sind mit #$D#$A getrennt
    // wrap string to multiple lines, each line separated by #$D#$A
    
strTmp := WrapText(strVal, 20);
    // Anzahl der Zeilentrennungen plus eins = Anzahl Zeilen
    // 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;
    // Höhe für den Text berechnen
    // calcualte the height for the text
    
Height := i * Combobox1.ItemHeight;
  end;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
  // Schreibt einen Text auf die Combobox. Wenn der Text zu lange ist, wird er
  // auf mehrere Zeilen aufgeteilt
  // 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
  
// Text auf mehrere Zeilen aufteilen
  // wrap the text
  
strVal := WrapText(Combobox1.Items[Index], 20);
  i      := 0;
  Combobox1.Canvas.FillRect(Rect);
  // jede Textzeile einzeln ausgeben
  // output each single line
  
while Pos(#$D#$A, strVal) > 0 do
  begin
    
intPos := Pos(#$D#$A, strVal);
    // Aktuelle Zeile aus dem String kopieren
    // 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);
    // die ausgegebene Zeile aus dem String löschen
    // 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;
  // Letzte Zeile schreiben
  // write the last line
  
ComboBox1.Canvas.TextRect(rc, Rect.Left, Rect.Top + i * Combobox1.ItemHeight, strVal);
  Combobox1.Canvas.Brush.Style := bsClear;
  // den Text mit einem Rechteck umrunden
  // surround the text with a rectangle
  
Combobox1.Canvas.Rectangle(Rect);
end;

end.

 

printed from
www.swissdelphicenter.ch
developers knowledge base