Форум: "Основная";
Текущий архив: 2004.06.27;
Скачать: [xml.tar.bz2];

Вниз

ListBox   Найти похожие ветки 

← →
Softal   (2004-06-11 08:32) [0]

Подскажите как мне добавить в ListBoxe  картинки для каждого Itemsa

---

← →
KSergey ©   (2004-06-11 08:43) [1]

См. пример в справке для TCustomListBox.OnDrawItem

---

← →
Softal   (2004-06-11 09:10) [2]

Данного примера я не нашел. У меня D7

---

← →
Serge ©   (2004-06-11 09:21) [3]

А примеров наверно туча по разным ФАК-ам есть.

---

← →
serge ©   (2004-06-11 09:29) [4]


Procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
Var
 LRect, RRect, TxtRect: TRect;
 RColor, LColor: TColor;
Begin
 LRect := Rect; LRect.Right := LRect.Left + 32; RRect := Rect; RRect.Left := LRect.Right + 4;
 If odSelected In state Then
 Begin
   LColor := $00C56A31; RColor := $00C56A31; TListBox(Control).Canvas.Font.Color := clWhite;
 End
 Else
 Begin
   LColor := clBtnFace; RColor := $00EAEAEA; TListBox(Control).Canvas.Font.Color := clNavy;
 End;
 With TListBox(Control).Canvas Do
 Begin
   Brush.Style := bsSolid;
   Brush.Color := RColor;
   FillRect(Rect);
   Brush.Color := LColor;
   FillRect(LRect);
   Brush.Style := bsClear;
   TxtRect := Rect; TxtRect.Left := TxtRect.Left + 2;
   DrawText(TListBox(Control).Canvas.Handle, PChar(TListBox(Control).Items[Index]),
     length(TListBox(Control).Items[Index]), TxtRect,
     DT_SINGLELINE + DT_VCENTER + DT_LEFT);
 End;
End;


Нe вот, че-то типа такого, просто надо добавить еще отрисовку картинки (BitBlt, Canvas.Draw, Canvas.CopyRect etc...)

---

← →
Рамиль ©   (2004-06-11 09:38) [5]

unit Unit1;

interface

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

type
 TForm1 = class(TForm)
   ListBox1: TListBox;
   ImageList1: TImageList;
   Panel1: TPanel;
   Edit1: TEdit;
   procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
     Rect: TRect; State: TOwnerDrawState);
   procedure Edit1KeyDown(Sender: TObject; var Key: Word;
     Shift: TShiftState);
   procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
     var Height: Integer);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
 Rect: TRect; State: TOwnerDrawState);
var
 Bit: TBitMap;
 i, CurWidth: integer;
begin
Bit := TBitmap.Create;
CurWidth := 0;
with (Control as TListBox) do
begin
  Canvas.FillRect(Rect);
  i := 1;
  while i <= Length(Items[Index]) do
  begin
    if (Items[Index][i] = "*") and (Items[Index][i + 1] in ["0", "1", "2", "3", "4", "5", "6"]) then
    begin
      ImageList1.GetBitmap(StrToInt(Items[Index][i + 1]), Bit);
      Canvas.Draw(Rect.Left + CurWidth + 1, Rect.Top, Bit);
      CurWidth := CurWidth + ImageList1.Width + 2;
      inc(i, 2);
    end else
    begin
      Canvas.TextOut(Rect.Left + CurWidth,Rect.Top,ListBox1.Items[index][i]);
      CurWidth := CurWidth + Canvas.TextWidth(Items[Index][i]);
      inc(i);
    end;
  end;
end;
Bit.Free;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
 Shift: TShiftState);
begin
 if Key = 13 then
 begin
   ListBox1.Items.Add(Edit1.Text);
   Edit1.Text := "";
 end;
end;

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
 var Height: Integer);
begin
 Height := ImageList1.Height;
end;

end.

Парсируются пары символов "*цифра" в картинки.
Надо только поставить Style в lbOwnerDrawFixed или lbOwnerDrawVariable, в зависимости от того что необходимо в итоге

---

← →
Softal   (2004-06-11 09:40) [6]

К сожалению у меня нет  данного примера. У меня D7

---

← →
Рамиль ©   (2004-06-11 09:41) [7]

В данном случае lbOwnerDrawVariable, так как задается высота строки.

---

← →
KSergey ©   (2004-06-11 09:43) [8]

> [6] Softal   (11.06.04 09:40)
> К сожалению у меня нет  данного примера. У меня D7

Ну нету - так привели уже
Да и что-то сомнительно что нету... Впрочем, не важно.

---

Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2004.06.27;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.47 MB
Время: 0.037 c