1

源程序下载
1：给ListBox、ComboBxox添加图片
第一步：
在Form1上分别放置一个ComboBox1: TComboBox，改变ComboBox1的Style属性：ComboBox1.Style := csOwnerDrawVariable；ListBox1 : TListBox，改变ListBox1的Style属性 ListBox1.style := lbOwnerDrawVariable
第二步：
定义一个图片数组，TheBitmap : Array [1..10] of TBitmap ;同时再设置一个BmpAlreadyCreate : Boolean;变量，用于判断图片是否已经生成。
第三步：
给ComboBox1.OnDrawItem和ListBox1.OnDrawItem事件添加内容。
第四步：
在程序退出时释放所创建的图片资源，图片是否创建，由变量BmpAlreadyCreat来判断；
具体程序如下：
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+'00102\'+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;
2：给ListBox添加水平滚动条
给LitBox添加水平滚动条，只需要一句话，SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,5000, longint(0)); 就可以实现。
procedure TForm1.Button2Click(Sender: TObject);
begin
SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,5000, longint(0));
end;
3：Delphi中动态定制菜单
Delphi的标准构件组中提供了Menu标准菜单和PopupMenu弹出式菜单两种组件，这两个构件，既可以在设计过程中根据需要填写各个菜单项，定制各菜单项的响应事件，也可以在程序运行过程当中，根据使用者的选择，动态确定菜单项的内容与响应事件，即动态定制菜单。前一种方法较为简单，被广大程序员广泛采用；后一种方法较为复杂，但适用性特别好，可移植性强，在实际编程当中，一些特殊的要求下，是解决问题的唯一方法。
PopupMenu弹出式菜单的各菜单项实际上是一个个TMenuItem类的对象，不同对象的Caption属性就是菜单在屏幕上显示的内容。改变这些Caption属性的内容即可达到动态定制菜单项的目的。弹出时菜单项数目的增减，可以通过TPopupMenu.items.add(TMenuItem)和TPopupMenu.items.delete(Word)两种方法来实现，然后再通过对TmenuItem.OnClick事件的重定向，实现菜单选择的事件响应。
在Form1上放置PopuMenu1: TPopupMenu与Button3:Tbutton,设置各Form1.PopupMenu := PopuMenu1，在按Delphi中动态定制菜单之前和按了之后，所见到弹出式菜单有什么不同。
本程序的注意事项：删除弹出式菜单PopupMenu1原先的菜单项时，PopupMenu1.items.count会随着Delete(0)方法的使用自动逐步减小。因此删除菜单时，应该注意。
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;
源程序下载