1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:

//WICHTIG: Style auf lbOwnerDrawFixed stellen
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
const
  SM1 = ':)';
var
  Bmp: TBitmap;
  s, t: String;
  m, z: Integer;
begin
  Bmp := TBitmap.Create;
  try with (Control as TListbox) do begin
    Bmp.Transparent := True;
    Bmp.LoadFromFile('c:\smily.bmp'); //max 16x16 wegen ItemHeight

    //odSelected in State Abfrage fehlt noch

    z := 0;
    s := Items[Index];
    Canvas.Brush.Style := bsClear; //weil ich zu Faul bin zu rechnen
    while Pos(SM1, s) > 0 do begin
      t := Copy(s, 1, Pos(SM1, s) - 1);
      m := Canvas.TextWidth(t);

      Canvas.TextRect(Rect, Rect.Left + z, Rect.Top, t);
      Canvas.Draw(Rect.Left + z + m, Rect.Top, Bmp);

      Delete(s, 1, Pos(SM1, s) - 1);
      Delete(s, 1, Length(SM1) + 1);
      z := z + m + Bmp.Width + 2;
    end;
    Canvas.TextRect(Rect, Rect.Left + z, Rect.Top, s);
  end finally Bmp.Free end;
end;