📄 00102.htm
字号:
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<meta name="GENERATOR" content="Microsoft FrontPage 4.0">
<meta name="ProgId" content="FrontPage.Editor.Document">
<title>1</title>
</head>
<body bgcolor="#000000" text="#FFFFFF" link="#FFFFFF">
<p><span style="BACKGROUND-COLOR: #ff0000"><a href="00102.zip">源程序下载</a></span><b><span style="background-color: #000080"><br>
</span></b><span style="background-color: #000000">
<br>
</span><b><span style="background-color: #000080">
<a name="1"></a>
1：给ListBox、ComboBxox添加图片<br>
</span><span style="background-color: #000000">
<br>
</span></b>第一步：<br>
在Form1上分别放置一个ComboBox1: TComboBox，改变ComboBox1的Style属性：ComboBox1.Style := csOwnerDrawVariable；ListBox1 : TListBox，改变ListBox1的Style属性 ListBox1.style := lbOwnerDrawVariable<br>
<br>
<br>
第二步：<br>
定义一个图片数组，TheBitmap : Array [1..10] of TBitmap ;同时再设置一个BmpAlreadyCreate : Boolean;变量，用于判断图片是否已经生成。<br>
<br>
第三步：<br>
给ComboBox1.OnDrawItem和ListBox1.OnDrawItem事件添加内容。<br>
<br>
第四步：<br>
在程序退出时释放所创建的图片资源，图片是否创建，由变量BmpAlreadyCreat来判断；<br>
<br>
具体程序如下：<br>
procedure TForm1.FormCreate(Sender: TObject);<br>
begin<br>
BmpAlreadyCreate := False ;<br>
end;<br>
<br>
procedure TForm1.Button1Click(Sender: TObject);<br>
Var<br>
I : Integer ;<br>
AppPath : String ;<br>
begin<br>
AppPath := ExtractFilePath(Application.Exename);<br>
if Not BmpAlreadyCreate Then<br>
Begin<br>
For I := 1 to 10 do<br>
Begin<br>
TheBitmap[i] := TBitmap.Create ;<br>
TheBitmap[i].LoadFromFile(AppPath+'00102\'+IntToStr(i)+'.bmp') ;<br>
ComboBox1.Items.AddObject('ComboBox测试 '+IntToStr(i), TheBitmap[i]) ;<br>
ListBox1.Items.AddObject('ListBox测试 '+IntToStr(i), TheBitmap[i]) ;<br>
End ;<br>
End ;<br>
BmpAlreadyCreate := True ;<br>
end;<br>
<br>
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;<br>
Rect: TRect; State: TOwnerDrawState);<br>
var<br>
Bitmap: TBitmap ;<br>
Offset: Integer ;<br>
begin<br>
offset := 0 ;<br>
with (Control as TComboBox).Canvas do<br>
begin<br>
FillRect(Rect);<br>
Bitmap := TBitmap(ComboBox1.Items.Objects[Index]);<br>
if Bitmap <> nil then<br>
begin<br>
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,<br>
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,<br>
Bitmap.Height), clRed);<br>
Offset := Bitmap.width + 8;<br>
end;<br>
TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index]) //display the text<br>
end;<br>
end;<br>
<br>
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect:
TRect; State: TOwnerDrawState);<br>
var<br>
Bitmap: TBitmap;<br>
Offset: Integer;<br>
Begin<br>
offset := 0 ;<br>
with (Control as TListBox).Canvas do<br>
Begin<br>
FillRect(Rect);<br>
Bitmap := TBitmap(ListBox1.Items.Objects[Index]);<br>
if Bitmap <> nil then<br>
Begin<br>
BrushCopy(Bounds(Rect.Left + 2, Rect.Top + 2, Bitmap.Width,<br>
Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,<br>
Bitmap.Height), clRed);<br>
Offset := Bitmap.width + 8;<br>
End;<br>
TextOut(Rect.Left + Offset, Rect.Top, ListBox1.Items[Index]) //display the text<br>
End ;<br>
End ;<br>
<br>
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);<br>
Var<br>
I : Integer ;<br>
begin<br>
if BmpalreadyCreate Then<br>
For I := 1 to 10 do TheBitmap[i].Free ;<br>
end;<b><span style="background-color: #000080"><br>
</span><span style="background-color: #000000">
<br>
</span><span style="background-color: #000080">
<a name="2"></a>
2：给ListBox添加水平滚动条</span></b>
<br>
给LitBox添加水平滚动条，只需要一句话，SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,5000, longint(0)); 就可以实现。<br>
procedure TForm1.Button2Click(Sender: TObject);<br>
begin<br>
SendMessage(ListBox1.Handle,LB_SetHorizontalExtent,5000, longint(0));<br>
end;<b><span style="background-color: #000080"><br>
</span><span style="background-color: #000000">
<br>
</span><span style="background-color: #000080">
<a name="3"></a>
3：Delphi中动态定制菜单</span></b>
<br>
Delphi的标准构件组中提供了Menu标准菜单和PopupMenu弹出式菜单两种组件，这两个构件，既可以在设计过程中根据需要填写各个菜单项，定制各菜单项的响应事件，也可以在程序运行过程当中，根据使用者的选择，动态确定菜单项的内容与响应事件，即动态定制菜单。前一种方法较为简单，被广大程序员广泛采用；后一种方法较为复杂，但适用性特别好，可移植性强，在实际编程当中，一些特殊的要求下，是解决问题的唯一方法。<br>
PopupMenu弹出式菜单的各菜单项实际上是一个个TMenuItem类的对象，不同对象的Caption属性就是菜单在屏幕上显示的内容。改变这些Caption属性的内容即可达到动态定制菜单项的目的。弹出时菜单项数目的增减，可以通过TPopupMenu.items.add(TMenuItem)和TPopupMenu.items.delete(Word)两种方法来实现，然后再通过对TmenuItem.OnClick事件的重定向，实现菜单选择的事件响应。<br>
在Form1上放置PopuMenu1: TPopupMenu与Button3:Tbutton,设置各Form1.PopupMenu := PopuMenu1，在按Delphi中动态定制菜单之前和按了之后，所见到弹出式菜单有什么不同。<br>
本程序的注意事项：删除弹出式菜单PopupMenu1原先的菜单项时，PopupMenu1.items.count会随着Delete(0)方法的使用自动逐步减小。因此删除菜单时，应该注意。<br>
Procedure Tform1.ShowIt(Sender:Tobject);<br>
begin<br>
With Sender as TmenuItem do<br>
begin<br>
Label1.Caption := Caption<br>
end;<br>
end;<br>
<br>
procedure TForm1.Button3Click(Sender: TObject);<br>
Var<br>
Menuitem:array[1..4]of Tmenuitem;<br>
I:integer;<br>
begin<br>
While(popupmenu1.items.count>0) Do<br>
PopupMenu1.Items[0].free ; //释放已经创建的TmenuItem<br>
for I:=1 to 4 do<br>
Begin<br>
Menuitem[I] := TmenuItem.Create(Self); //动态创建TMenuItem<br>
MenuItem[I].Caption:= 'File '+inttostr(I); //设置MenuItem的Caption属性<br>
MenuItem[I].OnClick:= ShowIt; //定义menuItem的OnClick事件的处理过程<br>
PopupMenu1.Items.Add(MenuItem[I]); //增加到PopMenu中<br>
End;<br>
end;<br>
<br>
<br>
<span style="background-color: #FF0000"><a href="00102.zip">源程序下载</a></span>
</p>
</body>
</html>
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -