分享--为listbox和comebox添加图片，图片得自己弄了，呵呵

其实你很棒 2011-09-23 02:39:16

加精



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.