Полосатый TListBox

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

Оформил: DeeCo
Автор: http://www.swissdelphicenter.ch

unit Unit1;

 interface

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

 type

   TListbox = class(StdCtrls.TListbox)
   private
     procedure wmEraseBkGnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
   end;

      TForm1 = class(TForm)
     ListBox1: TListBox; // (!) ListBox1.Style := lbOwnerDrawFixed 
    Button1: TButton;
     procedure Button1Click(Sender: TObject);
     procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
       Rect: TRect; State: TOwnerDrawState);
     { ... }
   end;

 var
   Form1: TForm1;

 implementation

 {$R *.DFM}

 procedure TForm1.Button1Click(Sender: TObject);
 var
   i: Integer;
 begin
   for i := listbox1.Items.Count to listbox1.Items.Count + 5 do
     listbox1.Items.Add(Format('Item %d', [i]));
 end;

 { TListbox }
 const
   colors: array [Boolean] of TColor = ($FFFFC0, $C0FFFF);

 procedure TListbox.wmEraseBkGnd(var Msg: TWMEraseBkGnd);
 var
   cv: TCanvas;
   h, max: Integer;
   r: TRect;
   b: Boolean;
 begin
   Msg.Result := 1;
   h          := Perform(LB_GETITEMHEIGHT, 0, 0);
   if h = LB_ERR then h := ItemHeight;
   cv := TCanvas.Create;
   try
     cv.Handle := Msg.DC;
     r         := Rect(0, 0, ClientWidth, h);
     b         := Odd(TopIndex) and (TopIndex >= 0);
     max       := ClientHeight;
     cv.Brush.Style := bsSolid;
     while r.Top < max do
      begin
       cv.Brush.Color := colors[b];
       b := not b;
       cv.FillRect(r);
       OffsetRect(r, 0, h);
     end;
   finally
     cv.Handle := 0;
     cv.Free;
   end;
 end;

 procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
   Rect: TRect; State: TOwnerDrawState);
 var
   cb, ct: TColor;
 begin
   if not (odSelected in State) then
     with Control as TListbox do
      begin
       Canvas.Brush.Color := colors[Odd(Index)];
       Canvas.Brush.Style := bsSolid;
     end;
   Rect.Right := Control.ClientWidth;
   with Control as TListbox do
    begin
     Canvas.FillRect(Rect);
     Canvas.Brush.Style := bsClear;
     Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top, Items[Index]);
   end;
 end;

 end.

Перевод контента на русский язык:

Это проект Delphi, который реализует контрол стрипед TListBox с альтернирующими цветами для фона и текстовых элементов.

Распределение кода:

Компонент TListbox

Компонент TListbox派 от стандартного StdCtrls.TListbox и переопределяет процедуру wmEraseBkGnd для реализации эффекта стрипинга. Массив colors определяет два цвета - $FFFFC0 (палевый желтый) и $C0FFFF (палевый синий), которые используются альтернативно для фона.

В процедуре wmEraseBkGnd:

1. Инициализирует канвас (cv) с DC-объектом из сообщения.
2. Устанавливает прямоугольник (r) для заполнения альтернирующими цветами.
3. Циклится до достижения верхней границы списка, заполняя прямоугольник одним из палевых желтого или синего цвета в зависимости от того, является ли текущий элемент четным или нечетным.
4. Завершает канвас.

Компонент TForm1

Компонент TForm1 содержит TListBox (ListBox1) и TButton (Button1). При клике кнопки добавляет 5 новых элементов в список с помощью цикла.

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

1. Проверяет, является ли элемент выбранным (т.е., находится ли он в состоянии odSelected) и устанавливает цвет кисти соответственно.
2. Заполняет прямоугольник альтернирующими цветами, определенными в массиве colors.
3. Устанавливает текстовый цвет на белый (bsClear) и рисует текст элемента с помощью Canvas.TextRect.

Альтернативное решение

Если вы хотите более простое решение, можно достичь эффекта стрипинга, установив свойство ListBox1.Style в lbOwnerDrawVariable и реализуя только процедуру ListBox1DrawItem. Это позволит настроить отображение каждого элемента списка без переопределения процедуры wmEraseBkGnd.

В этом случае можно использовать одиночный цвет для фона и текста, а затем альтернировать цвета для каждого элемента с помощью функции Odd(Index).

Обновленная реализация:

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
  if not (odSelected in State) then
    Control.Canvas.Brush.Color := $C0C0C0; // палевый серый
  else
    Control.Canvas.Brush.Color := clWhite;

  Control.Canvas.FillRect(Rect);
  Control.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top, Items[Index]);
end;

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

В статье описывается создание полосатого списка элементов (TListBox) в Delphi с помощью владельческого рисования и использования шаблонов для изменения цвета фона и текста элементов.

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

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

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