Климов Иван
дата публикации 12-01-2005 18:00

---

Версия для печати

В данном примере хочется рассмотреть, как с помощью канвы можно преобразить и добавить функциональности компоненту ListBox. Хочу оговориться сразу - для простоты вида я рисую прямо на канве. Для уменьшения эффекта мигания можно рисовать на bmp. Перейду непосредственно к примеру: Форма = Form7, Компонент - ListBox1 Я решил подгрузить bmp для списка с FormCreate, хотя можно где угодно…

procedure TForm7.FormCreate(Sender: TObject); begin bmp:=Tbitmap.Create; //создаем бмп bmp.Transparent:=True; //включаем прозрачность bmp.TransparentMode:=tmauto; //способ-авто, есть и другие флаги-смотри справку bmp.LoadFromFile(ExtractFilePath(Application.ExeName)+''user.bmp''); end; procedure TForm7.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState); var int,int2,int3:integer; //для определения нечетности OldBkMode: integer; //для задания прозрачности фона текста через api myrect,Myrect2:Trect; // произвольные ректы для боковой полосы и дорисовки ее //до конца листбокса oldbs:TbrushStyle; //для отмены прозрачности кисти Fcolor:Tcolor; //для отмены цвета шрифта Begin //задаем координаты боковой полоски myrect.Top:=rect.top; myrect.Bottom:=rect.Bottom; myrect.Left :=Rect.Left{ListBox1.Left}; Myrect.Right:=Rect.Left+Bmp.Width+2; Myrect2.Top:=rect.bottom; Myrect2.Left:=Myrect.Left; Myrect2.Right:=Myrect.Right; Myrect2.Bottom:=ListBox1.Height; //Если элемент последний то дорисовываем градиент до конца листбокса // (эффект на любителя) if index=ListBox1.Count-1 then DrawGradient(Listbox1.Canvas,Myrect2,true,[$00FDF6F6,$00D9C9C9]); if (index <> 0) and (index <> 6)then begin // Отрисовываем листбокс без Fixed рядом (у нас 0-ой и 6-й) ListBox1.Canvas.TextRect(rect,rect.left+bmp.width+3,rect.top+3,ListBox1.Items[Index]); int:= index mod 2; if int = 0 then begin //если ряд четный то рисуем полоску светлого цвета (а-ля Linux!!) ListBox1.Canvas.Brush.Color:=RGB(242,245,253); // я выбрал такой цвет //убираем линии прямоугольника. (рисуем его без рамки) ListBox1.Canvas.pen.Style :=psclear; //рисуем прямоугольник ListBox1.Canvas.RoundRect(Rect.Left+bmp.Width,Rect.Top,rect.Right, rect.bottom,0,0); // задаем прозрачность текста OldBkMode := SetBkMode(ListBox1.Canvas.Handle, TRANSPARENT); // рисуем текст ListBox1.Canvas.TextRect(rect,rect.left+bmp.Width+3,rect.top+3, ListBox1.Items[Index]); // возвращаем старые настройки прозрачности SetBkMode(ListBox1.Canvas.Handle, OldBkMode); end; end; if (index <> 0) and (index <> 6) then begin // Если не Fixed то рисуем градиент сбоку DrawGradient(Listbox1.Canvas,Myrect,true,[$00FDF6F6,$00D9C9C9]); //если хотим чтобы все bmp были одинаковые {ListBox1.Canvas.Draw(rect.Left,Rect.Top,bmp); } end; if (index=0) or (index = 6) then begin //отрисовка Fixed рядов ListBox1.Canvas.Font.Style:=[fsBold]; //Шрифт жирный DrawGradient(Listbox1.Canvas,Rect,false,[$00FDF6F6,$00D9C9C9]); // другой градиент ListBox1.Canvas.Brush.Color:=$00947C7C; //Цвет каемки Fixed прямоугольника ListBox1.Canvas.FrameRect(Rect); //Рисуем рамку oldbs:=ListBox1.Canvas.Brush.Style; Listbox1.Canvas.Brush.Style:=bsclear; //делаем фон текста прозрачным Fcolor:=ListBox1.Canvas.Font.Color; //запоминаем цвет шрифта ListBox1.Canvas.Font.Color:=clMedGray; DrawText(ListBox1.Canvas.Handle,Pchar(ListBox1.Items[Index]), length(ListBox1.Items[Index]),rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER); //рисуем текст в центре ячейки ListBox1.Canvas.Font.Color:=Fcolor; //восстанавливаем цвет ListBox1.Canvas.Brush.Style:=oldbs; //восстанавливаем стиль прозрачности end; if (index <> 0) and (index <> 6) then begin //чтобы не мигали Fixed ячейки if odselected in state then begin //отрисовываем выбранный элемент ListBox1.Canvas.pen.Width:=1; ListBox1.Canvas.pen.Color :=$00947C7C; ListBox1.Canvas.pen.Style :=pssolid; ListBox1.Canvas.Brush.Color:=$00C2EEFF; ListBox1.Canvas.Rectangle(rect.Left,rect.Top,rect.Right,rect.bottom); oldbs:=ListBox1.Canvas.Brush.Style; ListBox1.Canvas.Brush.Style:=bsclear; ListBox1.Canvas.TextRect(rect,rect.left+bmp.Width+3,rect.top+3, ListBox1.Items[Index]); ListBox1.Canvas.Brush.Style:=oldbs; end; end; if index = 5 then //выводим произвольный битмап в выбранный ряд ListBox1.Canvas.Draw(rect.Left,Rect.Top,bmp); if odFocused in State then //убираем стандартные точечки выделения при потере фокуса ListBox1.Canvas.DrawFocusRect(Rect); end;

