Delphi World - Полосатый TListBox
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Полосатый TListBox

Оформил: 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 World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования