三维轮廓仪:Delphi 控件与技巧专辑

［前言:］为简化程序员的工作Delphi提供了众多控件,同时由于的成功众多的软件厂商也为Delphi提供了相应的第三方控件,这一切使Delphi变得更加强大,成为微软在应用软件开发工具中强有力的竞争者。
 
　　Delphi中ListBox控件的六种特效
　　Delphi5是Borland公司开发的全新的可视化集成开发环境,它使用语法严密的Pascal语言,并封装了Windows中的构件,形成了自己的一套控件库体系
　　DELPHI超级Internet控件集--INDY
　　有一套功能很丰富、使用很方便、开放源代码的免费INTERNET控件集可以解决你的烦恼。这套控件集就是INDY
　　如何用Delphi编写自己的可视化控件
　　可视化控件实际上就是一个类(class),要编写一个类,可以直接在*.pas文件中编写。但是要编写控件,则必须使用包(package)。从File菜单中选择New,新建一个Package,这就是存放和安装控件用的包
　　Delphi 插件创建、调试与使用应用程序扩展
　　一个插件和一个普通DLL之间的差异在于插件具有扩展父应用程序功能的能力。例如,Photoshop本身并不具备进行大量的图像处理功能。插件的加入使其获得了产生诸如模糊、斑点,以及其他所有风格的奇怪效果,而其中任何一项功能都不是父应用程序自身所具有的
　　改变VCL的行为--一个使用可视化元件的实例
　　秘密在于在控件之前抢先截获Windows消息。这可以通过使用一个叫做WindowProc的TControl属性来实现,这个属性实质上指向控件的Windows消息事件处理器
　　Delphi第三方控件大测评
　　现在控件满天飞,不要说DSP(Delphi Super Page)了,光一个深度历险上面的控件就已经洋洋洒洒上万数了,而且每天还在更新
　　在Delphi中使用IP控件
　　在网络程序中,我们常常碰到需要用户输入IP地址的情况。然而Delphi并没有为我们提供可以用于输入IP串的控件,于是我们只好用Tedit控件(单行文本框)来接受用户输入的IP串。但是,使用Tedit来输入IP串并不是一个好的主意,因为处理起来非常不方便
　　TList的用法
　　TList是一个很好的东东,有了它我们不再去费尽心思地写什么列表类,直接用它就行了,下面的例子示范了怎样建立一个TList并插入两条记录,这些记录将输出在PaintBox上
　　RichEdit的自动格式化
　　这是一个注册EXE,OBJ,BIN三种类型文件当其被RichEdit打开时会自动转换为16进制显示的例子
　　RichEdit中实现查找功能
　　RichEdit有一个FindText函数,极大方便了我们为RichEdit编制查找功能。下面的片断取自于Delphi帮助中的范例
　　让按钮连续工作--兼谈Delphi元件开发
　　不知大家是否见过一种按钮,当它被按下的时侯,它所执行的功能(如向上或向下)就持续执行,当松开时,就停止,其实滚动棒两边的按钮就是这样的
　　
　　在Listboxes中加背景图
　　1. 建立一个窗体 2. 放一个ComboBox和Listbox
　　自动隐藏的声象按钮
　　随着计算机的日益普及和多媒体技术的不断发展,多媒体计算机辅助教学(MCAI)软件正改变人们传统的学习方式。MCAI软件的操作界面赏心悦目,特别是具有音响效果且能自动隐藏的图象按钮或菜单,图、文、声并茂,确实为软件添色不少,深受用户喜爱
　　DELPHI中利用TreeView控件建立目录树
　　TreeView是一个显示树型结构的控件,通过它能够方便地管理和显示具有层次结构的信息,是Windows应用程序的基本控件之一
　　在Delphi程序中应用IE浏览器控件
　　大概大家还记得Delphi的范例程序中的那个浏览器的例子吧。在那个例子中,利用控件THttp的属性和方法制作了一个浏览器。该例子用于理解THttp控件的使用方法,确实不错。但很少有人会用它作为一个真正的浏览器,原因很简单,功能太有限了
　　轻轻松松在DELPHI3.0中实现三态按钮
　　在许多新的软件中都用到三态按钮。所谓的三态按钮就是当鼠标还末移到时,按钮显示一种平面图像(FLAT);当鼠标移到按钮时,按钮呈现凸立体(UP);当鼠标在按钮上按下时,按钮呈现凹立体
　　制作用于日期时间型字段的DELPHI数据感知控件
　　用DELPHI开发C/S应用方便而快速,因为它拥有大量易于使用的数据访问和数据感知控件。然而万事总是难以完美,DELPHI的DBEdit控件用于输入日期时间型字段却很不方便
　　DELPHI控件Tweblabel的编制
　　Internet已经越来越多地渗透到生活的各个方面以及各个领域,许多人都有了自己漂亮的主页,但是,如何简洁而快速地调用这些主页呢？这就是用DELPHI的Tweblabel控件方法
　　在Delphi的DBGrid中插入其他可视组件
　　Delphi提供了功能强大的 DBGrid组件,以方便进行数据库应用程序设计。但是如果我们仅仅利用DBGrid组件,每一个获得焦点(Grid)只是一个简单的文本编辑框,不方便用户输入数据
　　用Delphi4的QReport部件生成报表
　　用户在使用数据库应用程序时经常要生成报表,利用Delphi 4的QReport 部件,可以帮助我们快速方便地生成报表。这里以一个设备管理报表为例说明如何用QReport部件与Query部件设计从多个数据表中生成报表
　　在Delphi中巧改窗体文件实现控件数组
　　delphi 开发的应用中,每一个窗体都有一个对应的窗体文件(.dfm),用来记录该窗体的属性以及窗体上所有控件的属性,以便在窗体关闭后能准确地重新生成窗体
　　状态条插入可视控件
　　FROM中放置一个状态条控件Status。调节Status.Panels,在其中插入3个状态条嵌板。把第二个嵌板的参数Style设置成psOwnerDraw
　　在Listboxes加背景图
　　建立一个窗体2. 放一个ComboBox和Listbox　3. 改变Component的Style为csOwnerDrawVariable和ListBox的Style为lbOwnerDrawVariable
　
　　编写提取图标的Delphi控件
　　在《从文件中提取图标》一文中(《计算机世界》第10期),我介绍了怎样从Windows下的可执行模块(EXE,DLL,CPL等)提取图标资源并且将所提取的图标保存成单独的图标文件
　　在RichEdit中的串查找
　　使用时与一般的WinAPI相差不多, 以下有一个包装过的函式.
　　改变RichEdit的游标位置
　　指定输入游标的位置
　　有关TListView的使用
　　ListView1.Items 为标准 Tlistitems类 ListView1.Items
　　Delphi中RichEdit的奥妙
　　用RichEdit(或者memo)控件制作文本编辑器时,通过访问lines?count属性可以得到总行数,但是若想知道光标当前所在行的行号就麻烦了
Delphi中ListBox控件的六种特效
　　Delphi5是Borland公司开发的全新的可视化集成开发环境,它使用语法严密的Pascal语言,并封装了Windows中的构件,形成了自己的一套控件库体系-VCL(Visual Component Library)。VCL控件体系具有很强的扩展性,为开发者设计特殊视觉效果的控件提供了技术支持。
本文就Delphi5中的TListBox控件,通过多种手段实现了它的七种特殊视觉效果,以期对广大程序爱好者在界面设计上有所启发与帮助。
　　一、基础知识
　　涉及TListBox自定义重绘的属性和事件:
　　属性:
　　　Style: 取值为lbStandard(标准风格),lbOwnerDrawFixed(所有者固定绘制风格),lbOwnerDrawVariable(所有者可变绘制风格)
　　说明:
　　　1．当Style = lbStandard时,使用控件默认的绘制风格。
　　　2．当Style = lbOwnerDrawFixed时,用户只能在控件默认大小的区域绘图。
　　　3．当Style = lbOwnerDrawVariable时,用户可改变控件默认的绘图区域大小并决定如何绘图。
　　事件:
　　　OnMeasureItem:当Style = lbOwnerDrawVariable时计算TListBox中某项的高度时调用。
　　　OnDrawItem :当Style = lbOwnerDrawVariable时由用户例程确定如何绘制TlistItem。
　　由此,可以看出,要实现定制界面风格的TListBox,首先,需要设置TlistBox的Style 属性为lbOwnerDrawVariable,其次,需要写自定义的重绘事件。
二、特殊效果的实现
　　在窗体(Form1)上放置5个ListBox,名称分别为ListBox1……ListBox5,将所有ListBox的Style属性设置为lbOwnerDrawVariable;在Form1上添加两个TImageList控件,命名为ImageList1,ImageList2;在ImageList1中装入两个16X16大小的图标;添加两个TButton控件,命名为Button1,Button2;再添加一个TImage控件,命名为Image1。其它操作,见下。
　　1．具有图标及热链接效果的列表框
　　在ListBox1的Items属性中添加几个字符串,并在ListBox1的OnDrawItem事件中编写代码如下:
procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
AIcon, BIcon: TIcon;
begin
try
file://从上述ImageList1中装入两个图标
AIcon := TIcon.Create;
BIcon := TIcon.Create;
file://装入图标到AIcon, BIcon
ImageList1.GetIcon(0, AIcon);
ImageList1.GetIcon(1, BIcon);
file://填充绘图区
ListBox1.Canvas.FillRect(Rect);
file://判断ListBox1中的当前重绘项是否被选中,根据状态装入不同的图标
if odSelected in State then
ListBox1.Canvas.Draw(Rect.Left, Rect.Top, AIcon)
else
ListBox1.Canvas.Draw(Rect.Left, Rect.Top, BIcon);
file://输出文字
ListBox1.Canvas.TextOut(Rect.Left + AIcon.Width div 2, Rect.Top + 2, ListBox1.Items[Index]);
finally
AIcon.Free;
BIcon.Free;
end;
end;
 
注:也可在OnMeasureItem事件中改变列表项的高度。
　　2．具有横向滚动条效果的列表框
　　在Form1上Button1的Click事件中书写如下代码:
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, ListBox1.Width + 30, 0);
end;
 
具体横向滚动区域的宽度可通过具体计算得出,在此从略。
3．具有图标,背景图片及透明文字效果的列表框
　　说明:
　　1．要使TListBox具有指定位图的背景,须考虑到以下问题:
　　如果TListBox的Items足够多,那么,在TListBox的OnDrawItem事件的Rect区域输出位图即可使整个TListBox的Canvas充满位图背景;反之,则会出现TListBox中上半部分有Item的地方有背景,下半部分没有Item的部分仍然为白色,影响视觉效果。
　　2． TListBox的Color属性决定了文本输出时的背景,通常为clWindow,这样用TextOut时就会出现不协调的白色文字背景。因此,要实现透明文字输出效果,可以通过设置ListBox.Canvas.Brush.Style := bsClear,这样,绘制的文字没有背景色,从而实现文字透明输出效果。
　　操作:
　　在ListBox2的Items属性中添加几个字符串;设置Form1上的Image1的Picture属性为一指定图片。在ListBox2的OnDrawItem事件中书写如下代码:
procedure TForm1.ListBox2DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
AIcon: TIcon;
I, K : Integer;
ARect, BRect: TRect;
H : Integer;
AStyle: TBrushStyle;
begin
try
file://计算Item数量
I := ListBox2.Items.Count-1;
AIcon := TIcon.Create;
file://装入图标
ImageList1.GetIcon(0, AIcon);
file://填充区域
ListBox2.Canvas.FillRect(Rect);
file://计算Rect绘图区的高度
H := Rect.Bottom - Rect.Top;
file://如果当前项是Item的最后一项,则在Canvas上没有Item的空白区绘制背景
if Index = I then
begin
K := 1;
ARect := Rect;
file://如果当前绘图项的底部小于ListBox2的Canvas的底部,有空白区域
While ARect.Bottom < ListBox2.Canvas.ClipRect.Bottom do
begin
file://一次计算下一个绘图区域
ARect.Top := Rect.Top + K * H;
ARect.Bottom := ARect.Top + H;
ListBox2.Canvas.stretchDraw(ARect, Image1.Picture.Bitmap);
Inc(K);
end;
end;
file://绘制当前项
ListBox2.Canvas.stretchDraw(Rect, Image1.Picture.Bitmap);
file://绘制图标
ListBox2.Canvas.Draw(Rect.Left, Rect.Top, AIcon);
ARect := Rect;
ARect.Left := Rect.Left + AIcon.Width div 2;
ARect.Top := ARect.top + 2;
file://保存当前画笔的风格
AStyle := Listbox2.Canvas.Brush.Style;
file://当前选中的Item要填充蓝色背景
if odSelected in State then
begin
ListBox2.Canvas.Brush.Style := bsSolid;
Listbox2.Canvas.Brush.Color := clBlue;
end
else
begin
file://未选中项透明背景,前景色为黑色
ListBox2.Canvas.Brush.Style := bsClear;
Listbox2.Font.Color := clBlack;
end;
file://输出文字
ListBox2.Canvas.TextOut(ARect.Left, ARect.top, ListBox2.Items[Index]);
file://恢复当前画笔的风格
ListBox2.Canvas.Brush.Style := AStyle;
finally
AIcon.Free;
end;
end;
 
　　以上方法实现了TListBox即具有背景图片,又具有图标和透明文字效果,极大的改善了TListBox的显示效果。
　　4．具有图标,背景图片,透明文字及文字对齐方式效果的列表框
　　要实现文字对齐效果,可通过Windows Api函数:DrawText实现。
　　操作:
　　将ListBox2的OnDrawItem事件中的代码复制到ListBox3的OnDrawItem事件中,并将复制代码中所有的ListBox2改为ListBox3。
　　将上述修改后代码中的ListBox3.Canvas.TextOut(Rect.Left + AIcon.Width div 2, Rect.Top + 2, ListBox3.Items[Index]); 语句删除,并在该处添加以下语句:
　　file://计算除掉图标所占区域后的区域,用于确定绘制文字的区域范围
ARect := Rect;
ARect.Left := Rect.Left + AIcon.Width div 2;
ARect.Top := ARect.top + 2;
file://Windows Api函数调用
DrawText(ListBox3.Canvas.Handle, PChar(ListBox3.Items[Index]), Length(ListBox3.Items[Index]), ARect, 0); file://0-左对齐, 1---居中, 2--右对齐
 
　　注:通知ListBox3重绘可通过命令ListBox3.Refresh实现
5．照片列表框效果
　　在ListBox4的Items属性中添加几个字符串;设置ImageList2的Width为148,Height为58;在ImageList2中装入与ListBox4中Items相同字符串数量的图片,大小148 X 58像素单位。
　　在ListBox4的OnMeasureItem事件中书写如下代码:
procedure TForm1.ListBox4MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
file://控制图片的高度
Height := 59;
end;
 
　　在ListBox4的OnDrawItem事件中书写如下代码:
procedure TForm1.ListBox4DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
ABmp: TBitmap;
begin
try
ABmp := TBitmap.Create;
ImageList2.GetBitmap(Index, ABmp);
ListBox4.Canvas.FillRect(Rect);
ListBox4.Canvas.Draw(Rect.Left, Rect.Top, ABmp);
finally
ABmp.Free;
end;
end;
 
　　这种利用TListBox实现的照片框效果,对于照片,商品图片的显示有一定价值。
　　6．以缩略图方式浏览某个文件夹下图片效果的列表框
　　在ListBox5的OnMeasureItem事件中书写如下代码:
procedure TForm1.ListBox5MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
file://控制图片的高度
Height := 59;
end;
 
　　在ListBox5的OnDrawItem事件中书写如下代码:
procedure TForm1.ListBox5DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
file://图片文件名
Fn: string;
ABmp: TBitmap;
begin
try
ABmp := TBitmap.Create;
Fn := ListBox5.Items[Index];
ABmp.LoadFromFile(ListBox5.Items[Index]);
Dec(Rect.Bottom);
ListBox5.Canvas.FillRect(Rect);
ListBox5.Canvas.StretchDraw(Rect, ABmp);
finally
ABmp.Free;
end;
end;
 
　　设置Button2的Caption为"预览",在其Click事件中书写如下代码:
var
sr: TSearchRec;
Dir: string;
begin
Dir := '';
file://选择目录对话框,需要在Uses中加入对FileCtrl单元的引用声明
if SelectDirectory('选择图片目录', '', Dir) then
begin
ListBox5.Items.Clear;
file://搜索该目录下的所有bmp文件
if FindFirst(Dir + '\*.bmp', faReadOnly, sr) = 0 then
begin
ListBox5.Items.Add(Dir + '\' + Sr.Name);
while FindNext(sr) = 0 do
begin
ListBox5.Items.Add(Dir + '\' + Sr.Name);
end;
FindClose(sr);
end;
end;
end;
 
以上六种方法将TBitmap, TIcon, TImage, TImageList结合使用,以及通过Windows API函数极大的改善了TListBox的外观,也为定制修改TlistView, TtreeView等控件的外观提供了参考手段。上述方法在Delphi5下调试通过。
DELPHI超级Internet控件集--INDY
　　你有没有用DELPHI开发Internet程序？是不是常常会烦恼FastNet组件为什么没有源代码？有很多问题,不看源代码,真不知道是什么问题。是不是也觉得FastNet组件支持的网络协议还不够多？现在不用烦恼了,有一套功能很丰富、使用很方便、开放源代码的免费INTERNET控件集可以解决你的烦恼。这套控件集就是INDY了。
　　什么是INDY？它有什么功能？怎么用？就让我慢慢道来。
　　INDY的全名是Internet Direct(也叫Winshoes),它是一套开放源代码的Internet控件集,它支持大部分流行的Internet协议,包括TCP、UDP、DNS、ICMP、FINGER、FTP、GOPHER、HTTP、POP3、SMTP、TELNET、WHOIS等,支持BASE64、MD2、MD4、MD5等编解码,提供INTERNET流行协议的客户端和服务器控件。INDY控件集的客户端和服务器控件都有完整、详细的源代码例程和帮助文件,用户可以根据这些例子,简单方便快速的建造各种服务器程序,例如WEB服务器、TELNET服务器、IRC服务器、TCP、UDP服务器等,而这些服务器都是支持多线程的。用户也可以很简单的编写出各种客户端程序,例如EMAIL、FINGER、FTP、PING、TELNET等。著名的OICQ使用的协议是UDP,有了INDY你可以使用UDP服务器和UDP客户端写出一个和OICQ较劲的东东来。
　　INDY是完全基于SOCKET阻塞工作模式(后面讨论)的开发库,现在已经支持BORLAND DELPHI、C++ BUIDER和最新的Kylix(LINUX里的DELPHI)等开发平台。目前,INDY的最新正式发行版本是8.0版,最新BETA版本是8.1版。INDY8.0支持DELPHI 4、DELPHI 5、C++BUIDER 4、C++BUIDER 5、Kylix等版本。Kylix已经把INDY作为标准组件打包到发行包里了。而且据说DELPHI 6.0将会把INDY作为它的INTERNET基本组件,由此可见INDY的强悍实力。
　　看了怎么多吸引人的特性,是不是迫不及待的想得到它了？不用急,你可以随时到INDY的主页上下载一份免费的源代码来安装,INDY的网址是(http://www.nevrona.com/Indy/),主页上会公布最新的INDY消息,发表更新的源代码和相关文档。如果在开发过程中遇到什么问题,可以通过访问BORLAND公司的新闻组(news://newsgroups.borland.com)里面的borland.public.delphi.internet.winsock和borland.public.cppbuilder.internet两个主题来获得免费的技术支持。INDY小组会及时回答在新闻组里提出的关于INDY的问题。你也可以把使用INDY的心得技巧、发现的BUG,发表到新闻组里,为INDY的发展作出一份贡献。
 INDY的安装很简单,现在INDY的网站正式提供WINDOWS版本的安装程序供下载,支持Kylix的版本则包含在BORLAND公司的Kylix发行包里,不过由于BORLAND修改了一些文件的原因,导致INDY的例程都不能编译成功,所以INDY网站提供了针对Kylix修改的例程文件下载。下载了安装程序后,执行安装程序(请先把你的开发平台程序关掉),设置好安装路径(图一),选择好你的开发平台的种类(DELPHI或C++BUIDER)和版本(图二),就可以了。等安装完成,打开你的开发平台程序,就可以在控件栏里发现新加的三个栏目:INDY SERVERS、INDY CLIENTS、INDY MISC(图三)。分别是INDY的服务器类、客户端类、杂项控件。而安装了INDY的目录里,包含有INDY的控件文件和控件源代码以及例程。你还可以在网站上下载它的帮助文件,帮助文件里包括各个控件的详细说明,是应用好INDY的必备手册。
 
图一选择开发平台类型和版本
 
图二控件面板图
　　安装好INDY后,可以开始尝试INDY的新鲜好味道了。INDY提供的丰富例程就是绝好的教材。先编译几个例程,看看INDY的强大功能吧。要想熟练的使用好INDY,就得多多学习这些例程和参考帮助文件。
　　熟悉WINSOCK编程的读者一定会觉得奇怪吧,为什么INDY是是完全基于SOCKET阻塞工作模式的呢？异步模式(非阻塞模式)是WINSOCK的一大特点,为什么不用呢？
　　其实,之所以大多数WINDOWS下的INTERNET程序都使用异步模式,这和WINSOCK的历史有关。当WINSOCK被移植到WINDOWS的时候,当时的WINDOWS操作系统还是WINDOWS 3.1,而WINDOWS 3.1是不支持多线程的,不象UNIX下可以使用FORK来运行多进程。在WINDOWS 3.1下,如果使用阻塞模式,在通讯时会锁定用户界面使程序没有响应,为了避免这种情况,WINSOCK就引入异步模式这个新特性。而使用异步模式来编制INTERNET程序也就成了WINDOWS程序员的经典教条。但是,随着新的WINDOWS操作系统的出现,如WINDOWS 95、NT、98、ME、2000等,这些操作系统开始支持多线程。异步模式这个教条仍然深入人心,使很多程序员会下意识的拒绝使用阻塞模式。
　　事实上,UNIX下的SOCKET只支持阻塞模式(现在UNXI的SOCKET有了一些新的非阻塞特性,不过绝大多数应用仍然使用阻塞模式)。阻塞模式具有以下几个比异步模式优越的特点:
　　编程更简单,可以把所有处理SOCKET的代码放在一起,顺序执行,而不用分散在不同的事件处理代码段里。
　　更容易移植到UNIX,使用INDY的DELPHI程序,可以不做太多(甚至不做)修改,就可以把WINDOWS的DELPHI源代码拿到LINUX下,用Kylix来编译成LINUX下的网络程序。
更容易在多线程程序里使用,由于阻塞模式的代码可以放在一起,可以很方便的把这些代码包裹在线程里面来使用,而不象异步模式,需要针对不同的事件,设置不同的处理代码。
　　为了兼顾简单可靠和高效,INDY是基于阻塞模式工作的。阻塞模式需要等待任务完成才返回,这样,当主线程里调用阻塞任务运行时,程序不能处理用户界面的消息。INDY提供了一个控件TidAntiFreeze来解决这个问题。只要在你的程序里,简单的填加一个TidAntiFreeze控件到任何地方(随便往FORM上放),不需要写任何代码(最多把超时时间改一下),就可以很好的解决用户界面不响应的问题。
　　下面有两段示范代码,可以看出INDY控件的程序代码和其他使用异步模式的Internet控件的程序代码相比,是多么的简洁:
代码一:INDY控件的程序代码(IndyClient代表INDY控件的一般形式)
with IndyClient do begin
Connect;
Try
// 在这里写入你的处理代码
finally
Disconnect;
end;
end;
代码二:其他控件的程序代码(SocketComponent代表一般的Internet控件)
procedure TFormMain.TestOnClick(Sender: TComponent);
begin
with SocketComponent do begin
Connect; try
while not Connected do begin
if IsError then begin
Abort;
end;
Application.ProcessMessages;
OutData := 'Data To send';
while length(OutData) > 0 do begin
Application.ProcessMessages;
end;
finally Disconnect; end;
end;
end;
procedure TFormMain.OnConnectError;
begin
IsError := True;
end;
procedure TFormMain.OnRead;
var
i: Integer;
begin
i := SocketComponent.Send(OutData);
OutData := Copy(OutData, i + 1, MaxInt);
end;
关于INDY的简单介绍就到这里了,感兴趣的朋友就去下载一个用吧,你一定会喜欢上它的。
如何用Delphi编写自己的可视化控件
　　可视化控件(Visual Component)实际上就是一个类(class),要编写一个类,可以直接在*.pas文件中编写。但是要编写控件,则必须使用包(package)。从File菜单中选择New,新建一个Package,这就是存放和安装控件用的包。然后单击Package窗口中的Add按钮,添加一个元件(Unit)。
　　在弹出的对话框最上方选择New Component。因为一个控件的所有属性、方法、事件不可能都由自己编,所以就需要选择祖先类(或者叫做"父类"或"基类"),然后再在其上面添加自己的属性、方法、事件。在Ancestor type后的下拉框中选择所需的祖先类。由于编写可视化控件必须要画图,所以选择TGraphicControl作为祖先类。再在Class Name框中输入新控件(类)的名称,一般以"T"开头。Palette Page是用来选择新控件在Delphi的窗口中的控件页面名称,例如"Standard",这个可以自己取。在Unit File Name中添好新控件文件的路径及文件名,单击OK按钮。新的控件便加入了。现在可以为该控件编写代码了。
　　下面以编写一个可以自定义图片的滚动条为例,说明编写可视化控件的方法。
　　按照上面的方法,选择TGraphicControl为祖先类,新控件的名称是TPigHorizontalScroller(小猪水平滚动条)。选择好文件路径和文件名后,单击OK按钮,开始编写代码。
　　每一个控件,都会被创建(Create)和删除(Destroy),所以必须首先编写这两个过程。对于控件中的每一个过程,都必须在前面先定义,然后再在后面编写。定义的过程或属性有三种:一、在private后定义的是属于控件内部使用的,使用该控件的人无法看到;二、在protected后定义的一般是看不到的,只在别人使用该控件作为祖先类编写其它控件时才可见;三、在public后定义的只允许别人在程序中调用;四、在published后定义的可以在属性窗口(Object Inspector)中看到。由于创建和删除过程除了在编程过程中建立控件时自动执行外,还可能在程序运行过程中动态创建控件时被调用,所以把它定义在public后⑴。(该序号表示次步骤在所附源程序中的代码的位置,下同)现在也许还不知到应该在这两个过程中编写什么,如何去编。我们在下面将会讲到。
我们首先为这个控件添加一些属性。我们定义一个Max属性用于设置或读取滚动条的最大值。因为在程序中一般不直接使用属性,所以要定义一个变量,和该属性对应起来,一边修改或读取其值。因为它只在控件内部使用,所以我们把它定义在private后⑵。(一般与属性相关联的变量都以"F"开头,例如FMax)定义好变量后,再定义属性。这个属性需要再Object Inspector窗口中可见,所以把它定义再published后⑶。定义的语法是:
　　property <属性名>:<类型> read <读取该属性时对应的变量> write <写入该属性时对应的变量或过程>
　　其它的变量和属性也类似的定义(例如Min最小值、Value当前值等)。下面我们定义几个属性和变量,用于设置滚动条的图片(因为图片变量比较特殊,所以单独讲一下)。我们把LeftButtonUpPicture(向左按钮图片)、LeftButtonDownPicture(向左按钮按下图片)等定义为TBitmap类型(一定要定义相对应的变量)。
　　大家一定注意到了,在所附的源程序中,定义这几个属性时,read后所指定的读取属性时对应的变量是F…,而write后指定的写入该属性时对应的不是一个变量,而是一个Set…之类的东西,这是一个自定义的过程。作为该功能的过程的定义为:
　　procedure <过程名>(Value: <被设置的属性的值的类型>)
　　因为执行写入该类属性的时候需要做其它的事情,所以不能光用一个变量来处理,应该用一个过程来处理。这中过程一般定义在protected后。在该类过程中,使用一个在⑷处这样一个语句来给TBitmap类型的变量来赋值,这是由于该类型的变量不能直接赋值而采用的。定义完这些TBitmap类型的变量的属性后,上面讲的create过程和destroy过程中就需要编写代码了。因为TBitmap也是一个类,所以在create过程中必须创建⑸,在destroy过程中必须释放掉(free)⑹。这里⑺所指的inherited语句是用于指明该过程是从祖先类类中继承来的。(这个一定不能掉)。
　　因为我们编写的是可视化控件,所以必须在控件上画图。我们这个控件的祖先类TGraphicControl中封装有一个Canvas(画布)对象,我们可以直接使用它来画图。如果你对画布的使用还不太熟悉,最好去找一本书来看一看。
　　下面要做的工作就是画图了。如何在控件上画图呢？祖先类TGraphicControl中有一个Paint事件,当控件需要重画时便会自动触发。我们现在要做的就是要为这个事件编写一段程序。首先在protected后定义一个Canvas对象。由于它是祖先类中已有的,所以不需要加任何说明⑻。我们将使用这个对象来画图。接着,就要定义一个Paint过程,编写绘制控件的代码。先在public后定义Paint过程。由于它是由祖先类触发的,而不是由用户调用的,所以后面必须加上override,否则,该控件将会由于Paint过程永远不会被调用而不成为可视化控件⑼。下面我们就来编写Paint过程的代码⑽。
　　该文章所附的源程序的Paint过程中的T_Height等变量是用来保存滚动条中按钮、滑块等的大小的,这部分程序和普通的Application中的程序差别不大,大部分都是对画布进行操作,相信大家一看就明白。值得注意的是下面对FAutoSize变量的判断⑾,FAutoSize是和该控件的属性AutoSize相关联的布尔型变量,是用来设置这个控件的大小是否随图片的大小而变化的。注意,在控件的代码中,一般都不直接调用属性,而是使用与其相对应的的变量。程序编到这里,就算是终于给自己的新控件做了一个外型了,不过它还不能滚动。现在我们来编写鼠标事件,让我们能够操纵它。鼠标事件的过程的定义和Paint过程很相似,只是后面要加上参数说明⑿,鼠标事件分为MouseDown、MouseMove和MouseUp三个,在定义后面都要加上override。接下来在后面编写它的代码。注意:这里的鼠标事件是Mouse…,而不是通常的OnMouse…。可是在⒀处的定义是干什么用的呢？这里的事件定义,都是给用户使用的,也就是说,当使用该控件时,会在Object Inspector中的Event页面中显示出来。
　　这些鼠标事件的代码也非常简单,判断鼠标的坐标,在画布上画出相应的图片等,并同时触发相应的事件。值得注意的是,在调用自定义事件时,都要先用⒁处的这样一个语句来判断用户是否已经为该事件编写代码。这一点非常重要,否则会调用出错。
　　大家注意到了,刚才所调用的事件都是自定义的,定义的方法也很简单,和定义属性差不多,只是类型时TNotifyEvent罢了。　　　　　
　　TNotifyEvent是默认事件,其定义为:
　　TNotifyEvent = procedure(Sender: TObject)
　　如果你要定义另外形式的事件,就必须这样:先在type后编写
　　<事件类型名称> = procedure(<参数>:<类型>)
例如:
　　TCustomEvent = procedure(a: Integer; b:String);
然后在public后定义:
　　 <事件名称>:<事件类型名称>
例如:
　　AnEvent: TCustomEvent;
　　看完这些,这整个程序你应该理解了吧。如果编译或运行出错,注意检查以下几点:
　　　　1、create和destroy过程中是否有inherited语句;
　　　　２、TBitmap类型的变量create和free了没有;
　　　　３、过程前有没有控件名,例如:TPigHorizontalScroller.MoseMove
　　判断鼠标是否进入或离开控件的方法:
定义如下的过程:
　　procedure MouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
　　procedure MouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
　　再在下面编写代码就行了。这个方法用于编写三态按钮很有用,有兴趣的话,(将来)可以到我的主页下载Pig VCL Package(小猪可视化控件包),参考其中的TPigButton控件。(现在还没有,但是将来有了,欢迎大家下载)
Delphi 插件创建、调试与使用应用程序扩展
 
    有没有使用过Adobe Photoshop如果用过,你就会对插件的概念比较熟悉。对外行人来说,插件仅仅是从外部提供给应用程序的代码块而已(举个例子来说,在一个DLL中)。一个插件和一个普通DLL之间的差异在于插件具有扩展父应用程序功能的能力。例如,Photoshop本身并不具备进行大量的图像处理功能。插件的加入使其获得了产生诸如模糊、斑点,以及其他所有风格的奇怪效果,而其中任何一项功能都不是父应用程序自身所具有的。
　　对于图像处理程序来说这很不错,可是为什么要花偌大的力气去完成支持插件的商业应用程序呢？假设,我们举个例子,你的应用程序要产生一些报表。你的客户肯定会一直要求更新或者增加新的报表。你可以使用一个诸如Report Smith的外部报表生成器,这是个不怎么样的解决方案,需要发布附加的文件,要对用户进行额外的培训,等等。你也可以使用QuickReport,不过这会使你身处版本控制的噩梦之中--如果每改变一次字体你就要Rebuild你的应用程序的话。
　　然而,只要你把报表做到插件中,你就可以使用它。需要一个新的报表吗？没问题,只要安装一个DLL,下次应用程序启动时就会看见它了。另外一个例子是处理来自外部设备(比如条形码扫描器)的数据的应用程序,为了给用户更多的选择,你不得不支持半打的各种设备。通过将每种设备接口处理例程写成插件,不用对父应用程序作任何变动就可以获得最大程度的可伸缩性。
入门
　　在开始写代码之前最重要的事情就是搞清楚你的应用程序到底需要扩展哪些功能。这是因为插件是通过一个特定的接口与父应用程序交互的,而这个接口将根据你的需要来定义。在本文中,我们将建立3个插件,以便展示插件与父应用程序相交互的几种方式。
　　我们将把插件制作成DLL。不过,在做这项工作之前,我们得先制作一个外壳程序来载入和测试它们。图1显示的是加载了第一个插件以后的测试程序。第一个插件没有完成什么大不了的功能,实际上,它所做的只是返回一个描述自己的字符串。不过,它证明了很重要的一点--不管有没有插件应用程序都可以正常运行。如果没有插件,它就不会出现在已安装的插件列表中,但是应用程序仍然可以正常的行使功能。
　　我们的插件外壳程序与普通应用程序之间的唯一不同就在于工程源文件中出现在uses子句中的Sharemem单元和加载插件文件的代码。任何在自身与子DLL之间传递字符串参数的应用? 都需要Sharemem单元,它是DelphiMM.dll(Delphi提供该文件)的接口。要测试这个外壳,需要将DelphiMM.dll文件从Delphi\Bin目录复制到path环境变量所包含的路径或者应用程序所在目录中。发布最终版本时也需要同时分发该文件。
插件通过LoadPlugins过程载入到这个测试外壳中,这个过程在主窗口的FormCreate事件中调用,见图2。该过程使用FindFirst和FindNext函数在应用程序所在目录中查找插件文件。找到一个文件以后,就使用图3所示的LoadPlugins过程将其载入。
{ 在应用程序目录下查找插件文件 }
procedure TfrmMain.LoadPlugins;
var
　　sr: TSearchRec;
　　path: string;
　　Found: Integer;
begin
　　path := ExtractFilePath(Application.Exename);
　　try
　　Found := FindFirst(path + cPLUGIN_MASK, 0, sr);
　　while Found = 0 do begin
　　LoadPlugin(sr);
　　Found := FindNext(sr);
end;
　　finally
　　FindClose(sr);
end;
end;
{ 加载指定的插件 DLL. }
procedure TfrmMain.LoadPlugin(sr: TSearchRec);
var
　　Description: string;
　　LibHandle: Integer;
　　DescribeProc: TPluginDescribe;
begin
　　LibHandle := LoadLibrary(Pchar(sr.Name));
　　if LibHandle $#@60;$#@62; 0 then
begin
　　DescribeProc := GetProcAddress(LibHandle, cPLUGIN_DESCRIBE);
if Assigned(DescribeProc) then
begin
　DescribeProc(Description);
　memPlugins.Lines.Add(Description);
end
else
begin
　MessageDlg(’File "’ + sr.Name + ’" is not a valid plug-in.’,
mtInformation, [mbOK], 0);
end;
end
else
MessageDlg(’An error occurred loading the plug-in "’ +
sr.Name + ’".’, mtError, [mbOK], 0);
end;
　　LoadPlugin方法展示了插件机制的核心。首先,插件被写成DLL。其次,通过LoadLibrary API它被动态的加载。一旦DLL被加载,我们就需要一个访问它所包含的过程和函数的途径。API调用GetProcAddress提供这种机制,它返回一个指向所需例程的指针。在我们这个简单的演示中,插件仅仅包含一个名为DescribePlugin的过程,由常数cPLUGIN_DESCRIBE指定(过程名的大小写非常重要,传递到GetProcAddress的名称必须与包含在DLL中的例程名称完全一致)。如果在DLL中没有找到请求的例程,GetProcAddree将返回nil,这样就允许使用Assigned函数测定返回值。
　　为了以一种易用的方式存储指向一个函数的指针,有必要为用到的变量创建一个特定的类型。注意,GetProcAddress的返回值被存储在一个变量中,DescribeProc,属于TpluginDescribe类型。下面是它的声明:
type
TPluginDescribe = procedure(var Desc: string); stdcall;
　　由于过程存在于DLL内部,它通过标准调用转换编译所有导出例程,因此需要使用stdcall指示字。这个过程使用一个var参数,当过程返回的时候它包含插件的描述。
　　要调用刚刚获得的过程,只需要使用保存地址的变量作为过程名,后面跟上任何参数。就我们的例子而言,声明:
DescribeProc(Description)
　　将会调用在插件中获得的描述过程,并且用描述插件功能的字符串填充Description变量。
构造插件
　　我们已经创建好了父应用程序,现在该轮到创建我们希望加载的插件了。插件文件是一个标准的Delphi DLL,所以我们从Delphi IDE中创建一个新DLL工程,保存它。由于导出的插件函数将用到字符串参数,所以要在工程的uses子句中把Sharemen单元放在最前面。图4列出的就是我们这个简单插件的工程源文件。
uses
Sharemem, SysUtils, Classes,
main in ’main.pas’;
{$E plg.}
exports
DescribePlugin;
begin
end.
　　虽然插件是一个DLL文件,但是没有必要一定要给它一个.DLL的扩展名。实际上,一个原因就足以让我们有理由改变扩展名:当父应用程序寻找要加载的文件时,新的扩展名可以作为特定的文件掩模。通过使用别的扩展名(我们的例子使用了*.plg),你可以在一定程度上确信应用程序只会载入相应的文件?1嘁胫甘咀?$X可以实现这个改变,也可以通过Project Options对话框的Application页来设置扩展名。
　　第一个例子插件的代码是很简单的。图5显示了包含在一个新单元中的代码。注意,DescribePlugin原型与外壳应用程序中的TpluginDescribe类型相一致,使用附加的export保留字指定该过程将被导出。被导出的过程名称也将会出现在主工程源代码的exports段中(在图4中列出)。
unit main;
interface
procedure DescribePlugin(var Desc: string);
export; stdcall;
implementation
procedure DescribePlugin(var Desc: string);
begin
Desc := ’Test plugin v1.00’;
end;
end.
　　在测试这个插件之前,要先把它复制到主应用程序的路径下。最简单的办法就是在主目录的子目录下创建插件,然后把输出路径设置为主路径(Project Options对话框的Directories/Conditionals也可以作这个设置)。
调试
　　现在介绍一下Delphi 3中一个较好的功能:从IDE中调试DLL的能力。在DLL工程中可以通过Run paramaters对话框指定某程序为宿主应用程序,这就是指向将调用DLL的应用程序的路径(在我们这个例子中,就是刚刚创建的测试外壳程序)。然后你就可以在DLL代码中设置断点并且按F9运行它--就像在一个普通应用程序中做的那样。Delphi会运行指定的宿主程序,并且,通过编译带有调试信息的DLL,把你指引到DLL代码内的断点处
改变VCL的行为--一个使用可视化元件的实例
 
　　这可能实现吗？秘密在于在控件之前抢先截获Windows消息。这可以通过使用一个叫做WindowProc的TControl属性来实现,这个属性实质上指向控件的Windows消息事件处理器(event handler)。
　　为了展示这一技术,我们将创建一个LinkedLabel控件,可以将它连接到任何TControl控件并且动态改变它的行为。TLinkedLabel由TLabel继承而来,附加4个公开的属性:
l Associate -- 将被改变行为的相连控件
l CapsLock -- 当这个Boolean属性被设置为True时,特定类型的控件将把小写键盘输入作为大写来处理。这个属性并不对所有控件有效,因为并不是所有的控件都以相同的方式相应WM_CHAR消息。经测试Edit,MaskEdit,Memo,和RichEdit控件都对CapsLock属性有响应,但是ComboBox则不响应。很明显,CapsLock属性对于很多其他控件(如Button、CheckBox等)只有很小的影响,或者没有影响。
l Gap -- LinkedLabel与相连控件的距离
l OnTop -- 这个Boolean属性决定LinkedLabel出现在相连控件的左侧还是顶端。
　　另外,TlinkedLabel将保持自身和相连控件的Enabled和Visible属性相一致。它也会保持自身和相连控件的距离和角度,也就是说,当你移动LinkedLabel时,其关联也会随之移动,反之亦然。
我们来看一下TLinkedLabel类的声明,如图1所示。
unit LinkedLabel;
interface
uses
Messages, Classes, Controls, StdCtrls;
type
　TLinkedLabel = class(TLabel)
　private
　// 相连控件.
　FAssociate: TControl;
　// 将 FAssociate 置为全大写模式
　FCapsLock: Boolean;
　// 标签与关联控件之间的距离
　FGap: Integer;
　// 标签在关联控件顶端时为true
　FOnTop: Boolean;
　// 保存 FAssociate.WindowProc的原始值
　FOldWinProc: TWndMethod;
　// 用于防止无限更新循环
　FUpdating: Boolean;
　protected
　procedure Adjust(MoveLabel: Boolean);
　procedu SetGap(Value: Integer);
　procedure SetOnTop(Value: Boolean);
　procedure SetAssociate(Value: TControl);
　procedure NewWinProc(var Message: TMessage);
　procedure Notification(AComponent: TComponent;
　Operation: TOperation); override;
　procedure WndProc(var Message: TMessage); override;
　
public
　constructor Create(AOwner :TComponent); override;
　destructor Destroy; override;
　published
　property Associate: TControl
　read FAssociate write SetAssociate;
　property CapsLock: Boolean
　read FCapsLock write FCapsLock;
　property Gap: Integer read FGap write SetGap default 8;
　property OnTop: Boolean read FOnTop write SetOnTop;
end;
　　现在让我们来仔细看看这个控件中的不同方法,先由构造器(constructor)开始。首先说明一下,当创建一个新对象时,与它相关联的所有内存都被清空。这个动作将会自动把Fassociate和FoldWinProc设置为nil,将FcapsLock、FonTop、Fupdating设置为False。所有这些都不需要在构造器中明确的初始化它们。因此,唯一需要我们在构造器中设置的就是Gap的默认值。
implementation
constructor TLinkedLabel.Create(AOwner: TComponent);
begin
　inherited;
　FGap := 8;
end;
　　现在我们来看一下Adjust方法,它负责安排LinkedLabel或者关联控件的放置(取决于MoveLabel参数的取值)。正如你将在代码中看到的,LinkedLabel与相关控件的实际位置取决于Gap和OnTop属性(见图2)。虽然我们在OnTop中只提供了两种可能的选择,不过可以很容易的对其编程以提供更多的可能性。不过,把TlinkedLabel武装到牙齿(原文是“add a lot of "bells and whistles"”,译者注)并不是本文的重点,这项任务就委托给读者们来完成吧。
procedure TLinkedLabel.Adjust(MoveLabel: Boolean);
var
dx, dy: Integer;
begin
　if (Assigned(FAssociate)) then begin
　if (FOnTop) then
begin
　dx := 0;
　dy := Height + FGap;
end
else
begin
　dx := Width + FGap;
　dy := (Height - FAssociate.Height) div 2;
end;
　if (MoveLabel) then
begin
　Left := FAssociate.Left - dx;
　Top := FAssociate.Top - dy;
end
else
begin
　FAssociate.Left := Left + dx;
　FAssociate.Top := Top + dy;
end;
end;
end;
　　现在,我们来完成Gap和OnTop属性的set方法(见图3),以便当Gap或者Onop属性被修改时我们可以改变LinkedLabel的位置。
procedure TLinkedLabel.SetGap(Value: Integer);
begin
if (FGap $#@60;$#@62; Value) then
begin
　FGap := Value;
　Adjust(True);
end;
end;
procedure TLinkedLabel.SetOnTop(Value: Boolean);
begin
　if (FOnTop $#@60;$#@62; Value) then
begin
　FOnTop := Value;
　Adjust(True);
end;
end;
现在是SetAssociate方法
procedure TLinkedLabel.SetAssociate(Value: TControl);
begin
　if (Value $#@60;$#@62; FAssociate) then begin
　if (Assigned(FAssociate)) then
　FAssociate.WindowProc := FOldWinProc;
　FAssociate := Value;
　if (Assigned(Value)) then
begin
Adjust(True);
　Enabled := FAssociate.Enabled;
　Visible := FAssociate.Visible;
　FOldWinProc := FAssociate.WindowProc;
　FAssociate.WindowProc := NewWinProc;
end;
end;
end;
　　为了便于理解,我们需要详细的讨论一下WindowProc属性。WindowProc被定义为TwndMethod类型。TwndMethod可以在Controls单元中找到,定义如下:
TWndMethod = procedure(var Message: TMessage) of object;
　　注意,FoldWinProc同样被定义为TwndMethod,并且NewWinProc方法拥有与TwndMethod相同的参数结构。这就允许我们将FoldWinProc指向WindowProc的当前值,并把WindowProc重定向到NewWinProc方法。如果WindowProc只是另一个事件属性的话,我们为什么需要使用FoldWinProc呢？因为WindowProc与其它事件属性的不同之处在于WindowProc指向一个已经存在的事件处理器。如果我们只是简单的将WindowProc指向我们的方法,这个控件将不能再对任何Windows消息产生响应。为了解决这个问题,我们在把WindowProc指向NewWinProc之前把FoldWinProc设置为WindowProc的当前值。
　　在NewWinProc中,我们通过FoldWinProc调用原先的消息处理器(message handler),并且处理特定的Windows消息。因为我们修改了关联控件的WindowProc值,因此要在把关联改变到一个新的控件之前恢复它从前的取值。
　　避免把关联控件的WindowProc属性指向一个不再存在的例程也同样重要。如同我们所见的,在析构器中调用SetAssociate(nil)将会把WindowProc恢复为初始值。
destructor TLinkedLabel.Destroy;
begin
SetAssociate(nil);
inherited;
end
　　另外,我们也不希望关联到一个不再存在控件。通过覆盖Notification方法,我们可以知道关联组件何时被销毁,从而重置关联的指针:
procedure TLinkedLabel.Notification(AComponent: TComponent;
Operation: TOperation);
begin
　if ((Operation = opRemove) and
　(AComponent = FAssociate)) then SetAssociate(nil);
end;
　　现在我们来看NewProc方法。这里,我们只是寻找发送给关联控件的特定Windows消息。认识到这一点是很重要的:虽然方法通过关联控件调用,但它实际上是LinkedLabel的一部分,例如,Self=LinkedLabel,而不是关联控件。这对为一个按钮创建onclick事件处理器来说也是一样的,onclick事件处理器是作为按钮父窗体的一部分,而不是扩充Tbutton类的新方法。
procedure TLinkedLabel.NewWinProc(var Message: TMessage);
var
Ch: Char;
begin
　if (Assigned(FAssociate) and (not FUpdating)) then begin
　FUpdating := True;
　try
　case(Message.Msg) of
　WM_CHAR:
　if (FCapsLock) then begin
　Ch := Char(TWMKey(Message).CharCode);
if (Ch $#@62;= ’a’) and (Ch $#@60;= ’z’) then
　TWMKey(Message).CharCode := ord(UpCase(Ch));
end;
　CM_ENABLEDCHANGED:
　Enabled := FAssociate.Enabled;
　CM_VISIBLECHANGED:
　Visible := FAssociate.Visible;
　WM_SIZE, WM_MOVE, WM_WINDOWPOSCHANGED:
　Adjust(True);
end;
finally
　FUpdating := False;
end;
end;
　FOldWinProc(Message);
end;
　　如果你检查一下这个例程,就会发现我们并没有花多少力气去处理Windows消息。我们只注意几个特定的消息,然后就让关联通过调用FOldWinProc正常的处理它们。在处理WM_CHAR消息的时候,我们对消息的一部分做了改变,让控件认为我们按下的是大写字母键。
　　最后,我们关心一下两个不同的消息,以确定关联控件是否被移动了。这样做的原因在于从TwinControl继承的控件会在它们被移动时接到WM_MOVE消息,而此时其它的可视控件(如一个标签)则会收到WM_WINDOWPOSCHANGED消息。程序也检查了WM_SIZE消息,原因是如果OnTop属性为False,则LinkedLabel的位置会随控件的高度而变化。
　　我们这个控件的最后一个方法是:当LinkedLabel被改变时,要在关联的什么地方作修改？当然我们不使用覆盖Tlabel的现存方法来实现它,而是要用修改关联行为的相同技术来做。注意我们不是重新定向WindowsProc属性,而是覆盖了WndProc方法。为什么把它们叫做相同的技术呢？如果你看一下TControl的构造器,你可以发现WindowProc会被初始化以指向WndProc方法。所以从本质上讲,我们覆盖的是同一种方法,不过做得更“干净”,也不用去保存WindowProc的初始值。
procedure TLinkedLabel.WndProc(var Message: TMessage);
begin
if (Assigned(FAssociate) and (not FUpdating)) then begin
　FUpdating := True;
try
　case(Message.Msg) of
　CM_ENABLEDCHANGED: FAssociate.Enabled := Enabled;
　CM_VISIBLECHANGED: FAssociate.Visible := Visible;
　WM_WINDOWPOSCHANGED: Adjust(False);
end;
　finally
　FUpdating := False;
end;
end;
　inherited;
end;
　　对于刚刚完成的控件还有最后一点需要注意。你也许发现NewWinProc和WndProc中都使用了Fupdating。这个变量被用来通知LinkedLabel和它的关联控件其它控件正在发生改变。如果你忽略了这一步,很容易造成一个无限的更新循环,或者其它无法预料的结果。下面是一个事件流程,显示为什么需要Fupdating变量。
·用户把 LinkedLabel 拖动到一个新位置。
· WndProc 接收到一个 WM_WINDOWPOSCHANGED 消息,并且触发 Adjust(False) 来移动关联控件。
·作为对关联控件调整的一部分,Adjust 把FAssociate.Left设置为新值。
· FAssociate 触发 WM_MOVE 消息,指出它已经改变了位置。
· NewWinProc 监测到 WM_MOVE 消息并调用 Adjust(True) 以修改 LinkedLabel 的位置配合关联控件的移动。
　　如你所见,在关联控件试图移动LinkedLabel之前我们没有什么机会改变关联控件的Top属性来配合LinkedLabel的新位置。通过使用Fupdating变量,关联控件不会注意到WM_MOVE消息,也不会试图调用Adjust来重新布置LinkedLabel。
一对问题
在这篇文章中我没有提及TlinkedLabel的一对问题。下面是对它们的大致说明:
　　·如果你把两个或者两个以上LinkedLabel关联到同一个控件然后释放它们之中的一个或者几个,就可能导致各种各样的问题。你可能会打断到其它LinkedLabel的关联,甚至可能导致被关联控件的WindowProc指向一个并不存在的历程。
　　·如果你把 LinkedLabel 关联到另一个窗体上的控件,那么Notification 方法在那个控件被销毁时不会被调用。当控件被关联时调用 FreeNotification 可以解决这个问题,但这并没有真正指出问题所在。真正的问题在于我们允许它被关联在其它窗体的控件上。其实我们真正想实现的是把LinkedLabel与拥有相同Parent的控件相关联。虽然这么做并不难,不过要只在对象查看器的Associate属性下拉列表中显示符合条件的控件也需要一些小技巧。
结论
　　其实结论也没多少东西。替换现存控件的WindowProc确实有它的局限性,不过这毕竟是一种非常有用的技术。我想不出什么其它合适的方法来创建一个像TlinkedLabel这样的控件,让关联控件在被移动时也一并移动LinkedLabel。我可不想去尝试并且列出这种技术其它可能的用法,因为这种可能性是无限的,它只会被一个程序员的灵活性所局限。
 
Delphi第三方控件大测评
 
古人云∶“工欲善其事,必先利其器。”
　　这句话,我想凡是用Delphi的朋友,应该都有很深切的体会吧。的确,如果Delphi没有了控件的支持,那么人气度一定会大大的降低,不会有现在这样多的Fan了,俺也就改行用BCB或VC了,呵呵。
　　但是,现在控件满天飞,不要说DSP(Delphi Super Page)了,光一个深度历险上面的控件就已经洋洋洒洒上万数了,而且每天还在更新,多恐怖啊∶)然而,选择多了以后,烦恼也就随之而来了(呵呵,如果MM也能有那么多让我挑就好了),因为无法一个个的都去试过,所以有许多的优秀控件还不是为人所知,因此我就写下了这篇文章,希望能为大家当个向导,起到一个抛砖引玉的作用吧。
　　好了,现在转入正题。首先来大体上为控件分一下类,以方便我们后面的讨论。
　　但因为控件的种类太多,所以就粗略的分为如下几个类别∶
　　---界面风格类
　　---Shell外观类
　　---Editor类
　　---Grid类
　　---DB类
　　---Report类
　　---图形类
　　---综合类
　　约定的前提是∶All FreeWare,All source.至于那些要花钱购买的商业控件,我将在后面另外进行讨论。对于文中我们所讨论的每一个控件,都会给出一个品质得分,商业控件和免费控件一视同仁,不以价格论高低,而以质量分高下:
　　
　　大体的评分标准如下:
　　一级棒的超cool控件:
　　★★★★★
　　也很不错的控件:
　　★★★★
　　虽一般但有特色的控件:★★★
　　三颗星以下的控件就不在本文的讨论范围之内了。(☆表示★的效力减半)
　　
　　还需要注意的就是,则篇文章旨在向大家推荐一些优秀的第三方控件,文中提及的所有控件都可以在www.Delphiuser.com网站上下载。
　　
　　◆首先,我们先来讨论一下免费的第三方控件(有源代码):
　　㈠界面风格类------------
　　一个优秀的软件应该具有一个优秀的操作界面,我想这应该是不容置疑的。但是用过C/C++写程序的朋友一定会有这样的感叹,作一个美观而又容易上手的界面实在太累了(除了BCB外)。但自从Delphi横空出世之后,这一切就豁然改观了。
　　这里我先为大家推荐四套优秀的界面制作控件包。
　　
　　1.FlatStyle2.1　　品质:★★★★★
　　--------------------------------- ------------------
　　评测:
　　非常非常棒的界面控件包,什么叫Cool?用过了FaltStyle后,你就知道了:)在最新的2.1版中,FlatStyle作了很大的改动,不但新增了好几个控件,还对源码作了很大幅度的修改,更加有条理了.不过,还是有几个小bug,呵呵,但无伤大雅.AWater自己又在这个基础上,修订了一下,并增添了几个控件,使用的感觉只有一个字可以形容,呵呵,爽呀!强烈推荐!
　　
　　2.JLAqua1.0 品质:★★★★
　　----------------------------------------------------
　　评测:
　　这是一个类Mac OS界面的控件包,如果你对苹果那可人的界面情有独钟的话,这个东东是你最好的选择.绝对的抢眼.但由于是1.0版,AWater用了后觉的还是意犹未尽,好象还是少了点什么.不过已经很不错了呢,向您推荐.
　　3.Platinum Controls 品质:★★★☆
　　----------------------------------------------------
　　评测:
　　又是一个类Mac OS界面的控件包,和上面的JLAqua相比较的话,主要的不同点在于这个控件包所模拟的是一种较为经典的老式的Mac OS风格界面,而JLAqua则比较新潮一些,同时这个控件包所提供的控件种类也比较少,功能也较为单一。但是,还是颇有点特色的,值得推荐。
　　
　　4.CoolForm 品质:★★★
　　--------------------------------------------------
　　评测:
　　第一次用这个家伙的时候,还真被它的名字给唬住了,后来仔细一看它的源码,才发现不过如此,其实就是一个作古里古怪的Form的东东而已,不过写得很简洁,功能也不俗,特别是他内带的属性编辑器,写得很有意思,可以根据你所提供的图片而自动的生成Mask图像。呵呵,还算不错的一个控件,用不用随你。
　　
　　㈡Shell外观类-------------
　　相信很多朋友在写程序时,并不满足Delphi提供的OpenDialog和SaveDialog吧,有时需要作一个类似资源管理器(Explorer)的东东,而Delphi提供的FileListBox和DirectoryListBox的却又太难看,太简陋。虽然Delphi提供了ShellApi.pas,但自己再从头写一个这样的Component却又太麻烦时,下面的这几个东东可以让你从多余的重复劳动中解放出来。
　　
　　1.DFS TSystemTreeView v0.95 Beta 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　说起DFS,相信凡是用Delphi的老鸟,一定不会陌生。这个控件可以算得上是精品了,AWater也就不多嚼舌了,但由于是Beta版的缘故吧,还是有些不太稳定,偶尔会出错。所以就只打了四颗星,有点委屈它了呢,呵呵。向您推荐！
　　
　　2.LsFileExplorer 2.7 品质:★★★☆
　　---------------------------------------------------
　　评测:
　　挺不错的一个控件包,唯一可惜的地方是其中的TLsDirTreeCombo部分有一个bug,就是当把TLsDirTreeCombo放在TCoolBar或TControlBar之上时,一旦width有变化,你就会发现TLsDirTreeCombo的ClickButton位置会有严重的错位。呵呵,本来AWater想给它打★★★★☆的,结果就一落千丈啦,满可惜的。如果这个bug能够修正的话,那就很不错了,不过话又说回来,毕竟是免费的吗。还是值得向您推荐。
　　㈢Editor类----------
　　有没有这样的感觉呢？Memo太简单,Richedit不好用,版本也太乱,容易出问题。想不想拥有一个象Delphi自带的Editor一样的支持语法高亮,功能又强大的编辑控件呢？请看下面两个东东吧。
　　
　　1.mwEdit 0.92a 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　这个东东可是目前免费控件中的顶级之作,拥有商业控件般的强大功能,同时又开放源代码,可是广大的Delphi程序员的福气呦！有了它,您也能够轻松的写出像Delphi自带的Editor一样的编辑器来,它除了支持Pascal语法的特殊高亮显示之外,还能够支持其它十多种的语法高亮显示。最妙的是,mwEdit居然还能够和数据库连接起来,呵呵。实在是太强大了,向您强烈推荐！
　　
　　2.unicode edit 1.0 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　这个控件是著名的JEDI项目之一,大体上和上面的mwEdit相似,不过功能还没有它那么强大,但也已经很不错了。特点是内建了超过一百个unicode(WideString)的函数,是不是很恐怖呀？呵呵,向您推荐！
　　㈣Grid类--------
　　在现实中的很多数据组织方式非常适合用Grid来表示,尤其是在一个数据量大,信息繁杂的系统中,如果没有Grid control,那将是无法想像的。然而Delphi自带的Grid,不管是StringGrid,还是DrawGrid,或DBGrid,都还嫌不够强大。下面的几个Grid控件也许会让你感到兴奋的。
　　
　　1.TStringAlignGrid 2.0 品质:★★★★
　　-----------------------------------------------------
　　评测:
　　这个控件虽然是个免费的东东,但是可以看出作者还是很用心的。功能不能说非常强大,但却够用,只要你不是做什么特别的东西,这个控件绝对是你最好的选择。而且附带了一份详细的help文件,值得推荐。
　　
　　㈤DB类------
　　这方面好像没有什么特别突出的免费控件,挑来捡去的,就只找到这一个,呵呵。
　　
　　1.TkbmMEMTABLE v. 2.33 品质:★★★★
　　---------------------------------------------------
　　评测:
　　一个不错的内存表控件。如果你正急需这方面的控件的话,就试试吧。值得推荐。
　　㈥Report类----------
　　说到报表,许多朋友的心里一定会翻涌起种莫名的滋味吧。在品尝过QuickReport带来的尴尬之后,寻找一个优秀的,功能出众的报表控件就一直是我们孜孜以求的,下面为大家推荐两个非常优秀的报表控件,而且还都是我们国人自己开发的,呵呵,掌声欢迎:
　　
　　1.eReport 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　非常优秀的报表控件,完全为了中国的报表格式所设计,同时内带一个报表编辑器,工作模式类似于套打,本来用QuickReport需要干一个月的活,用eReport三天就可以搞定了,呵呵。不过,需要指出的是,eReport现在还不能支持报表嵌套,这不能不说是一种遗憾。(居作者王寒松自己说,报表嵌套的部分本来是已经写好了的,可惜不当心给搞丢了,后来也就一直没有写下去了。呜呜呜呜......)
　　
　　2.rmachine 品质:★★★★
　　-----------------------------------------------------
　　评测:
　　说起这个东东,可能知道的人并不是很多。但说起FastReport,相信大家应该都有所耳闻吧。这个控件就是在著名的FastReport的基础上发展起来的,修正了一些Bug,增强了许多功能。挺不错的,呵呵。推荐！
　　
　　㈦图形类--------
　　应该说图形类控件范围太大,从一般的Image到Chart,还有各种各样的Effect.内容实在太多太广,我就简单的挑几个最有特色的介绍个大家吧。
　　
　　1.FastLib 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　非常非常优秀的图形库,提供了大量的图形处理函数,功能之强大甚至连一些商业控件都自愧不如。用它作出的各种的图形特效,呵呵,只能说一个绝字。向您强烈推荐！
　　
　　2.GLScene(OpenGL Component) 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　有没有试过这样写OpenGL程序:选一个模型,然后为它添加灯光,纹理。实时调整大小,位置。不满意？就换一个模型,重来一次。一切好像不是在写程序,而好像在3DSMax中现场编辑的感觉一样。怎么样,奇妙吧,还不快去试试。呵呵,向您强烈推荐！
　　
　　3.TPicShow v2.3 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　这个小东东,提供了一百二十二种的图形特效,而且效率也不错。剩去了你的大量查书,编码的时间,快来试试吧,给你的程序里的图形加上些切换特效,让你的用户啧啧称赞你的程序界面。呵呵,向您强烈推荐！
　　
　　㈧综合类--------
　　综合类的控件包,就是指那些囊括了各种类型的控件的大杂烩,下面为大家列举几个免费控件中优秀的综合类控件包:
　　
　　1.RxLib 2.75 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　说起这个家伙,大家应该早巳如雷贯耳了吧？呵呵,所以AWater就不多说了,可别告诉我说你还不知道,向您强烈推荐！
　　
　　2.RALib 1.52a 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　这个东东和RxLib虽然名字差了一个字,但功能却比RxLib还要强,只不过在国内的知名度没有RxLib那么响罢了,去试试吧,保证你会惊喜万分的。向您强烈推荐！
　　
　　3.DevExpress Forum Library 2.0 品质:★★★★☆
　　-----------------------------------------------------
　　这个控件包是著名的Delphi控件厂商Developer Express出品的一套免费且有源代码的扩件包?1蠨eveloper Express的一贯风格,这个控件包处处透露出一股“贵族”的味道,其中包含了许多的优秀控件,给人的感觉可一点都不像是免费的控件,如果你看一下它的源码,更有这种感觉,条理清晰,结构合理。不愧是名家出手。呵呵。不过,这么好的东东也不是随便就能得到的,首先得参加Developer Express的Forum,在他们那儿注册之后(当然是免费的),才可以得到。快去注册吧。强烈推荐！
　　
　　好了,看过了上面的这些免费的第三方控件之后,下面让我们来看一下商业控件的情形吧,我们同样也把商业控件分成8个类别,进行一下评测,来和前面推荐的免费的控件来比一比看,到底是谁利害,商业控件可不一定能全占优呢！
　　
　　◆商业控件(可是要花钱去买的哟):
　　㈠界面风格类------------
　　1.DevExpress Bars 3.1 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　是由著名的Delphi控件厂商Developer Express出品的类Word2000界面的控件组。功能之强大,界面之华丽,呵呵,简直是一言难尽呀。我甚至都有些怀疑Dephi的菜单和工具栏就是用这个东东作的。实在太cool了,相比之下,免费的ToolBar97,简直就成了鸡胁,食之无味啊。呵呵,如果你想作出一个精美的流行界面,这是你最好的选择,而且也能剩下你的大量重复劳动时间。强烈推荐！！！
　　
　　2.ExtarPack 1.5 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　如果你想把自已的程序界面作很另类的话,这个东东就是最好的选择了,呵呵。可以把你的程序武装到牙齿,如果别人不知到的话,肯定以为你再用一个什么的新式操作系统呢。呵呵,想给别人一个惊喜吗,就用ExtarPack吧。会让你满意的很。不过,我可要事先提醒你,这个东东的耗费系统资源量也不小哟。强烈推荐！
　　
　　3.FormContainer 1.5 品质:★★★★★
　　-----------------------------------------------------
　　你不会没用过Delphi自带的TeeChart吧,这个东东就是出TeeChart的那个公司的两个程序员写的,质量吗,呵呵,一级棒的呢。绝对不给TeeChart丢脸。知道一个人为什么会在电脑面前傻傻的发呆吗？多半是看到了用FormContainer写的程序了。呵呵。真的绝了,绝对经典的界面风格,让你意想不到的一种惊喜。AWater很配服能写出这个控件的程序员,非常了不起。可惜搞不到源码,不然一定要好好研究一下。向您强烈推荐！！
　　
　　㈡Shell外观类-------------
　　1.Shell Control Pack VCL v1.5 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　关于这个控件,AWater也就不想多费话了。只想说一句:用着的感觉就好像在用资源管理器(Explorer)一样。呵呵,非常非常的棒。向您强烈推荐！！
　　㈢Editor类----------
　　1.Dream Memo 3.1 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　著名的Delphi控件厂商“梦之队”Dream Company出品的强大的编辑控件。应该说各方面都非常优秀。至少在AWater没有使用mwEdit之前一至认为它是最好的,现在吗,嘿嘿,最好的当然就论不到它了。不过,的确非常强大,可惜这个东东写的太庞杂。所以吗,Bug也比较多。但还是值得向您推荐的。
　　
　　2.PlusMemo 5.2 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　这个控件可是元老了,功能强大。很有特色。很有自已的风格,也支持数据感应。而且作的也很小巧。非常不错。向您强烈推荐！！
　　㈣Grid类--------
　　1.DevExpress ExpressQuantumGrid 2.1 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　又是由著名的Delphi控件厂商Developer Express出品的超级Grid控件。主要应用于数据库的操作使用方面。功能强悍,有许多的“独门武功”。呵呵,如果借用围棋的段位来评分的话,这个控件的水平恐怕还在九段之上。堪称超一流。就算是同样的商业控件中,在操作数据库方面,比ExpressQuantumGrid强的恐怕还没生出来。如果再配上同门所出的dxTreeList,dxPrintSystem,可真的是打遍天下无敌手了。而且是百分之一百的纯VCL写成的。是不是COOL呆了,呵呵。向您强烈推荐！！！！！
　　
　　2.TopGrid 2.01 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　这个控件虽然在操作数据库功能方面没有像前面的DevExpress ExpressQuantumGrid那样犀利。但它却适应面很广,可以胜任StringGrid,DrawGrid,DBGrid的所有工作,不像ExpressQuantumGrid只适用于数据库操作。而且TopGrid的界面非常的Cool,有点像PowerBuild里的DataWindow的感觉,而且是更加美观。功能十分灵活,可以非常方便的操作Grid中的每一个Cell,唯一的缺点是编译出来的EXE文件大了点,不过用ASPack压一下就可以两全了,呵呵。向您强烈推荐！！！
　　
　　3.XLGrid 1.62 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　用这个控件让我想起了MS的Excel,呵呵。强大,强大,还是强大。可惜不支持数据库操作。在它的主页上有预发布2.0的实现功能计划书,AWater看了后,大流口水,太Cool了,可惜还没发布。不过这个1.62版的,巳经很爽了。向您强烈推荐！！！
　　㈤DB类------
　　实在太多太多了,从高端的ASTA到性能全面的DBISAM,从DAO到Topaz,还有大名鼎鼎的InfoPower,实在是太多了,而且个个都是五星级的。AWater就不写了,反正这方面,是商业控件全面胜出。呵呵。
　　㈥Report类----------
　　1.ReportBuilder 5.0 品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　非常非常强大的报表控件,不要问我它到底强大到如何程度,因为这估计得整整写上五六千字才能向你介绍清楚。如果你正在为手头缺少一个功能强大,适用面广报表控件时,那么就只有它了,这是你最好的选择。可以说,只要你想得到,它基本都作到的。向您强烈推荐！！！
　　
　　2.HTMLReport 品质:★★★★☆
　　-----------------------------------------------------
　　评测:
　　放上这个东东,可能有凑数之嫌。不能说功能非常非常强大。但你看它的名字,里面有个非常时兴的字眼:HTML。呵呵,对了,它就是作这个用的。如果你有这方面的需要,找它就没错了。总体性能也很不错。当然还没有强大到像上面那个REportBuilder一样恐怖。向您强烈推荐！！
　　㈦图形类--------
　　1.Pegasus公司的系列图形控件品质:★★★★★
　　-----------------------------------------------------
　　评测:
　　Pegasus公司出品过许多知名的图形控件,比如像FXTools,ImagN’之类大家都早巳有所耳闻的超级控件。如果你对图形处理方面有较为高的要求,则应该考虑一下Pegasus 公司出品的这些一流的控件。可不是一般的免费控件可以替代的哟。向您强烈推荐！！
　　㈧综合类--------
　　综合类的我就不写测评了,反正无论是恐龙级的LMD,AHM2000,还是RZLIB,或是精致的1stClass。强大的功能和繁多的控件,都不是免费的控件包可以相提并论的,用的时侯,唯一让我担心的,就是我倒底该用哪一个好呢？呵呵,这岂不也是一种烦恼吗:)
　　
　　比较之下,我想大家心里都有了一个底了吧。在以上免费控件和商业控件的共八个大类的评测下,应该说商业控件占了绝对的优势,只除了一个Editor类,免费控件可以和商业控件一较高下之外,其余的都是有一定的差距。特别是在DB类方面,免费控件一方死的最残,呵呵。不过话说回来,天下到底没有白吃的午餐,好东西总还是要花钱去买的吗。但是,最后我们可以得出这样一个结论,虽然商业控件功能强大,品质优秀。但是,在你没有哪么多的资金去购买,或你对程序的某方面性能要求并不是非常苛刻时,你完全可以考虑使用一些优秀的第三方免费控件,或以之为蓝本在这个基础上进行二次开发,来达到你的设计要求,这也是一个非常不错,而且也很省钱的方案吧:)
　　从上面的论述中,大家应该可以了解到了一些关于delphi的第三方控件的资料了,不过AWater在这里要提醒大家的是,控件虽好,但也不能滥用。更不能什么都依靠控件,一个好的程序员,不但要会用,更要会自己写。有空多研究一下优秀控件的源码,对水平的提高是大有帮助的,也能更加深入的理解面向对象编程的机制。希望有朝一日,我们中国人也能写出像delphi的优秀程序来,让满世界的老外为我们来开发第三方的控件,呵呵呵.....
 在Delphi中使用IP控件
 
在网络程序中,我们常常碰到需要用户输入IP地址的情况。然而Delphi并没有为我们提供可以用于输入IP串的控件,于是我们只好用Tedit控件(单行文本框)来接受用户输入的IP串。但是,使用Tedit来输入IP串并不是一个好的主意,因为处理起来非常不方便。事实上,在我们的身旁有一个专门用来输入IP串的Windows控件,该控件如图所示。IP控件会拒绝非法的IP串(在每个部分只能输入0..255之间的数字);它让你可以轻松地获取控件中的IP串所对应的IP值(32位整数),这省去了IP串和IP值之间相互转换的麻烦;此外,你还能限制IP控件中所能输入的IP的范围。在本文中,我将向大家介绍如何在我们的Delphi程序中使用Windows的IP控件。
　　 Windows中有两个非常重要的动态联结库:commctrl.dll和comctl32.dll,它们是Windows的自定义控制库(Windows Common Controls)。自定义控制库中包含了许多常用的Windows控件,如Statusbar,Coolbar,HotKey等;在Delphi中,这些控件大多数都已被包装成可视化控件了。在Microsoft推出Internet Explorer 3之后,自定义控制库中新增了一些控件,其中就包括Windows的IP控件(IP Address edit control)。
　　初始化Windows自定义控制库
　　 Windows提供了两个API函数,InitCommonControls和InitCommonControlsEx,用来初始化自定义控制库。从名字我们不难看出这两个API函数的关系:后者是前者的增强。如果你希望在程序中使用IP控件,你必须用InitCommonControlsEx来完成对自定义控制库以及类的初始化。函数InitCommonControlsEx的原型如下(Pascal语法):
　　 ... ...
　　创建IP控件
　　 ... ...
　　使用IP控件。在程序中,我们通过向IP控件发送消息来与它通讯。IP控件可以响应的消息有以下6个,这些消息及它们的含义,见下表:
　　 ... ...
　　若想要获取IP控件中IP串所对应的IP值,你应该向IP控件发送IPM_GETADDRESS消息,并且需要把一个32位整数的地址作为SendMessage的最后一个参数。
　　 ... ...
　　 IP控件的通知消息
　　当IP串被改动后或者输入焦点发生了转移,IP控件就会向它的父窗口发送通知消息IPN_FIELDCHANGED。在大多数情况下,我们都可以忽略此通知消息。以下是处理通知消息IPN_FIELDCHANGED的一个示例:
procedure Tform1.WndProc(var Msg: TMessage);
var p:PNMHDR;
begin > inherited;
if Msg.Msg=WM_NOTIFY
then begin
p:=Pointer(Msg.lParam);
if p^.code=IPN_FIELDCHANGED
then begin
{…
处理IP控件的IPN_FIELDCHANGED通知消息
…}
end;
end;
end;
 
TList的用法
 
　　TList是一个很好的东东,有了它我们不再去费尽心思地写什么列表类,直接用它就行了,下面的例子示范了怎样建立一个TList并插入两条记录,这些记录将输出在PaintBox上。
C++ Builder
请参照Delphi的例子
Delphi
procedure TForm1.FormButton1Click(Sender: TObject);
type
PMyList = ^AList;
AList = record
I: Integer;
C: Char;
end;
var
MyList: TList;
ARecord: PMyList;
B: Byte;
Y: Word;
begin
MyList := TList.Create;
New(ARecord);
ARecord^.I := 100;
ARecord^.C := Z;
MyList.Add(ARecord); //加入一个100的整数和Z字符
New(ARecord);
ARecord^.I := 200;
ARecord^.C := X;
MyList.Add(ARecord); //加入一个200的整数和X字符
Y := 10;
for B := 0 to (MyList.Count - 1) do
begin
ARecord := MyList.Items[B];
Canvas.TextOut(10, Y, IntToStr(ARecord^.I));
Y := Y + 30;
Canvas.TextOut(10, Y, ARecord^.C);
Y := Y + 30;
end;
for B := 0 to (MyList.Count - 1) do
begin
ARecord := MyList.Items[B];
Dispose(ARecord);
end;
MyList.Free;
end;
 RichEdit的自动格式化
 
这是一个注册EXE,OBJ,BIN三种类型文件当其被RichEdit打开时会自动转换为16进制显示的例子
C++ Builder
请参照Delphi的例子
Delphi
第一:要从TCoriversion派生出一个新类
第二:重载CorrvertReadStream函数
第三:在主窗体的OnCreate函数中登记文件类型。用RichEdit的.RegisterConversionFormat函数
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, Forms, Dialogs,
Menus, StdCtrls, ComCtrls;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
MenuFile: TMenuItem;
MenuOpen: TMenuItem;
MenuSaveAs: TMenuItem;
N1: TMenuItem;
MenuExit: TMenuItem;
OpenDlg: TOpenDialog;
SaveDlg: TSaveDialog;
Rich: TRichEdit;
StatusBar: TStatusBar;
procedure FormCreate(Sender: TObject);
procedure MenuOpenClick(Sender: TObject);
procedure MenuSaveAsClick(Sender: TObject);
procedure MenuExitClick(Sender: TObject);
procedure MenuPopupPopup(Sender: TObject);
procedure MenuSelectAllClick(Sender: TObject);
procedure MenuCopyClick(Sender: TObject);
private
procedure Progress(Address:LongInt);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
type
THexConversion = class(TConversion)
public
function ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): integer; override;
end;
// This implements a callback procedure used by TRichEdit when loading
// a file. Gets called repeatedly until stream is empty.
//
function THexConversion.ConvertReadStream(Stream:TStream; Buffer:PChar;
BufSize:integer): intege
var s:string;
buf:array[1..16] of char;
i,n:integer;
begin
Result := 0;
if BufSize <= 82 then Exit;
s := Format(;%.5x ,[Stream.Position]);
n := Stream.Read(buf,16);
if n = 0 then Exit;
for i := 1 to n do
begin
AppendStr(s,IntToHex(ord(buf[i]),2)+ );
if i mod 4 = 0 then AppendStr(s, );
end;
AppendStr(s,StringOfChar( ,62-length(s)));
for i := 1 to n do
begin
if (buf[i] <#32) or (buf[i] > #126) then
buf[i] := .;
AppendStr(s,buf[i]);
end;
AppendStr(s,#13#10);
StrPCopy(Buffer,s);
Result := length(s);
if Stream.Position and $FFF = 0 then MainForm.Progress(Stream.Position);
end;
procedure TMainForm.Progress(Address:LongInt);
begin
StatusBar.SimpleText := Reading... $+IntToHex(Address,5);
StatusBar.Update;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Rich.RegisterConversionFormat(bin,THexConversion);
Rich.RegisterConversionFormat(obj,THexConversion);
Rich.RegisterConversionFormat(exe,THexConversion);
end;
procedure TMainForm.MenuOpenClick(Sender: TObject);
var fname:string;
begin
if OpenDlg.Execute then
begin
try
Screen.Cursor := crHourglass;
fname := ExtractFileName(OpenDlg.Filename);
StatusBar.SimpleText := Reading...;
Rich.Lines.Clear;
Application.ProcessMessages;
try
Rich.Lines.LoadFromFile(OpenDlg.Filename);
StatusBar.SimpleText := fname;
except on E:EFOpenError do
begin
StatusBar.SimpleText := ;
MessageDlg(Format(Cant open file %s.,[fname]),mtError,[mbOk],0);
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;
end;
procedure TMainForm.MenuSaveAsClick(Sender: TObject);
begin
SaveDlg.Filename := ChangeFileExt(OpenDlg.FileName,.txt);
if SaveDlg.Execute then
Rich.Lines.SaveToFile(SaveDlg.FileName);
end;
procedure TMainForm.MenuExitClick(Sender: TObject);
begin
Close;
end;
end.
 RichEdit中实现查找功能
 
　　RichEdit有一个FindText函数,极大方便了我们为RichEdit编制查找功能。下面的片断取自于Delphi帮助中的范例。
C++ Builder
请参照Delphi的例子
Delphi
procedure TMainForm.FindDialogFind(Sender: TObject);
var
FoundAt: LongInt;
StartPos, ToEnd: integer;
SearchFlag: TSearchTypes;
begin
if frMatchCase in FindDialog.Options then
SearchFlag:=[stMatchCase];
if frWholeWord in FindDialog.Options then
SearchFlag:=SearchFlag+[stWholeWord];
with RichEdit do
begin
StartPos:=SelStart+SelLength;
ToEnd:=Length(Text) - StartPos;
FoundAt:=FindText(FindDialog.FindText, StartPos, ToEnd, [stMatchCase]);
if FoundAt<>-1 then
begin
SetFocus;
SelStart:=FoundAt;
SelLength:=Length(FindDialog.FindText);
end
else
begin
SelLength:=0;
SelStart:=StartPos;
Application.MessageBox(PChar(找不到+FindDialog.FindText),查找失败,0);
end;
end;
end;
 让按钮连续工作--兼谈Delphi元件开发
 
　　不知大家是否见过一种按钮,当它被按下的时侯,它所执行的功能(如向上或向下)就持续执行,当松开时,就停止,其实滚动棒两边的按钮就是这样的。下面我们来做个按钮元件,让它也有这样的功能。
　　在我们做元件之前,让我们了解一下它的原理,要想实现这个功能,我们可以做一个定时器,把触发一次的代码写在定时器的触发代码里面,其实我们要实现的功能很简单,就是让一个按钮按下时,EDIT1里面的数字就一直加一,当松开时就停止。先向Form1里面放一个Edit,然后放一个Timer,写下如下代码procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
edit1.text:=inttostr(strtoint(edit1.text)+1);
except
edit1.text:=1;
end;
end;
　　然后,我们还需要有个Button,让按钮按下时激活时间触发器,当按钮松开时关闭时关闭时间触发器就可以了。我们再写下如下代码
procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
timer1.enabled:=true;
end;
procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
timer1.enabled:=false;
end;
　　这样,我们想要的功能就做成了,非常简单,是不是？但是,如果要做许多这样的按钮,我们势必要重复写这样的代码很多遍,那编程岂不变成打字了,而且还容易出错,这是我们所不愿看到的。下面,我就这个功能,把它做成一个可重复利用的元件,这样,每当我们想要这个功能时,我们便可以从元件板里面把它放到Form上,只写我们想要做的代码,就可以了。
　　首先要为我们的按钮取一个名字,就叫TTimerButton吧,然后从元件板里选个已经存在的元件,从头做元件固然可以,但是会做许多无用功,本来人家Delphi已经实现的功能,我们还重复去写它做什么,又浪费时间,又容易出错,其实,OOP编程的根本就是让大家从重复的劳动中脱离出来,写程序时只写有用的代码,其余的事情呢,就交给Delphi去做,不然,我们花了这么多精力来学它干什么,不就是为了省点时间吗,否则还不如拿汇编来干呢. 书归正转,我们选了个元件,TButton 蛭颐且龅谋旧砭褪歉鯞utton,所以从TButton开始着手是最合适的,你完全可以从其他种类的按钮开始。选定了父元件后,让我们来想想要加哪些自己的东西呢,第一个是要加个定时器,但是,定时器是与Button固化在一起的,所以我们把它加在私有部分,但是,定时器的时间是要可调的,我们把它声明成一个属性。在Delphi里,所有的属性都需要声明并实现它的读写方法,否则,就无法存取这个属性,关于属性的声明语法,请参见代码　　其中TimerTriger是时间触发器执行时的过程
TTimerButton = class (TButton)
private
FTimer :TTimer;
FInterval :Integer;
protected
procedure TimerTrigger(Sender: TObject);
function SetInterval(Value :integer);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
published
property Interval :Integer read FInterval write SetInterval default 200;
end;
　　第二,我们需要创建一个事件,以便在实际应用时,将代码写在这个事件里面执行。其实一个事件也是一个Property,它的声明语法请参见以下代码
TTimerButton = class (TButton)
private
FOnPush: TNotifyEvent;
published
property OnPush: TNotifyEvent read FOnPush write FOnPush;
end;
　　对于Delphi中的一个类来说,都需要有构造函数和析构函数,我们这个类也不例外,下面的代码就是加上构造函数和析构函数的完整声明
TTimerButton = class (TButton)
private
FTimer :TTimer;
FInterval :Integer;
FOnPush :TNotifyEvent;
protected
procedure TimerTrigger(Sender: TObject);
function SetInterval(Value :integer);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
Constructor Create(AOwner:TComponent); override;
Destructor Destroy; override;
published
property Interval :Integer read FInterval write SetInterval default 200;
property OnPush :TNotifyEvent read FOnPush write FOnPush;
end;
　　下面,就该写代码了,首先写构造函数与析构函数,当创建这个按钮(类)时,类里面的定时器同时也被创建,但处于非激活状态,同时,缺省值也应被置入;当这个按钮(类) 被消除时,定时器也应被释放。下面的代码就是构造函数与析构函数
　　
Constructor TTimerButton.Create(AOwner: TComponent);
begin
Inherited Create(AOwner);
FTimer:=TTimer.Create(self);
with FTimer do begin
Ontimer:=TimerTrigger;
Enabled:=false;
end;
FInterval := 200;
FTimer.Interval := 200;
OnMouseDown:= MouseDown;
OnMouseUp := MouseUp;
end;
Destructor TTimerButton.Destroy;
begin
FTimer.free;
inherited Destroy;
end;
　　下面,就该写属性的读写方法了,属性的读写方法比较简单,只要把值写入对应的字段就可以了,下面,就是这部分代码
procedure TTimerButton.SetInterval(Value :integer);
begin
FInterval:=value;
FTimer.Interval:=value;
end;
　　这样,元件的框架就搭好了,下面要做的工作,就是把我们刚开始的工作在做一遍,这比较容易,请参看下面的代码,其中TimerTrigger执行的是,判断是否写了事件代码,如果写了就执行。
procedure TTimerButton.TimerTrigger(Sender: TObject);
begin
if assigned(FOnPush) then
FOnPush(self);
end;
procedure TTimerButton.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FTimer.enabled:=true;
end;
procedure TTimerButton.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FTimer.enabled:=False;
end;
　　最后,是元件的注册部分,注册表示将这个元件加到元件表的位置,调用一个RegisterComponent函数即可,代码如下:
procedure Register;
begin
RegisterComponents(Tang, [TRotatePicture]);
end;
　　然后在加上文件的头,我们这个元件就做成了,使用Delphi的增加元件功能将元件加入元件板,新开始一个Form测试,完全实现了我们想要的功能,成功地将比较繁琐的代码,采用元件的形式了封装起来。
　　这一次,我们成功地运用ObjectPascal语言实现了代码的封装,把比较繁琐的代码做到了元件里面,如此看来,用Delphi开发元件其实也不是很困难的事情,但愿我的这一篇文章能给大家起个抛砖引玉的作用,祝愿大家写出更加出色的元件来
　　评语:但是由于Windows限制每个窗体TIMER的投递个数,这样作的话Button一多就可能让你的程序不工作,这个Tip简述了制作构件的方法,但这样做成的构件不安全!
 在Listboxes中加背景图
 
1. 建立一个窗体
2. 放一个ComboBox和Listbox
3. 改变Component的Style为csOwnerDrawVariable和ListBox的Style为lbOwnerDrawVariabble。
4. 声明5个TBitmap的全局变量
5. 覆盖Form的OnCreate.
6. 覆盖ComboBox的OnDraw.
7. 覆盖ComboBox的OnMeasureItem.
8. 释放资源在Form的OnClose.
下面给出完整的主程序源程序:
unit Ownerdrw;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ComboBox1: TComboBox;
ListBox1: TListBox;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
TheBitmap5 : TBitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
TheBitmap1 := TBitmap.Create;
TheBitmap1.LoadFromFile(C:\delphi\images\buttons\globe.bmp);
TheBitmap2 := TBitmap.Create;
TheBitmap2.LoadFromFile(C:\delphi\images\buttons\video.bmp);
TheBitmap3 := TBitmap.Create;
Th tmap3.LoadFromFile(C:\delphi\images\buttons\gears.bmp);
TheBitmap4 := TBitmap.Create;
TheBitmap4.LoadFromFile(C:\delphi\images\buttons\key.bmp);
TheBitmap5 := TBitmap.Create;
TheBitmap5.LoadFromFile(C:\delphi\images\buttons\tools.bmp);
ComboBox1.Items.AddObject(Bitmap1: Globe, TheBitmap1);
ComboBox1.Items.AddObject(Bitmap2: Video, TheBitmap2);
ComboBox1.Items.AddObject(Bitmap3: Gears, TheBitmap3);
ComboBox1.Items.AddObject(Bitmap4: Key, TheBitmap4);
ComboBox1.Items.AddObject(Bitmap5: Tools, TheBitmap5);
ListBox1.Items.AddObject(Bitmap1: Globe, TheBitmap1);
ListBox1.Items.AddObject(Bitmap2: Video, TheBitmap2);
ListBox1.Items.AddObject(Bitmap3: Gears, TheBitmap3);
ListBox1.Items.AddObject(Bitmap4: Key, TheBitmap4);
ListBox1.Items.AddObject(Bitmap5: Tools, TheBitmap5);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
TheBitmap1.Free;
TheBitmap2.Free;
TheBitmap3.Free;
TheBitmap4.Free;
TheBitmap5.Free;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
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;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
end;
end;
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:
Integer; var Height: Integer);
begin
height:= 20;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Bitmap: TBitmap;
Offset: Integer;
begin
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;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
end;
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
height:= 20;
end;
end.
//该窗体的DFM文件
object Form1: TForm1
Left = 211
Top = 155
Width = 435
Height = 300
Caption = Form1
Font.Color = clWindowText
Font.Height = -13
Font.Name = System
Font.Style = []
PixelsPerInch = 96
OnClose = FormClose
OnCreate = FormCreate
TextHeight = 16
object ComboBox1: TComboBox
Left = 26
Top = 30
Width = 165
Height = 22
Style = csOwnerDrawVariable
ItemHeight = 16
TabOrder = 0
OnDrawItem = ComboBox1DrawItem
OnMeasureItem = ComboBox1MeasureItem
end
object ListBox1: TListBox
Left = 216
Top = 28
Width = 151
Height = 167
ItemHeight = 16
Style = lbOwnerDrawVariable
TabOrder = 1
OnDrawItem = ListBox1DrawItem
OnMeasureItem = ListBox1MeasureItem
end
end
 自动隐藏的声象按钮
　　随着计算机的日益普及和多媒体技术的不断发展,多媒体计算机辅助教学(MCAI)软件正改变人们传统的学习方式。MCAI软件的操作界面赏心悦目,特别是具有音响效果且能自动隐藏的图象按钮或菜单,图、文、声并茂,确实为软件添色不少,深受用户喜爱。以下介绍用Delphi实现上述功能的技术。
 
　　准备工作
　　建好应用软件主目录C:\AutoHide及其子目录Images 和Sounds。作为软件主界面的背景图象的位图文件Background.bmp,及作为按钮图象的位图Chimera.bmp都存入Images目录中。将声音文件Growl.wav存入Sounds目录。
　　图象按钮
　　1．启动Delphi3.0IDE,新建项目AutoHide.dpr,主窗体单元命名为Main.pas,存入C:\AutoHide目录。在主窗体上放入三个TImage组件,主要属性按表1设置。
　　表1主窗体和各组件属性设置
组件    属性    设置
Form1    Caption    AutoHideButton
Name    MainForm
Image1    Align    alClient
Name    BackgroundImage
Picture    (TBitmap)
Stretch    True
Visible    True
Image2    Align    alNone
Name    PictureImage
Picture    (TBitmap)
Stretch    True
Transparent    True
Visible    False
Image3    Align    alNone
Cursor    crHandPoint
Name    ButtonImage
Picture    (None)
Stretch    False
　　BackgroundImage的Picture属性装入Background.bmp,PictureImage 的Picture属性装入Chimera.bmp。ButtonImage重叠于PictureImage之上,置于背景图象的特定位置。
　　2．建立ButtonImage的OnMouseMove事件,当鼠标移至其上时PictureImage显现:
PictureImage.Visible:=True;
　　3．建立BackgroundImage的OnMouseMove事件,当鼠标移开ButtonImage时PictureImage隐藏:
    PictureImage.Visible:=False;
　　4．创建ButtonImage(注意:不是PictureImage)的OnClick事件,以响应鼠标点击完成规定动作。不失一般性,在此仅显示一行信息。
    MessageBeep($FFFF);
    ShowMessage(WelcometotheDelphi.);
　　5．编译、运行。软件启动后进入主? ,在背景图象上没有菜单,也没有按钮,如图1所示。
　　当鼠标移至猎豹头部时,豹头变成狮头按钮,且鼠标变为手指,如图2所示。
　　当鼠标移出狮头范围时,狮头隐藏,恢复主界面图象。若点击狮头按钮,则出现信息窗(见图3):
WelcometotheDelphil.
　　音响效果
　　如果要在上述“自动隐藏”按钮加上音响效果,可以在狮头出现时利用PlaySound()播放一个声音文件(.wav)。
　　但是,不能将PlaySound()直接加入ButtonImage 的OnMouseMove事件中。这是因为,当鼠标在按钮上移动时,PlaySound()会不断重复执行。务必确保按钮出现时声音文件只播放一次！须如此这般:
　　1.为调用PlaySound()函数,并控制声音文件的播放次数,在Main.pas单元的implementation段加入:
    uses
    mmsystem;
    var
    noHide:Boolean;
　　2.创建主窗体MainFrom的OnCreate事件处理程序,以初始化noHide变量:
    noHide:=True;
　　3.将ButtonImage的OnMouseMove事件处理程序改为(begin与end之间的语句):
    ifnoHidethen
    begin
    PictureImage.Visible:=True;
    PlaySound(Sounds\Growl,0,SND_ASYNC);
    noHide:=False;
    end;
　　4.将BackgroundImage的OnMouseMove事件处理程序改为(begin与end之间的语句):
    PictureImage.Visible:=False;
    noHide:=True;
　　重新编译和运行。此时,当鼠标移至猎豹头部时,张牙舞爪、咆哮着的狮头出现,惊心动魄。
　　以上例程编译和运行环境是Delphi3.0和中文Windows 98。
DELPHI中利用TreeView控件建立目录树
Rainbow的话:关于TreeView的使用,还可以参看:联合使用TreeView 组件
　　TreeView是一个显示树型结构的控件,通过它能够方便地管理和显示具有层次结构的信息,是Windows应用程序的基本控件之一。DELPHI虽然具有比较强大的文件管理功能,提供了多个用于文件管理的标准控件,如DriveComboBox、DirectoryListBox、FileListBox等,通过设置它们的属性,使其建立起联系,甚至不用编写一行程序,我们就可以实现在不同的目录之间进行切换,然而这样的目录切换只适用于进行文件的查找定位,而不能方便地进行目录的浏览,例如我们要从c:\windows目录转到c:\program files目录,就必须返回到根目录才能进行切换,而不能象Windows资源管理器那样任意地在不同的目录之间进行浏览与切换。
　　要实现在不同目录之间任意切换和浏览,还是需要使用TreeView控件,以下程序就利用DELPHI的TreeView控件来建立目录树。
　　在该程序中采用的各部件以及界面设计如下图所示:
 
　　各部件的主要属性设置如下:
 
　　该程序利用DriveCommboBox控件来获得系统具有的驱动器,并以此作为目录树的最上层,利用FileListBox控件,通过设置其Filetype属性为fdDirectory,可以获得所需的子目录,在TreeView控件的OnExpanding事件中将得到的子目录加到该控件的某一节点下。
　　整个程序的源代码如下:
　　unit main;
　　interface
　　uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls, FileCtrl, ComCtrls, ImgList;
　　type
　　TForm1 = class(TForm)
　　DirTreeView: TTreeView;
　　FileListBox1: TFileListBox;
　　DriveComboBox1: TDriveComboBox;
　　ImageList1: TImageList;
　　procedure FormCreate(Sender: TObject);
　　procedure DirTreeViewExpanding(Sender: TObject; Node: TTreeNode;var AllowExpansion: Boolean);
　　private
　　{ Private declarations }
　　public
　　{ Public declarations }
　　end;
　　var
　　Form1: TForm1;
　　implementation
　　{$R *.DFM}
　　procedure TForm1.FormCreate(Sender: TObject);
　　var
　　FirstNode,DirNode : TTreeNode;
　　ItemCount,Index:integer;
　　Itemstr:string;
　　begin
　　ItemCount:= DriveComboBox1.Items.Count; //所有驱动器的个数
　　FirstNode := DirTreeView.Items.GetFirstNode;
　　for index := 0 to ItemCount -1 do
　　begin
　　ItemStr:= DriveComboBox1.Items[index];
　　ItemStr:= copy(ItemStr,1,pos(:,ItemStr)) ; //获得驱动器的名称(比如C/D)
　　DirNode := DirTreeView.Items.AddChild(FirstNode, ItemStr );
　　DirNode.HasChildren := true;
　 DirNode.ImageIndex := 0;
　　DirNode.SelectedIndex := 1;
　　end;
　　end;
//响应扩展事件
　　procedure TForm1.DirTreeViewExpanding(Sender: TObject; Node: TTreeNode;Var AllowExpansion: Boolean);
　　var
　　DirNode : TTreeNode;
　　ItemCount,Index,level,icount:integer;
　　Itemstr,strPath:string;
　　begin
　　if node.Count = 0 then
　　begin
　　icount:=0;
　　level:=node.Level ;
　　dirnode:=node;
　　strPath:=node.Text+\ ;
　　while level 0 do
　　begin
　　strPath:=dirnode.Parent.Text+\+strpath;
　　dirnode:=dirnode.parent;
　　level :=level -1;
　　end;
　　FileListBox1.Clear ;
　　FileListBox1.Directory := strpath;
　　ItemCount:= FileListBox1.Items.Count;
　 for index:=0 to ItemCount -1 do
　　begin
　　itemstr:=filelistbox1.items[index];
　　itemstr:= copy(ItemStr,2,pos(],ItemStr)-2) ;
　　if (itemstr〈〉.) and (itemstr 〈〉 ..) then
　　begin
　　 DirNode := DirTreeView.Items.AddChild(Node,itemstr );
　　 DirNode.HasChildren :=true;
　　 DirNode.ImageIndex := 0;
　　 DirNode.SelectedIndex := 1;
　　 icount:=icount+1;
　　end;
　　if icount = 0 then
Node.HasChildren := false;
　end;
　　end;
　　end;
　　end.
 
 
　　程序的运行效果如图所示:我们可以展开目录树中的任何一个节点,并且可以在任意节点之间切换,就象我们在Windows资源管理器中所作的那样,而不需要逐级回退之后才能进行切换。
在Delphi程序中应用IE浏览器控件
　　大概大家还记得Delphi的范例程序中的那个浏览器的例子吧。在那个例子中,利用控件THttp的属性和方法制作了一个浏览器。该例子用于理解THttp控件的使用方法,确实不错。但很少有人会用它作为一个真正的浏览器,原因很简单,功能太有限了,不支持Frame,不支持Script脚本语言,不能以本地文件方式查看HTML文件等等。大部分用户在使用Internet Explorer或Netscape Navigator;我们程序员也乐意使用现成的浏览器,在需要使用浏览器时,就在程序中通过WinExec或CreateProcess等方法调用外部浏览器让用户使用。
　　这种方法确实挺省事的,但总让笔者有点不甘心,把程序控制权让给其它外部程序总让自己很感到麻烦,尤其当应用软件的使用者的计算机使用水平不是很高时。如果能有一个浏览器控件,就可把浏览器嵌入到自己的程序中,那应该挺不错的。
　　如果你的软件的外部环境是WIN95+IE或WIN98(这样的软件使用率还很高的),那样在系统中就已经有了一个IE浏览器控件可以使用了,也许是你长时间没有发觉吧,别浪费资源了,拿来使用吧。当系统中已经安装了IE3.X或IE4.X时,IE浏览器控件已经注册到系统中了,请运行Regedit,用“编辑”菜单下的“查找”功能,查找“Shell.Explorer”键名,你会发现IE控件已经作为ActiveX控件注册在系统中了,这样就我们可以在Delphi中使用该控件了。
一、在Delphi中引入IE浏览器控件
　　由于IE浏览器控件需要提供显示功能才能使用,所以不能在程序中用CreateOleObject取得一个实例后直接使用其属性和方法,否则程序在运行时会引起错误;这时需要用Delphi中提供的“Import ActiveX Control”功能,操作方法见下所述。
　　在“Components”菜单中,调用“Import ActiveX Control”功能,在Registered Controls(注册控件)列表中选择“Microsoft Internet Controls(Version1.1)”,下方的提示栏中显示出其路径为C:\PWin98\System\SHDOCVW.DLL,在Class Names(类型列表)中列出了可注册的三个控件:TWebBrowser_V1、TWebBrowser和TShellFolderViewOC,分别为IE3浏览器控件、IE4浏览器控件和“Microsoft外壳文件夹查看路由器”控件。单击Install进行安装。安装完成后,在“ActiveX”控件栏中,将增加三个控件,分别为TWebBrowser_V1、TWebBrowser和TShellFolderViewOC;在Delphi的Imports目录下,将创建一个文件SHDocVw_TLB.PAS,其中有这三个控件的包装细节,当然含控件的属性和方法说明了
二、在Delphi程序中使用IE浏览器控件
　　以TWebBrowser(IE4浏览器控件)为例子。
TWebBrowser的常见属性和方法主要有:
GoBack:方法,后退到上一个页面。
GoForward:方法,前进到下一个页面。
GoHome:方法,调用默认的主页页面,该页面在IE的选项中设定。
GoSearch:方法,调用默认的搜索页面,该页面在IE的选项中设定。
Navigate(const URL: WideString; var Flags, TargetFrameName, PostData,
Headers: OleVariant):方法,调用指定页面,具体参数如下:
URL:指定页面的URL。 Flags:Word类型,作用还不清楚,可设为0。
TargetFrameName:WideString,打开页面所在的Frame,为空字符串时在当前的Frame中打开;TargetFrameName指定的Frame存在时在Frame中打开;
TargetFrameName指定的Frame不存在时则新建一个窗口打开,此时就相当于调用外部的IE浏览器了。
PostData:boolean,是否允许发送数据。
Headers:WideString,要发送的URL请求的头部数据。
Refresh:方法,刷新当前页面。
Stop:方法,停止调用或打开当前页面。
LocationName:属性(WideString),当前位置的名称。
LocationURL:属性(WideString),当前位置的URL。
Busy: 属性(Boolean),是否正忙。
Visible: 属性(Boolean),浏览器窗口是否可见。
(以下属性为在TWebBrowser新增,TWebBrowser_V1中没有,其作用有待探索)
StatusBar: 属性(Boolean),是否显示状态栏。
StatusText: 属性(WideString),状态栏内容。
ToolBar: 属性(SYSINT),工具栏中的内容。
MenuBar: 属性(Boolean),是否显示菜单条。
FullScreen: 属性(Boolean),是否全屏显示。
Offline: 属性(Boolean),是否脱机浏览。
AddressBar: 属性(Boolean),是否显示地址栏。
TWebBrowser的常见事件主要有:
OnStatusTextChange = procedure(Sender: TObject; const Text: WideString) of object;
　　在状态栏提示信息变化时发生,参数Text为当前状态栏提示信息,我们可以根据该信息来更新我们自己的状态栏提示信息或处理其它的事务．
OnProgressChange = procedure(Sender: TObject; Progress, ProgressMax: Integer) of object;
　　在打开页面的进度变化时发生,参数Progress为当前进度,ProgressMax为总进度,我们可以根据这两个参数来更新我们自己的状态栏提示信息或处理其它的事务．
OnCommandStateChange = procedure(Sender: TObject; Command: Integer; Enable: WordBool) of object;
　　当执行新的命令时发生,Command为命令标识,Enable为是否允许执行该命令．
OnTitleChange = procedure(Sender: TObject; const Text: WideString) of object;
　　在页面的标题发生变化时发生,Text为当前标题．
OnPropertyChange = procedure(Sender: TObject; const Property_: WideString) of object;
　　在页面的属性发生变化时发生,Property_为属性名称
OnDownloadComplete: TNotifyEvent
　　在下载页面完成后发生．
OnDownloadBegin: TNotifyEvent
　　在下载页面开始前发生．
三、在Delphi程序中应用IE浏览器控件的两个例子
(1)制作自己的帮助系统
　　我们利用IE浏览器控件为用户制作了一个帮助系统,帮助文件由多个HTML文件组成,一个主题对应一个 HTML文件(Topic.HTM),每个主题下的项目对应HTML文件中的一个标签(#Item)。这样在我们的系统中,就不必再调用IE浏览器或WinHelp程序来为用户提供帮助了。相信大家知道HTML帮助文件与传统的HLP帮助文件相比的优势所在吧。
　　在下面例子中,演示了TWebBrowser(IE4浏览器控件)的Navigate方法的使用方法。请注意程序中的注释。(下面为程序的主要片段)。
{根据主题和项目调用帮助文
procedure ShowHelp( HelpTopic,HelpItem : String );
var
TargetFrameName,PostData,Heads,Flags : OleVariant;
URL : widestring;
begin
TargetFrameName := ’’;{指定Frame的空字符串时,则在当前Frame中打开帮助文件}
PostData := false;{不发送数据}
Heads := ’’;{Header信息为空}
Flags := 0;{Flags设为0}
URL := HelpTopic + ’.HTM#’+HelpItem;{帮助信息的URL}
with formHelp.webbrowser do{在帮助窗口中的IE浏览器控件中显示帮助信息}
begin
navigate(URL,Flags,TargetFrameName,PostData,Heads);{显示帮助信息}
end;
end;
(２)显示一个GIF动画
　　假如你还没有一个适合的动画显示控件,不妨试用一下下面方法．
procedure ShowGIF( GIFFileName : String );
var
TargetFrameName,PostData,Heads,Flags : OleVariant;
URL : widestring;
begin
TargetFrameName := ’’;{指定Frame的空字符串时,则在当前Frame中打开动画文件}
PostData := false;{不发送数据}
Heads := ’’;{Header信息为空}
Flags := 0;{Flags设为0}
URL := GIFFileName;
with formGIF.webbrowser do{在指定窗口中的IE浏览器控件中显示动画}
begin
navigate(URL,Flags,TargetFrameName,PostData,Heads);{显示动画文件}
end;
end;
以上程序在PWIN98+Delphi3.0下调试通过。
 
轻轻松松在DELPHI3.0中实现三态按钮
　　在许多新的软件中都用到三态按钮。所谓的三态按钮就是当鼠标还末移到时,按钮显示一种平面图像(FLAT);当鼠标移到按钮时,按钮呈现凸立体(UP);当鼠标在按钮上按下时,按钮呈现凹立体(DOWN)。
　　由于DELPHI中有图像按钮,能够实现UP和DOWN两种状态,因此只需增加FLAT状态即可?1收呔芯浚⑾钟幸韵铝街址椒ā?
1. 修改BITBTN上的GLYPH属性.
　　(1)当处于FLAT状态时,GLYPH属性设置为图像文件1,为了让按钮只是平面地显示,必须让图像文件1的尺寸大于按钮的实际尺寸,按钮就呈现平面状,可以在FORM的ONMOUSEMOVE事件上用以下函数实现:
Bitbtn1.glyph.loadfromfile(‘文件名1’);
　　(2)当处于UP和DOWN状态时,GLYPH设置为图像文件2。由于BITBTN构件本身就具有按钮的特性,所以对图像大小没有特殊要求。可以在BITBTN1的ONMOUSEMOVE事件上用以下函数实现:
Bitbtn1.glyph.loadfromfile(‘文件名2’);
　　用这种方法实现的三态按钮有一个明显的不足,由于BITBTN1不断地从图像文件LOAD图像数据,因此图像一直闪烁不定,不但影响运行速度而且效果不佳。
2．修改IMAGE构件和BITBTN构件的VISIBLE属性
　　在FORM的同一个位置设置大小完全相等的两个构件IMAGE1和BITBTN1,由于一起动FORM时,显示FLAT状态,因此把IMAGE1的VISIBLE属性初值设为TRUE;把BITBTN1的VISIBLE属性设为FALSE。
　　(1)当处于FLAT状态时,只显示IMAGE1构件。即把IMAGE1的VISIBLE属性设为TRUE,把BITBTN1的VISIBLE属性设为FALSE。于是FORM的OMMOUSEMOVE事件上调用如下语句:
IMAGE1.VISIBLE:=TRUE;
BITBTN1.VISIBLE:=FALSE;
　　(2)当处于UP或DOWN状态时,把IMAGE1的VISIBLE属性设为FALSE;把BITBTN1的VISIBLE属性设为TRUE。因此在IMAGE1和BITBTN1的ONCLICK事件上分别调用如下语句:
IMAGE1.VISIBLE:=FALSE;
BITBTN1.VISIBLE:=TRUE;
　　使用该方法虽然多用了一个构件,但是不必频繁地装载图像数据,因此运行速度快,效果也很好。 
　　以上是我在实践的过程中发现的两种比较简单的方法,当然还有许多其它的方法也可以实现,愿与各位读者探讨。
制作用于日期时间型字段的DELPHI数据感知控件
　　用DELPHI开发C/S应用方便而快速,因为它拥有大量易于使用的数据访问和数据感知控件。然而万事总是难以完美,DELPHI的DBEdit控件用于输入日期时间型字段却很不方便,为了改善这一缺点,笔者开发了一个DBDateTime数据感知控件,大大方便了时间和日期的输入。
　　创建一个构件时,最重要的一步是选择正确的父类,这样可以减少代码的编写。DELPHI的构件库中已有一个TDateTimePicker构件,可以以下拉日历或利用SpinButton递增、递减的方式方便地输入和改变日期、时间,但它没有数据感知的能力。因此,我们可以以它为父类,派生出一个新的控件,加上能与数据集通信的数据感知功能。
　　数据感知控件通过DataLink对象与DataSource进行交互,所以为控件增加数据感知能力需要创建一个TDataLink(或其派生类)对象作为控件的成员,并为控件创建公开的DataField和DataSource属性;然后需响应TDataLink对象的OnDataChange和OnUpdateData事件。下面是控件的主要源代码,并带有相应的注释:
{定义从TDateTimePicker派生的TDBDateTime类。注意,在单元接口的Uses中应加入DB,DBCTRLS引用}type
TDBDateTime=class(TDateTimePicker)
private
FDataLink:TFieldDataLink;
//TFieldDataLink是TDataLink的派生类,处理单个字段与DataSource的交互
procedureDataChange(sender:Tobject);
//当DataSet的记录改变(如浏览记录)时触发OnDataChange事件,DataChange将作为该事件的事件处理句柄
procedureUpdateData(sender:Tobject);
//更新DataSet前触发OnUpdateData事件,UpdateData将作为该事件的事件处理句柄
functionGetDataSource:TDataSource;
procedureSetdataSource(value:TDataSource);
FunctionGetDataField:String;
procedureSetdataField(Value:String);
procedureCMexit(varMessage:TCMExit);message CM_EXIT;//当控件失去焦点时触发CM_EXIT消息
protected
procedureChange;override;//控件中日期、时间改变时触发OnChange事件
procedureNotification(AComponent:TComponent;
Operation:Toperation);override;
//当某一控件从FORM上移走时DELPHI的IDE调用该方法通知其它控件
public
constructorCreate(AOwner:Tcomponent);override;
destructorDestroy;override;
lished
propertyDataSource:TDataSourcereadGetDataSource
writeSetDataSource;//为控件增加DataSource属性,使它能与DataSource构件连接
propertyDataField:StringreadGetDataField
writeSetDataField;
end;//为控件增加DataField属性,使它指向代表某一字段的TField对象
procedureRegister;//注册构件
implementation
procedureTDBDateTime.CMExit;
begin
try
FDataLink.UpdateRecord;
//控件失去焦点时更新DataSet,这将触发OnUpdateData事件
except
Setfocus;
raise;
end;
DoExit;
end;
constructorTDBDateTime.Create(Aowner:Tcomponent);
begin
inheritedCreate(Aowner);
//创建DataLink对象,挂接OnDataChange、OnUpdateData事件处理句柄
FDataLink:=TFieldDataLInk.Create;
FDataLink.OnDataChange:=DataChange;
FDataLink.OnUpdateData:=Updatedata;
end;
DestructorTDBDateTime.Destroy;
begin
FDataLink.OnDataChange:=nil;
FDataLink.OnUpdateData:=nil;
FDataLink.Free;
inheritedDestroy;
end;
functionTDBDateTime.GetdataSource:TdataSource;
begin
result:=FDataLink.DataSource;
end;
ProcedureTDBDateTime.SetDataSource(Value:TDataSource);
begin
FDataLink.DataSource:=Value;
end;
functionTDBDateTime.GetDatafield:String;
begin
result:=FDataLink.FieldName;
end;
procedureTDBDateTime.SetDataField(value:String);
begin
FdataLink.FieldName:=value;
end;
procedureTDBDateTime.DataChange(Sender:Tobject);
begin
DateTime:=now;
//若控件连了活动的DataSet则数据集变动时控件显示当前记录的相应字段值
ifFDataLink.Field nilthen
ifFDataLink.Field.Text then
DateTime:=FDatalink.Field.AsDateTime;
end;
ProcedureTDBDateTime.UpdateData(sender:Tobject);
begin
FDatalink.Field.AsDateTime:=DateTime;
//用控件中的日期、时间更新相应字段
end;
procedureTDBDateTime.Change;
begin
//当用户改变了控件中的内容时将DataSet置为编辑状态
FDataLink.Modified;
ifnotFDataLink.Editingthen
FdataLink.Edit;
inheritedChange;
end;
procedureTDBDateTime.Notification(AComponent:TComponent;Operation:TOperation);
begin
inheritedNotification(Acomponent,Operation);
//当与控件相连的TdataSource被删除时将控件的DataSource属性置为空
if(Operation=opRemove)and(FDataLink nil)
and(AComponent=Datasource)then
DataSource:=nil;
end;
procedureRegister;
begin
RegisterComponents(DataControls,
[TDBDateTime]);//控件注册后安装于DataControls页
end;
end.
　　本控件安装后能以下拉日历和递增递减方式改变数据库的日期时间型字段,并能以长、短两种格式显示日期,方便实用。控件在DELPHI3、DELPHI4中使用安全可靠。
 
DELPHI控件Tweblabel的编制
　　Internet已经越来越多地渗透到生活的各个方面以及各个领域,许多人都有了自己漂亮的主页,但是,如何简洁而快速地调用这些主页呢？这就是用DELPHI的Tweblabel控件方法。首先来看看这个控件的威力。
　　上面这个Form窗体中放了三个Tweblabel 控件,你不用编写一句程序,只是简单地把它们拖放到Form 上,改一下网页的地址,就可以运行了。当光标移动到文字上时,光标就会自动变成手形,用鼠标轻轻地点击一下,浏览器就会启动,它将把你带到你想去的地方。接下来将引导你一步一步地学习,使你不但要了解这个奇妙的Tweblabel控件,而且要学会如何用DELPHI进行最奇妙的设计即控件编程。
　　启动DELPHI 3(或者DELPHI 4),菜单上有一个Component,用鼠标单击一下,选择New Component就会弹出一个窗口。有几样东西需要填写,先来解释一下。
　　 Ancestor type:表示被继承的对象,是个下拉框,选TLabel。
　　 Class Name:表示新创建的类的名字,取名为Tweblabel。
　　 Palette Page:表示把Tweblabel放到控件面板上的哪个栏位上,选缺省Sample,也可以选别的,或者干脆取个新栏位名字。
　　 Unit file name:选缺省。
　　 Search path:选缺省。
　　然后按“Create Unit”按钮。
　 DELPHI为我们创建了这个单元,并建起了骨架。下面就是用DELPHI编写的代码。
　　unit weblabel;
　　interface
　　uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,StdCtrls;
　　type
　　 Tweblabel = class(TLabel)
　　 private
　　 { Private declarations }
　　 protected
　　 { Protected declarations }
　　 public
　　 { Public declarations }
　　 published
　　 { Published declarations }
　　 end;
　　procedure Register;
　　implementation
　　procedure Register;
　　begin
　　 RegisterComponents(Samples, [Tweblabel]);
　　end;
　　end.
　　DELPHI的Unit分为两个部分,一个是interface(界面),另一个是implementation(实现)。并且类的定义分private、protected、public、published几个,前面三个是类固有的,published则是控件特有的? 中的变量可以显示在DELPHI的控件编辑器里。
　　有了DELPHI编写的控件的骨架之后,又该如何添加代码呢？我们需要做以下几件事情:
　　1．需要一个变量存放Internet主页的地址;
　　2．需要一个函数来完成调用浏览器访问Internet主页;
　　3．需要初始化这个Tweblabel,比如字体、颜色、风格使它更像一个链接;
　　4．当鼠标在Tweblabel上单击时,浏览器就会被启动。
　　具体作法如下:
　　1．定义变量
　　 private
　　 { Private declarations }
　　//定义一个变量存放HTTP主页的地址
　　Fhttpaddr:string;
　　 //为了使控件编辑器能够修改它,则加入:
　　 published
　　 { Published declarations }
　　 property CHttpaddr: string read Fhttpaddr write Fhttpaddr;
　　 //将变量输出到控件编辑器中,名称应该为HTTPADDR,前面加C是为了方便,
　　 //它将直接排列在Caption的下面,方便修改。
　　2．调用浏览器访问INTERNET主页函数
　　 function ShellExecute(hWnd: HWND; Operation, FileName, Parameters, Directory: PChar; ShowCmd: Integer): HINST; stdcall;
　　参数定义:
　　 hWnd: 父窗口句柄
　　 Operation: 操作模式 open 或 print
　　 FileName: 文件名指针
　　 Parameter: 传递给执行文件的参数
　　 Directory: 缺省目录
　　 ShowCmd: 程序启动后的状态:(1)SW_SHOWNORMAL 正常 (2)SW_MINIMIZE 最小 (3)SW_MAXIMIZE 最大
　　不考虑错误判断,打开一个WEB页面的例子:
　　 ShellExecute(handle, open, http://www.microsfto.com, nil, nil, SW_SHOWNORMAL);
　　函数ShellExecute包含在单元ShellAPI中。为了处理各种情况,我们定义了一个过程。
　　 public
　　 procedure ExploreWeb(handle:HWND ; page:PChar);
　　具体代码使用Robert Vivrette先生编写的程序片段。
　　procedure Tweblabel.ExploreWeb(handle:HWND ; page:PChar);
　 var
　　 Returnvalue : integer; //实际调用WEB页面
　　begin
　　 ReturnValue := ShellExecute(handle, open, page, nil, nil, SW_SHOWNORMAL);
　　 if ReturnValue $#@60;= 32 then
　　 case Returnvalue of
　　 0 :
MessageBox(handle,错误:内存溢出!,WEB页面出错信息,0);
　　 ERROR_FILE_NOT_FOUND:
MessageBox(handle,错误:文件未找到!,WEB页面出错信息,0);
　　 ERROR_PATH_NOT_FOUND:
MessageBox(handle,错误:目录错误!,WEB页面出错信息,0);
　　 ERROR_BAD_FORMAT :
MessageBox(handle,错误:EXE文件格式错误!,WEB页面出错信息,0);
　　 // All other errors . See help for more ReturnValues of ShellExecute
　　else
　MessageBox(handle,PChar(错误信息[:+IntToStr(Returnvalue)+]),WEB页面出错信息,0)
　　 end
　　end;
　　3．我们知道,必须重载Create函数才能加入我们的初始化代码。
　　 public
　　 { Public declarations }
　　 constructor Create(AOwner: TComponent); override;
　　实现部分:
　　 constructor Tweblabel.Create(AOwner: TComponent);
　　 begin
　　//调用父辈的CREATE
　　inherited Create(Aowner);
　　 //以下是自己的初始化代码
　//将光标设置为手型
　　Cursor:= crHandPoint;
　　//令标题=主页地址
　　chttpaddr:=http://www.nbip.net/michaeljia;
　　Caption:=chttpaddr;
　　//字体缺省大小为10
　　font.size:=10;
　　font.color:=clblue; 　　//字体缺省颜色为兰色
　　font.style:=[fsUnderline]; //字体缺省风格为下划线
　　 end;
　　4．要想通过单击Tweblabel来启动浏览器,必须重载CLICK函数,代码如下。
　　 protected
　　 { Protected declarations }
　　 procedure click; override;
　　实现部分:
　　 procedure Tweblabel.click;
　　 begin
　　inherited Click; //调用父辈的Click函数
　　　ExploreWeb(parent.handle,pchar(chttpaddr)); //调用WEB页面
end;
在Delphi的DBGrid中插入其他可视组件
　　Delphi提供了功能强大的 DBGrid组件,以方便进行数据库应用程序设计。但是如果我们仅仅利用DBGrid组件,每一个获得焦点(Grid)只是一个简单的文本编辑框,不方便用户输入数据。Delphi也提供了一些其他数据组件来方便用户输入,比如DBComboBox,DBCheckBox等组件,但这些组件却没有DBGrid功能强大。Delphi能不能象Visual Foxpro那样让DBGrid中获得焦点网格可以是其它可视数据组件以方便用户呢？其实我们可以通过在DBGrid中插入其他可视组件来实现这一点。
　　Delphi对DBGrid处理的内部机制,就是在网格上浮动一个组件--DBEdit组件。你输入数据的网格其实是浮动DBEdit组件,其他未获得焦点地方不过是图像罢了。所以,在DBGrid中插入其他可视组件就是在网格上浮动一个可视组件。因此任何组件,包括从简单的DbCheckBox到复杂的对话框,都可以在DBGrid中插入。下面就是一个如何在DBGrid中插入DBComboBox组件的步骤,采用同样的办法可以插入其他组件。
　　1、在Delphi 4.0中新建一个项目。
　　2、分别拖动的Data Access组件板上DataSource、Table,Data Controls组件板上DBGrid,DBComboBox四个组件到Form1上。
　　3、设置各个组件的属性如下:
 
　　注意:我在这里用了Teacher.dbf,那是反映教职工的性别,只能是“男”或者是“女”。
　　4、 DrawDataCell事件是绘制单元格,当获得焦点网格所对应的字段与组合框所对应的字段一致时,移动组合框到获得焦点的网格上,并且
使组合框可视,从而达到在DBGrid指定列上显示DBComboBox的功能。设置DBGrid1的OnDrawDataCell事件如下:
procedure TForm1.DBGrid1DrawDataCell(Sender: TObject; const Rect: TRect; Field: TField; State: TGridDrawState);
begin
if (gdFocused in State) then
begin
if (Field.FieldName = DBComboBox1.DataField ) then
begin
DBComboBox1.Left := Rect.Left + DBGrid1.Left;
DBComboBox1.Top := Rect.Top + DBGrid1.top;
DBComboBox1.Width := Rect.Right - Rect.Left;
DBComboBox1.Height := Rect.Bottom - Rect.Top;
DBComboBox1.Visible := True;
end;
end;
end;
　　5、 DBGrid指定单元格未获得焦点时不显示DBComboBox,设置DBGrid1的OnColExit事件如下:
procedure TForm1.DBGrid1ColExit(Sender: TObject);
begin
If DBGrid1.SelectedField.FieldName = DBComboBox1.DataField then
begin
DBComboBox1.Visible := false;
end;
end;
　　6、当DBGrid指定列获得焦点时DrawDataCell事件只是绘制单元格,并显示DBComboBox,但是DBComboBox并没有获得焦点,数据的输入还是在单元格上进行。在DBGrid1的KeyPress事件中调用SendMessage这个 Windows API函数将数据输入传输到DBComboBox上,从而达到在DBComboBox上进行数据输入。因此还要设置KeyPress事件如下:
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if (key $#@60; $#@62; chr(9)) then
begin
if (DBGrid1.SelectedField.FieldName =DBComboBox1.DataField) then
begin
DBComboBox1.SetFocus;
SendMessage(DBComboBox1.Handle, WM_Char, word(Key), 0);
end;
end;
end;
　　程序在中文Windows 98,Delphi 4.015 下调试通过。希望本文能使你可以更加方便快捷的开发数据库应用程序。
用Delphi4的QReport部件生成报表
　　用户在使用数据库应用程序时经常要生成报表,利用Delphi 4的QReport 部件,可以帮助我们快速方便地生成报表。这里以一个设备管理报表为例说明如何用QReport部件与Query部件设计从多个数据表中生成报表。
一、所用数据库
　　这里用到三个Foxpro数据表,DLBMK(设备大类编码)、SBXHK(设备型号及配置)、BMSBK(设备所在部门),存放在D:\SB目录下。其库结构如下:
(一) DLBMK
 
(二)SBXHK
 
(三)BMSBK
 
　　利用这三个数据表,要生成一个只有电脑部有而其他部门没有的设备型号的情况。
二? 绦蛑械牟考笆粜?/b>
　　程序中有两个窗体:主窗体mainForm与报表窗体repForm。主窗体mainForm中有两个TButton部件,设置如下:
部件属性及属性值
PreviewBtn:TButton Caption:预览
PrintBtn: TButton Caption:打印
　　报表窗体repForm中的部件及属性设置如下:
部件属性及属性值
Query1: TQuery DatabaseName:d:\sb
Active: True
Qrep1: TQuickrep Dataset:query1
TitleBand1: TQRBand BandType:rbTitle
HeadBand1: TQRBand BandType:rbColumnHeader
DrawLeft : True
DrawRight : True
DrawTop : True
DrawBottom : True
DetailBand1: TQRBand BandType:rbDetail
DrawLeft : True
DrawRight : True
DrawTop : True
DrawBottom : True
ChildBand1: TQRChildBand ParentBand:DetailBand1
DrawLeft : True
DrawRight : True
DrawTop : True
DrawBottom : True
TitleLabel: TQRLabel Caption:设备统计表
DlmcLabel: TQRLabel Caption:类别
SbxhLabel: TQRLabel Caption:型号
SbpzLabel: TQRLabel Caption:配置
SbslLabel: TQRLabel Caption:数量
DlmcDBText: TQRDBText Dataset:Query1
Datafield: dlmc
SbxhDBText: TQRDBText Dataset:Query1
Datafield: sbxh
SbpzDBText: TQRDBText Dataset:Query1
Datafield: sbpz
SbslDBText: TQRDBtext Dataset:Query1
Datafield: sbsl
Shape1～9: TQRShape Shape:qrsVertline
Top:0
Width:1
Query1的SQL属性设置为:
select a.dlbh,a.dlmc,b.sbxh,b.sbpz,b.sbsl
from dlbmk a,sbxhk b
where a.dlbh=b.dlbh and b.xhbm not in
(select xhbm from bmsbk where trim(bmmc)$#@60;$#@62;’电脑部’)
order by a.dlbh
　　设置几个TQRband部件的DrawLeft、DrawRight、DrawTop、DrawBottom属性值为True,是为了打印表格边框及横线。利用TQRShape部件,是为了打印出表格竖线。DlmcDBText放置在DetailBand1上,其它几个TQRDBText部件放置在ChildBand1上,Shape1～3放置在HeadBand1上,Shape4～6放置在DetailBand1上,Shape7～9放置在ChildBand1上。
三、为程序增加代码
1．mainForm窗体中的两个按钮事件
procedure TmainForm.PreviewBtnClick(Sender : TObject)
begin
repForm.Qrep1.Preview;
end;
procedure TmainFormPrintBtnClick(Sender : TObject)
begin
repForm.Qrep1.Print;
end;
2．HeadBand1、DetailBand1及ChildBand1的BeforePrint事件
procedure TrepForm.HeadBand1BeforePrint(Sender : TQRCustomBand; Var PrintBand : Boolean)
Begin
Shape1.Height:=HeadBand1.Height;
Shape2.Height:=HeadBand1.Height;
Shape3.Height:=HeadBand1.Height;
End;
procedure TrepForm.DetailBand1BeforePrint(Sender : TQRCustomBand; Var PrintBand : Boolean)
begin
PrintBand:=bh$#@60; $#@62;Query1[‘dlbh’];
if PrintBand then
begin
bh:=Query1[‘dlbh’];
Shape4.Height:=DetailBand1.Height;
Shape5.Height:=DetailBand1.Height;
Shape6.Height:=DetailBand1.Height;
end
end;
procedure TrepForm.ChildBand1BeforePrint(Sender : TQRCustomBand; Var PrintBand : Boolean)
Begin
Shape7.Height:=ChildBand1.Height;
Shape8.Height:=ChildBand1.Height;
Shape9.Height:=ChildBand1.Height;
End;
　　bh应在变量定义部分定义:
Var bh : shortint=0;
　　几个TQRShape部件的高度(Height)与所在TQRBand 部件保持一致,使竖线打印得整齐。如果在设计阶段调整了TQRBand部件的高度,也不会出现竖线断线或过长的情况。
　　在DetailBand1的BeforePrint事件中用PrintBand进行控制,可使每个设备大类名称只需打印一次,而不是每个型号都对应打印一次大类名称。因为dlbh字段的值都大于0,bh初值设为0使它与任一记录的dlbh字段的值都不同,以确保第一个大类名称被打印。这样就生成了一个从多个数据表中提取数据,并带有表格线的数据报表。
　　注:本例工程文件为sbgl.dpr,原程序文件为main.pas和sbrep.pas,若要测试请将dlbmk.dbf、sbxhk.dbf、bmsbk.dbf三个文件放在d:\sb目录下。
在Delphi中巧改窗体文件实现控件数组
delphi 开发的应用中,每一个窗体都有一个对应的窗体文件(.dfm),用来记录该窗体的属性以及窗体上所有控件的属性,以便在窗体关闭后能准确地重新生成窗体。几乎所有的DELPHI参考书都没有提到过该文件的具体情况,偶尔提到,也都泛泛而谈,因为窗体文件是二进制文件,只有在DELPHI提供的编辑环境中才能看到它的本来面目,对其进行操作可能会出现不可预知的错误;而且在大多数情况下,确实没有修改的必要。而本文谈到的和窗体文件密切相关。
　　要利用窗体文件,首先必须了解该类型文件的结构。窗体文件的结构很简单,朋友们可以生成一个窗体,随便放上一些控件,存盘后打开Unit1.dfm文件,就可以看到窗体文件是由关键字"object"和"end"构成的代码段,基本结构如下:
object 控件名 :类名
属性1 =属性值
属性2 =属性值
…
end
　　并且支持嵌套。Delphi在记录控件属性时,只记录修改过的属性,举一个例子,比如对一个标签控件(label1)的缺省描述如下:
 object Label1: TLabel
 Left = 256
 Top = 80
 Width = 32
 Height = 13
 Caption = Label1
 End
　　记录的五个属性都是随开发者拖放的位置和顺序不同而变化的,其它属性由于没有修改过,都是缺省值,所以不必记录。
　　窗体文件是有序的,它的有序性表现如下:
 object 窗体名:Tform
 窗体属性1=属性值
 窗体属性2=属性值
         。。。。。。
 // 以下是TgraphControl类型的控件
 object 控件名:类名
 控件属性1=属性值
 控件属性2=属性值
        。。。。。。
 end
 object 控件名:类名
 控件属性1=属性值
 控件属性2=属性值
        。。。。。。
 end
        。。。。。。
 // 以下是TwinControl类型的控件
 object 控件名:类名
 控件属性1=属性值
 控件属性2=属性值
         。。。。。。
 end
 object 控件名:类名
 控件属性1=属性值
 控件属性2=属性值
         。。。。。。
 end
        。。。。。。
 // 以下是其它类型的控件
 object 控件名:类名
 控件属性1=属性值
 控件属性2=属性值
         。。。。。。
 end
         。。。。。。
                end
　　在同一种类型的控件中,各控件排列的先后顺序和它被拖放到窗体上的先后顺序相同。这个顺序是可以人为修改的,我们正是通过修改这个顺序,来实现控件的数组化。下面将详细介绍。
　　熟悉VB的朋友肯定知道在VB中可以通过控件拷贝实现控件的数组化。而DELPHI中则没有这种功能。Delphi中可以使用Comp nts, Controls两个控件数组在一定程度上模拟控件的数组化,比如:
 for I := 1 to ControlCount-1 do
     if (Controls[I] is Tlabel) then
　　(Controls[I] as Tlabel).Caption := Test;
　　这段代码的功能是将窗体上所有Label的Caption属性设为Test;这是一种非常有用的方法,大家如果不太熟悉可以参考delphi帮助作进一步了解。这种方法有很多局限,最明显的是我们并不知道Controls[i]或Components[i]到底代表哪一个控件,只能用遍历的方法进行筛选,这不仅影响了程序执行的效率,也带来编程上的繁琐。
　　其实,Controls和Components中控件的排列顺序和对应的窗体文件(.dfm)中控件描述代码段的排列顺序是相同的。前面我们谈到窗体文件是可以进行适当修改的,也就是说,我们可以根据需要调整窗体文件中控件描述代码段的排列顺序,让Controls和Components这两个控件数组全在掌握之中,这样我们就能清楚知道Controls[I]或Components[I]具体代表的是哪一个控件。下面举例说明。
　　比如,我们想让窗体Form1上的所有Tbutton灰化,最简单的方法是一句一句的编写代码:
 Button1.Enabled := False;
 Button2.Enabled := False;
     ……
　　如果Tbutton数量很多,代码就变得很冗长。于是我们采用一个循环来实现:
 for I := 0 to ControlCount -1 do
     if Controls[I] is Tbutton Then
 　　(Controls[I] as Tbutton).Enabled := False;
　　现在我们有了更有效的方法,首先打开窗体文件(Form1.dfm),调整Tbutton的排列顺序,让所有Tbutton的代码段(Object…end)都排在一起,然后数一下前面其它控件代码段的个数,设为n,n-1就是第一个Button在Controls(Components)数组中的位置,这样程序就很简单:
 for I:= n-1 to n-1+ButtonNum do
　　(Controls[I] as Tbutton).Enabled := False;
　　代码的效率和简洁比以前有了很大提高。其中ButtonNum是Button的个数。
　　下一个例子更能体现利用这一规律的优越性。在编写Socket通信程序的时候,我们通常需要将用户输入的信息按照一定的顺序形成字符串,然后发送给服务器,服务器再根据事先约定的顺序解包,提取出内容,进行入库或其它操作。在形成字符串时,一般都是直接写代码,比如:
 InfoS := ;//用于存放字符串。
 if Edit1.Text $#@60; $#@62;  then InfoS := InfoS + Edit1.Text
 else begin
             Application.Message(请填写必要信息);
             Exit;
　　　　 end;
if Edit2.Text $#@60; $#@62;  then InfoS := InfoS + Edit2.Text
 else begin
             Application.Message(请填写必要信息);
             Exit;
    　　　 end;
 ……
　　如果录入的项目多,这种方法会使代码冗长不堪。现在我们可以先调整窗体文件中Edit框描述代码段的顺序,让它们排列在一起,并确定第一个Edit框在Controls控件数组中的位置(方法入前),设为n-1(其中n表示排在Edit框前面的控件的描述代码段个数),编写如下代码实现:
 for I := n-1 to n-1+EditNum do
　　　　if ((Controls[I] as TEdit).Text $#@60; $#@62; ) then
　　　　　　InfoS := InfoS + (Controls[I] as Tedit).Text
 Else begin
　　　　　　Application.Message(请填写必要信息);
 　　　　　Exit;
　　　　End;
其中EditNum表示Edit框的个数。
　　还有其它很多方面的应用,在这里就不一一赘述了。这实际上就是彻底实现了控件的数组化,而且这个数组还可以包含不同类型的控件。
 
　　这里有两个问题需要注意:一是在调整控件描述代码段顺序时,一定要遵照文中提到的窗体文件的有序性规则,比如试图将一个TButton控件的描述代码放在一个TLabel控件的描述代码前面是不可能的;另外请大家注意Controls和Components的区别,窗体文件中,控件间的父子关系可以通过缩进的格式很明显的看出来,在计算控件在数组中的位置时,一定要考虑控件间的层次关系,如果使用Controls,就应该只对同级控件进行计数,如果是Components,则应包括所有的控件。
　　当然,这种方法也有它的弊端,首先需要调整窗体文件顺序,其次程序的可读性会受到影响,所以大家在使用这种方法时应多写帮助。
 
状态条插入可视控件
    在FROM中放置一个状态条控件Status。调节Status.Panels,在其中插入3个状态条嵌板。把第二个嵌板的参数Style设置成psOwnerDraw。这一点很重要,如果没有这样做,将永远无法显示文字以外的东西。然后在状态条的OnDrawPanel事件中插入一行StatusDrawRect:=rect;以记录参数Style设置成psOwnerDraw的嵌板的坐标。
　　第二步,在FROM的Private中申明一个TProgressBar类型的变量Progress。然后在一个菜单的消息响应过程中调用Create方法把它建立起来,再设定状态条为该进程条的父窗口,进而设定进程条的一些必要参数。例如:最大值、最小值、原点坐标、高度和宽度等。
　　最后编译一下该程序,你就会发现在状态条中被插入了一个运动着的进程条。
　　类似地,你还可以在状态条中插入其他可视控件,如:按键、位图和动画控件等等。
以下是范例程序:
type
TForm1 = class(Tform)//定义一个窗口类
Status: TStatusBar;
MainMenu1: TMainMenu;
file1: TMenuItem;
insertprocressbar1: TMenuItem;
N1: TMenuItem;
exit1: TMenuItem;
procedure FormCreate(Sender: Tobject);
procedure StatusDrawPanel(StatusBar: TStatusBar; Panel:
TStatusPanel;const Rect: Trect);
procedure FormDestroy(Sender: Tobject);
procedure exit1Click(Sender: Tobject);
procedure insertprocressbar1Click(Sender: Tobject);
private
colorindex : integer; BookOpen:Boolean;
ssbmp:Tbitmap; progress:Tprogressbar;
StatusDrawRect:Trect; //记录要插入状态条特技的坐标范围
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: Tobject);
begin
end;
procedure TForm1.StatusDrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: Trect);
begin
StatusDrawRect:=rect; //记录要实现状态条特技的坐标范围
end;
procedure TForm1.exit1Click(Sender: Tobject);
begin
close;
end;
procedure TForm1.insertprocressbar1Click(Sender: Tobject);
var I,count:integer;
staPanleWidth:integer;< begin
progress:=Tprogressbar.create(form1);
count:=3000; //进程条的最大值
staPanleWidth:=status.Panels.Items[2].width;
//由于进程条的很宽,所以需要改变状态条嵌板的宽度,这里先保存它的宽度。
Status.Panels.Items[2].width:=150; // 改变宽度
status.repaint;
with progress do
begin
top:=StatusDrawRect.top;
left:=StatusDrawRect.left;
width:=StatusDrawRect.right-StatusDrawRect.left;
height:=StatusDrawRect.bottom-StatusDrawRect.top;
//设定进程条的宽度和高度
visible:=true;
try
Parent := status; //该进程条的拥有者为状态条status
Min := 0; Max := Count; //进程条的最大和最小值
Step := 1; //进程条的步长
for I := 1 to Count do
Stepit; // 累加进程条
ShowMessage(现在,进程条将要从内存中被释放);
finally
Free; //释放进程条
end; //try
end; //with
status.Panels.Items[2].width:=staPanleWidth; //恢复状态条嵌板的宽度
end; //begin
end.
在Listboxes加背景图
 建立一个窗体
　　2. 放一个ComboBox和Listbox
　　3. 改变Component的Style为csOwnerDrawVariable和ListBox的Style为lbOwnerDrawVariable。
　　4. 声明5个Tbitmap的全局变量
　　5. 覆盖Form的OnCreate.
　　6. 覆盖ComboBox的OnDraw.
　　7. 覆盖ComboBox的OnMeasureItem.
　　8. 释放资源在Form的OnClose.
Unit Ownerdrw;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls;
type
TForm1 = class(Tform)
ComboBox1: TComboBox;
ListBox1: TListBox;
procedure FormCreate(Sender: Tobject);
procedure FormClose(Sender: Tobject; var Action: TCloseAction);
procedure ComboBox1DrawItem(Control: TWinControl; Index: Integer;Rect: Trect; State: TOwnerDrawState);
procedure ComboBox1MeasureItem(Control: TWinControl; Index: Integer;var Height: Integer);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;Rect: Trect; State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; Index: Integer;var Height: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TheBitmap1, TheBitmap2, TheBitmap3, TheBitmap4,
TheBitmap5 : Tbitmap;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: Tobject);
begin
TheBitmap1 := Tbitmap.Create;
TheBitmap1.LoadFromFile(C:\delphi\images\buttons\globe.bmp);
TheBitmap2 := Tbitmap.Create;
TheBitmap2.LoadFromFile(C:\delphi\images\buttons\video.bmp);
TheBitmap3 := Tbitmap.Create;
TheBitmap3.LoadFromFile(C:\delphi\images\buttons\gears.bmp);
TheBitmap4 := Tbitmap.Create;
TheBitmap4.LoadFromFile(C:\delphi\images\buttons\key.bmp);
TheBitmap5 := Tbitmap.Create;
TheBitmap5.LoadFromFile(C:\delphi\images\buttons\tools.bmp);
ComboBox1.Items.AddObj (Bitmap1: Globe, TheBitmap1);
ComboBox1.Items.AddObject(Bitmap2: Video, TheBitmap2);
ComboBox1.Items.AddObject(Bitmap3: Gears, TheBitmap3);
ComboBox1.Items.AddObject(Bitmap4: Key, TheBitmap4);
ComboBox1.Items.AddObject(Bitmap5: Tools, TheBitmap5);
ListBox1.Items.AddObject(Bitmap1: Globe, TheBitmap1);
ListBox1.Items.AddObject(Bitmap2: Video, TheBitmap2);
ListBox1.Items.AddObject(Bitmap3: Gears, TheBitmap3);
ListBox1.Items.AddObject(Bitmap4: Key, TheBitmap4);
ListBox1.Items.AddObject(Bitmap5: Tools, TheBitmap5);
end;
procedure TForm1.FormClose(Sender: Tobject; var Action: TCloseAction);
begin
TheBitmap1.Free;
TheBitmap2.Free;
TheBitmap3.Free;
TheBitmap4.Free;
TheBitmap5.Free;
end;
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer;Rect: Trect; State: TOwnerDrawState);
var
Bitmap: Tbitmap;
Offset: Integer;
begin
with (Control as TComboBox).Canvas do
begin
FillRect(Rect);
Bitmap := Tbitmap(ComboBox1.Items.Objects[Index]);
if Bitmap $#@60;$#@62; 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;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Combobox1.Items[Index])
end;
end;
procedure TForm1.ComboBox1MeasureItem(Control: TWinControl; Index:
Integer; var Height: Integer);
begin
height:= 20;
end;
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: Trect; State: TOwnerDrawState);
var
Bitmap: Tbitmap;
Offset: Integer;
begin
with (Control as TListBox).Canvas do
begin
FillRect(Rect);
Bitmap := Tbitmap(ListBox1.Items.Objects[Index]);
if Bitmap $#@60;$#@62; 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;
{ display the text }
TextOut(Rect.Left + Offset, Rect.Top, Listbox1.Items[Index])
end;
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; Index: Integer;
var Height: Integer);
begin
height:= 20;
end;
end.
//该窗体的DFM文件
object Form1: TForm1
Left = 211
Top = 155
Width = 435
Height = 300
Caption = Form1
Font.Color = clWindowText
Font.Height = -13
Font.Name = System
Font.Style = []
PixelsPerInch = 96
OnClose = FormClose
OnCreate = FormCreate
TextHeight = 16
object ComboBox1: TComboBox
Left = 26
Top = 30
Width = 165
Height = 22
Style = csOwnerDrawVariable
ItemHeight = 16
TabOrder = 0
OnDrawItem = ComboBox1DrawItem
OnMeasureItem = ComboBox1MeasureItem
end
object ListBox1: TListBox
Left = 216
Top = 28
Width = 151
Height = 167
ItemHeight = 16
Style = lbOwnerDrawVariable
TabOrder = 1
OnDrawItem = ListBox1DrawItem
OnMeasureItem = ListBox1MeasureItem
end
end 
编写提取图标的Delphi控件
在《从文件中提取图标》一文中(《计算机世界》第10期),我介绍了怎样从Windows下的可执行模块(EXE,DLL,CPL等)提取图标资源并且将所提取的图标保存成单独的图标文件。在那篇文章的基础之上,我们来编写一个Delphi控件TWinIcon,该控件封装了图标提取(API函数ExtractIcon)及图标保存等操作。通过代码的封装,我们可以让程序具有更好的模块化结构,更易于代码的维护与升级。另外,如果你还不太熟悉Delphi控件的编写的话,TWinIcon应该是一个好的例子。
 
　 TWinIcon重要属性
FileName:要从中提取图标的文件
Total: (只读属性)FileName
所指定的文件中所包含的图标个数。
IconIndex:(范围:0到Total-1)
该属性指明当前所显示的图标。
About:显示版本信息。
　 TWinIcon重要成员函数(方法)
proc edure GetIcon(var AnIcon:TIcon;Index:Integer);
　功能:获取Index(必须在0到Total-1之间)所指定的图标,图标通过变量参数AnIcon返回。
procedure SaveIconAs(Name:String);
　功能:将当前所显示的图标(即IconIndex属性所指定的图标)保存成图标文件。
　 TWinIcon控件的实现
　详细程序可下载 (Zip 1.3 KB )
　控件的安装
在Delphi的集成开发环境中选择“Component | Install Component…”在对话框的“Unit file name”填上WinIcon.Pas的路径名和文件名 ,在“Package file name”处指明将构件安装到哪一个包
　控件的使用
　阅读上面源代码中,我们很容易就可掌握TWinIcon控件的使用方法。在Internet上发布的TWinIcon控件中包含有一个简单的示例。你可以在Torry’s Delphi Pages上( http://www.torry.ru/vcl/graphics/winicon.zip)或者我的个人站点( http://delphians.163.net/winicon.zip)找到它。
　 TWinIcon的一个重要特性就是它在Delphi集成开发环境(IDE)中就能浏览文件中的图标?1热缢担绻阍贗DE中将一个TWinIcon控件的FileName属性设置为“C:\Windows\Explorer.exe”,那么你就会立即看到一个电脑图标,通过改变IconIndex属性,你还能看到其它的图标。每次改 ileName属性时,IconIndex都会自动调整:如果FileName指定的文件不存在,则IconIndex被置成负1,否则被置成0。
在RichEdit中的串查找
使用时与一般的WinAPI相差不多, 以下有一个包装过的函式.
(* MsgBox(提示文字, 标题, ID_Flat) 讯息视窗
(* ============================================
(* 第叁个引数的设定与本函数传回值, 请参阅 WinAPI 中对
(* MessageBox 的说明
(*
(* Delphi 1.0
(* ----------
(* 本函数传入值为 Object Pascal 式的字串, 如果需
(* 要传入 PChar 请直接呼叫 Application.MessageBox
(*
(* Delphi 2.0
(* ----------
(* 以 PChar(LongStr) 即可传入 Application.MessageBox
(* 不一定需要 call 本函数, 只是为了前後版本相容而保留
(* 本函数
(* -------------------------------------------------- *)
function MsgBox(const sText, sCaption: string; wFlag: word): integer;
{$ifdef Windows}
{$define __ShortString}
{$endif}
{$ifdef Win32}
{$ifopt H-}
{$define __ShortString}
{$endif}
{$endif}
{$ifdef __ShortString}
var
szText, szCaption: array[0..254] of char;
{$endif}
begin
{$ifdef __ShortString}
StrPCopy(szText, sText); (* 转换成 Null-Term. 型的字串 *)
StrPCopy(szCaption, sCaption);
Result := Application.MessageBox(szText, szCaption, wFlag);
{$else}
Result := Application.MessageBox(PChar(sText),
PChar(sCaption),
wFlag);
{$endif}
end; { MsgBox }
改变RichEdit的游标位置
// 指定输入游标的位置
procedure SetCaret(RTF: TRichEdit; var Row, Col: word);
var
i, iStopLine, iSelStart: integer;
begin
if (RTF = nil) then Exit;
if Row = 0 then Row := 1;
if Col = 0 then Col := 1;
// 到第 Row 列, Col 行共几个字元
iStopLine := Row - 1;
iSelStart := 0;
for i := 0 to RTF.Lines.Count - 1 do
begin
if i = iStopLine then
begin
if Length(RTF.Lines[i]) >= Col then
Inc(iSelStart, Col)
else
Inc(iSelStart, Length(RTF.Lines[i]) + 2);
Break;
end;
Inc(iSelStart, Length(RTF.Lines[i]) + 2);
end;
if iSelStart > 0 then Dec(iSelStart);
// 以设定标记的方式指定游标位置
SendMessage(RTF.Handle, EM_SETSEL, iSelStart, iSelStart);
// 再次侦测游标位置
Row := SendMessage(RTF.Handle, EM_LINEFROMCHAR, RTF.SelStart, 0);
Col := RTF.SelStart - SendMessage(RTF.Handle, EM_LINEINDEX, Row, 0);
// 卷到游标所在位置
SendMessage(RTF.Handle, EM_SCROLLCARET, 0, 0);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
iRow, iCol: word;
begin
iRow := 17;
iCol := 3;
SetCaret(RichEdit1, iRow, iCol);
RichEdit1.SetFocus;
end
 
有关TListView的使用
ListView1.Items 为标准 Tlistitems类
ListView1.Items
(1)赋值
with ListView1.Items.Add do
begin
Caption:=caption; //添加第一项
SubItems.add(aaaaa); //添加后面数据
SubItems.add(1234);
SubItems.add(1234);
end; //一定要使用WITH结构.
(2)取值
listview1.Items.Item[i].Caption 取得某条数据标题
listview1.Items.Item[i].SubItems.Strings[j] 取得某条数据内容
listview1.Items.Item[i].SubItems.CommaText 一条记录的全部内容,
格式: "标题","内容1","内容2",....
listview1.Items.Item[i].SubItems.Text 一条记录的全部内容,
格式: 标题,内容,内容2....
(3)删除
listview1.Items.Item[i].Delete; 删除一条数据
(4)数据类型(长度)定义
i:=ListView1.Items.Count 数据条数
listview1.Items.Item[i].Selected 该条数据选中否(MultiSelect决定单选复选)
(5)其他
ListView1.Items.Clear; 清除数据
Delphi中RichEdit的奥妙
　　一、如何得知当前行号　　
　　用RichEdit(或者memo)控件制作文本编辑器时,通过访问lines?count属性可以得到总行数,但是若想知道光标当前所在行的行号就麻烦了,因为delphi没有提供这个属性。要实现这个编辑器必备功能,就须调用em_ LineFromChar。
　　请试试下面的程序。
　　先在窗口中布置一个RichEdit或者memo(命名为editor),以及一个button。在button的onclick事件中写入下列代码。
　　 var
　　　CurrentLine:Integer;
　　　begin
　　　　CurrentLine:=Editor?
　　　　 Perform(em_ LineFromChar,SFFFF,0); 　　
　　　　 Application?MessageBox(PChar(′当前行号是′+IntToStr(CurrentLine)),′消息′,mb_ iconinformation); 　　
　　 end;
　　需要注意的是,第一行的行号为零。
　　二、如何撤消操作(undo)
　　对于memo来说,实现undo是不需编程的,只要让popupmenu属性为空,运行时就能用鼠标右键激活一个常用操作菜单,其中包括撤消、剪切、复制、粘贴、删除和全选六项。
 　　但可惜的是,这一招对于功能强大的RichEdit控件居然行不通,害得我们还要自己设计一个popupmemu。当你用CutToClipBoard等语句轻松而顺利地完成了“剪切”等功能,接着便会无奈地发现,竟找不到undo或cancel之类的语句来执行“撤消”。
 　　这时你需要这样处理:
　　　RichEdit1?Perform(EM_UNDO,0,0);
　　另外还应检查是否允许撤消,从而开启或关闭弹出菜单中的“撤消”项:
　　　 Undo1?Enabled:=RichEdit?
　　　 Perform(EM_CANUNDO,0,0)<>0; 　
　
以上程序在Delphi3中调试通过