Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Многостроковый TComboBox

Delphi , Компоненты и Классы , Списки

Многостроковый 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; 
  // die Combobox mit einigen Beispielen fullen 
  // 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 Hohe fur 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; 
    // Hohe fur 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 loschen 
    // 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.

Here is the translation of the text into Russian:

Это компонент TComboBox в Delphi, который позволяет отображать собственные элементы. Комбо-бокс имеет несколько процедур: FormCreate, ComboBox1MeasureItem и ComboBox1DrawItem.

Процедура FormCreate инициализирует комбо-бокс некоторыми примерами и устанавливает его стиль в csOwnerDrawVariable, что означает, что комбо-бокс будет отображать свои элементы вместо использования стандартной отрисовки, предоставляемой системой.

Процедура ComboBox1MeasureItem рассчитывает требуемую высоту для каждого элемента в комбо-боксе. Она делает это, обернув текст каждого элемента в несколько строк на основе указанного ширины и затем рассчитывая количество строк, необходимых для отображения всего текста. Это необходимо потому, что комбо-бокс может иметь элементы с разной высотой, что могло бы вызвать проблемы, если не было обработано правильно.

Процедура ComboBox1DrawItem отображает каждый элемент в комбо-боксе на экране. Она делает это, обернув текст каждого элемента в несколько строк на основе указанного ширины и затем отображая каждую строку индивидуально на экране. Это позволяет иметь более контролируемое отображение элементов, например, возможность指定 используемого шрифта, цвета и т.д.

Вот улучшенная версия кода:

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);
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(#13#10, strTmp) > 0 do
    begin
      i := i + 1;
      strTmp := Copy(strTmp, Pos(#13#10, strTmp) + 2, Length(strTmp));
    end;
    // calculate the height for the text
    Height := i * ComboBox1.ItemHeight;
  end;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
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(#13#10, strVal) > 0 do
  begin
    intPos := Pos(#13#10, 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, rc.Top, strTmp);
    // delete the written line from the string
    strVal := Copy(strVal, intPos + 2, Length(strVal));
    Inc(i);
  end;
  // write the last line
  rc := Rect;
  rc.Top := Rect.Top + i * ComboBox1.ItemHeight;
  ComboBox1.Canvas.TextRect(rc, Rect.Left, rc.Top, strVal);
  ComboBox1.Canvas.Brush.Style := bsClear;
  // surround the text with a rectangle
  ComboBox1.Canvas.Rectangle(Rect);
end;

end.

Код был отформатирован и сделаны некоторые минимальные улучшения. Используется функция WrapText для обвязки текста в несколько строк на основе указанной ширины. Эта функция может быть реализована следующим образом:

function WrapText(const str: string; MaxWidth: Integer): string;
var
  i, PosSp: Integer;
  strTmp: string;
begin
  Result := '';
  while Length(str) > 0 do
  begin
    if Length(str) <= MaxWidth then
      Result := Result + str
    else
    begin
      i := 1;
      while True do
      begin
        PosSp := Pos(' ', str);
        if PosSp = 0 then
          break;
        if (i + 1) * 20 > MaxWidth then
        begin
          Result := Result + Copy(str, 1, PosSp - 1) + #13#10;
          Delete(str, 1, PosSp);
          Break;
        end else
          Inc(i);
      end;
    end;
  end;
end;

В статье описывается создание многострочного TComboBox в Delphi, который позволяет отображать текст на несколько строк и обрабатывать его wrapping.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Списки ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-08-19 13:29:56
2024-10-08 17:31:15/0.0043480396270752/0