listbox和comebox添加图片

unit U0012;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Gauges, ComCtrls, Menus;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    ComboBox1: TComboBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    PopupMenu1: TPopupMenu;
    Label1: TLabel;
    a1: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
    Procedure ShowIt(Sender:Tobject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  TheBitmap : Array [1..10] of TBitmap ;
  BmpAlreadyCreate : Boolean;
implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  BmpAlreadyCreate := False ;
end;


procedure TForm1.Button1Click(Sender: TObject);
Var
  I : Integer ;
  AppPath : String ;
begin
  AppPath := ExtractFilePath(Application.Exename);
  if Not BmpAlreadyCreate Then
  Begin
    For I := 1 to 10 do
    Begin
      TheBitmap[i] := TBitmap.Create ;
      TheBitmap[i].LoadFromFile(AppPath+'Img\'+IntToStr(i)+'.bmp') ;
      ComboBox1.Items.AddObject('ComboBox测试 '+IntToStr(i), TheBitmap[i]) ;
      ListBox1.Items.AddObject('ListBox测试 '+IntToStr(i), TheBitmap[i]) ;
    End ;
  End ;
  BmpAlreadyCreate := True ;
end;

procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap ;
  Offset: Integer ;
begin
  offset := 0 ;
  with (Control as TComboBox).Canvas do
  begin
    FillRect(Rect);
    Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);
    if Bitmap <> nil then
    begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
      Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
      Bitmap.Height), clRed);
      Offset := Bitmap.width + 8;
    end;
    TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index]) //display the text
  end;

end;

procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  Bitmap: TBitmap;
  Offset: Integer;
Begin
  offset := 0 ;
  with (Control as TListBox).Canvas do
  Begin
    FillRect(Rect);
    Bitmap := TBitmap(ListBox1.Items.Objects[Index]);
    if Bitmap <> nil then
    Begin
      BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,
      Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
      Bitmap.Height), clRed);
      Offset := Bitmap.width + 8;
    End;
    TextOut(Rect.Left + Offset, Rect.Top, ListBox1.Items[Index]) //display the text
  End ;
End ;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
Var
  I : Integer ;
begin
  if BmpalreadyCreate Then
    For I := 1 to 10 do TheBitmap[i].Free ;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,5000, longint(0));
end;

Procedure Tform1.ShowIt(Sender:Tobject);
begin
  With Sender as TmenuItem do
  begin
    Label1.Caption := Caption
  end;
end;


procedure TForm1.Button3Click(Sender: TObject);
Var
  Menuitem:array[1..4]of Tmenuitem;
  I:integer;
begin
  While(popupmenu1.items.count>0) Do
    PopupMenu1.Items[0].free ; //释放已经创建的TmenuItem


  for I:=1 to 4 do
  Begin
    Menuitem[I]        := TmenuItem.Create(Self); //动态创建TMenuItem
    MenuItem[I].Caption:= 'File '+inttostr(I);    //设置MenuItem的Caption属性
    MenuItem[I].OnClick:= ShowIt;                 //定义menuItem的OnClick事件的处理过程
    PopupMenu1.Items.Add(MenuItem[I]);            //增加到PopMenu中
  End;
end;

end.