Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2004.06.27;
Скачать: CL | DM;

Вниз

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;
Скачать: CL | DM;

Наверх




Память: 0.49 MB
Время: 0.024 c
14-1086773601
*Pavel
2004-06-09 13:33
2004.06.27
Шмон нелицензионного ПО


3-1085827809
KADAN
2004-05-29 14:50
2004.06.27
last insert id в MSSQL


1-1087234669
Oxer
2004-06-14 21:37
2004.06.27
Файл помощи


3-1086168355
din
2004-06-02 13:25
2004.06.27
Как создать запрос по датам


1-1087289051
AlexG
2004-06-15 12:44
2004.06.27
DLL из обычной в ресурсную...