listbox和comebox添加图片

unit U0012;interfaceuses  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.