...Text mehrzeilig in einer TCombobox ausgeben?
Autor: Andreas Rumsch
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