Наверное, Вы хотите спросить: "А что такое DrawGradient???" Это процедура по прорисовке градиента с произвольным количеством цветов (взята мною из DelphiWorld''a).

Примечание:
Автор процедуры: David Johannes Rieger
Оригинал материала: http://www.djr-delphi.gmxhome.de/old/Tipps/Grafik/005.htm
http://www.swissdelphicenter.ch/torry/showcode.php?id=1162

procedure DrawGradient(ACanvas: TCanvas; Rect: TRect; Horicontal: Boolean; Colors: array of TColor); type RGBArray = array[0..2] of Byte; var x, y, z, stelle, mx, bis, faColorsh, mass: Integer; Faktor: double; A: RGBArray; B: array of RGBArray; merkw: integer; merks: TPenStyle; merkp: TColor; begin mx := High(Colors); if mx > 0 then begin if Horicontal then mass := Rect.Right - Rect.Left else mass := Rect.Bottom - Rect.Top; SetLength(b, mx + 1); for x := 0 to mx do begin Colors[x] := ColorToRGB(Colors[x]); b[x][0] := GetRValue(Colors[x]); b[x][1] := GetGValue(Colors[x]); b[x][2] := GetBValue(Colors[x]); end; merkw := ACanvas.Pen.Width; merks := ACanvas.Pen.Style; merkp := ACanvas.Pen.Color; ACanvas.Pen.Width := 1; ACanvas.Pen.Style := psSolid; faColorsh := Round(mass / mx); for y := 0 to mx - 1 do begin if y = mx - 1 then bis := mass - y * faColorsh - 1 else bis := faColorsh; for x := 0 to bis do begin Stelle := x + y * faColorsh; faktor := x / bis; for z := 0 to 3 do a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor)); ACanvas.Pen.Color := RGB(a[0], a[1], a[2]); if Horicontal then begin ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top); ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom); end else begin ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle); ACanvas.LineTo(Rect.Right, Rect.Top + Stelle); end; end; end; b := nil; ACanvas.Pen.Width := merkw; ACanvas.Pen.Style := merks; ACanvas.Pen.Color := merkp; end else // Please specify at least two colors raise EMathError.Create(''Es mussen mindestens zwei Farben angegeben werden.''); end;