Fórum adicionando imagens e mudando a cor em listbox.. #223115

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  //Or set this property in the object inspector 
  //Oder im Objekt Inspektor einstellen 
  ListBox1.Style := lbOwnerDrawFixed; 
end; 

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
begin 
  with Control as TListBox do 
  begin 
    Canvas.FillRect(Rect); 
    Canvas.Font.Color := TColor(Items.Objects[Index]); 
    Canvas.TextOut(Rect.Left + 2, Rect.Top, Items[Index]); 
  end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
  ListBox1.Items.AddObject(´Red Item´, Pointer(clRed)); 
end; 

procedure TForm1.Button2Click(Sender: TObject); 
begin 
  ListBox1.Items.AddObject(´Green Item´, Pointer(clGreen)); 
end; 

{ Create a TImage on your Formular and assign a bitmap } 
{ Create a TListbox on your Formular } 

type 
  TForm1 = class(TForm) 
    ListBox1: TListBox; 
    Image1: TImage; 
    procedure FormCreate(Sender: TObject); 
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; 
      Rect: TRect; State: TOwnerDrawState); 
    procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer; 
      var Height: Integer); 
  private 
    {...} 
  public 
    {...} 
  end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with ListBox1.Items do 
  begin 
    Clear; 
    ListBox1.Style := lbOwnerDrawVariable; 
    AddObject(´Bitmap1´, Image1.Picture.Bitmap); 
    AddObject(´Bitmap2´, Image2.Picture.Bitmap); 
    AddObject(´Bitmap3´, Image3.Picture.Bitmap); 
  end; 
end; 

procedure CenterText(Cnv: TCanvas; Rect: TRect; S: string); 
var  
  X, Y: Integer; 
begin 
  X := (Rect.Right + Rect.Left - Cnv.TextWidth(S)) div 2; 
  Y := (Rect.Bottom + Rect.Top - Cnv.TextHeight(S)) div 2; 
  Cnv.TextOut(X, Y, S); 
end; 

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; 
  Rect: TRect; State: TOwnerDrawState); 
var  
  Bitmap: TBitmap; 
begin 
  with ListBox1 do 
  begin 
    Canvas.FillRect(Rect); 
    if Items.Objects[Index] <> nil then 
    begin 
      Bitmap := Items.Objects[Index] as TBitmap; 
      Canvas.BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, 
        Bitmap.Width, Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width, 
        Bitmap.Height), Bitmap.Canvas.Pixels[0, Bitmap.Height - 1]); 
    end; 
    Rect.Left   := Rect.Left + Bitmap.Width + 4; 
    Rect.Bottom := Rect.Top + Bitmap.Height + 4; 
    CenterText(Canvas, Rect, Items.Strings[Index]); 
  end; 
end; 

procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer; 
  var Height: Integer); 
begin 
  if Index = 0 then Height := Image1.Height + 4; 
end;