Delphi常用技巧

来源:百度文库 编辑:神马文学网 时间:2024/04/29 16:45:34
在网上行走时,经常会看到弹出的桌面小窗体,有时做广告,有时向你致以节日的问候;人们称其为桌面小精灵;有的桌面小精灵会自动移动,有的固定在屏幕的某一角落,动画闪烁,煞是迷人。本人用Delphi制作了一款桌面小精灵,愿与大家共享。
桌面小精灵的实现功能:当运行时,在屏幕的左下角显示一无边框、无标题栏的小窗体,并自动向屏幕的右上角移动,窗体上的小精灵——可爱的马先生,一会跃起,高呼“马
到成功!”,一会含情脉脉地向你招手“再见”;同时,还不断地闪烁显示当前时间,时刻提醒你抓紧时间呦!当你嫌它碍事时,你可以按下鼠标左键,将它拖到任意位置。如果你厌烦它不停移动,你可以双击鼠标左键,它会老老实实地呆在原地不动,只要你用鼠标轻轻一点,它又会高高兴兴地上路,当你单击“再见”时,桌面小精灵就会消失,你不想一试身手吗?请跟我来!
运行后效果图
生成一窗体,设置窗体属性如下:Name属性为Form1,BorderStyle属性为bsNone,FormStyle属性为StyOnTop,Height属性值240,Width属性值209。
窗体上分别添加组件,设置属性如下:
(1)添加两个Image组件,Name属性分别设为Image1、Image2,Align属性均设为alClient (以使Image组件充满整个窗体),Image1的Enabled为False,Image2的Enabled为True,然后通过Picture属性为Image1、Image2添加图片(适合的图片格式:BMP、JPG )。
(2)在Image上再添加两个Timer组件,Name属性分别为Timer1、Timer2,Enabled属性均为True,Interval属性均为1000毫秒。
(3)在Image上再添加一个Label组件,Name:=Label1,Caption:=“马到成功!”,Enabled:=True,Font属性为“华文行楷,粗斜体,三号字,红色”(根据你的图片设置适当的字体、字号、字体颜色)。
(4)在Image上再添加一个Panel组件,设置属性:Name:=Panel1。
Caption:=时间;Color:=clBlue ; Font设为:华文彩云、三号、黄色。
添加源代码如下:
//用Timer1控制两图片、标签及时间的显示
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if (form1.Image1.Visible =true) then
begin
Image1.Visible :=false ;
Image2.Visible :=true ;
Label1.Visible :=false;
panel1.Caption :='再见!';
end
else
begin
Image1.Visible :=true;
Image2.Visible :=false;
Label1.visible:=true;
panel1.caption :=timetostr(time());
end;
end;
//用Timer2控制窗体的移动
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if form1.Left>=750 then
begin
form1.Top :=350;
form1.Left:=0;
end
else
form1.Left:=form1.Left+5;
form1.Top :=form1.Top -3;
end;
procedure TForm1.Panel1Click(Sender: TObject);
begin
close;
end;
//实现用鼠标点住窗体的任意位置,拖动窗体
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND,,0)
end;
//设置窗体的初始化位置
procedure TForm1.FormCreate(Sender: TObject);
begin
left:=0;
top:=350;
end;
//单击Image1、Image2时,Timer2重新开始工作,实现窗体的再移动
procedure TForm1.Image1Click(Sender: TObject);
begin
timer2.Enabled :=true;
end;
procedure TForm1.Image2Click(Sender: TObject);
begin
timer2.Enabled :=true;
end;
//双击Image1、Image2时,Timer2停止工作,实现窗体的固定不动效果
procedure TForm1.Image1DblClick(Sender: TObject);
begin
timer2.Enabled :=false;
end;
procedure TForm1.Image2DblClick(Sender: TObject);
begin
timer2.Enabled :=false;
end;
end.
用Delphi 5.0编写在线播放器
--------------------------------------------------------------------------------
对于RealPlayer网络播放软件大家一定不会陌生。其强大的网络视频、音频等媒体播放功能让人很是羡慕。如果自己也能做一个,心里肯定感觉不错。
RealPlayer软件本身有一个RealPlayer插件。由于它采用的是Active技术,这就为我们创建自己的RealPlayer播放器创造了条件。因为应用ActiveX技术做成的插件,可以很方便地应用到任何支持ActiveX技术的开发语言中,并作为一个普通组件加以使用。我们在下面
就以Delphi 5.0为例,制作一个属于自己的RealPlayer网络影视播放器。
添加RealPlayerActive插件到组件栏ActiveX项中,以备使用。选择主菜单Component→Import ActiveX Control项,将出现一个Import ActiveX窗口,该窗口的上部选择列表中存放了本计算机系统中已经拥有的各种Active插件。如果你安装了RealPlayer软件,就从中找到RealPlayer ActiveX Control Library一项并选定,然后选择窗口下部的Install...按钮,出现Install窗口,保持默认值,选择OK,即可添加完成。回到组件栏ActiveX项中,你会发现RealPlayer软件的图标。这样,RealPlayer就可当作一个普通组件使用。
图1 RealPlayer Active
新建一个Delphi应用程序,然后在窗口中把组件栏ActiveX项中的RealPlayer组件拉入窗口中,命名为RealAudio1,出现一个简化的RealPlayer界面。但它只有控制界面,没有视频图像界面。这不要紧,在RealPlayer组件的Controls属性中加入“ImageWindow”,然后点击下面的窗口,视频图像开始出现,在“ImageWindow”后接着添加“ControlPanel”属性值(用逗号分开)。这样控制界面出现,还可以在后面继续添加“Statuabar”值,出现状态条。
将RealPlayer组件拉动到适当大小,在窗口中添加一命令按钮并命名为Play。然后在按钮的单击事件中添加以下代码:
procedure TForm1.Button1Click(Sender: TObject);
begin
RealAudio1.source=' c:A.rm' ; //播放的电影源。
RealAudio1.doplay; //开始播放电影
end;
一个RealPlayer播放器就做完了,简单吧!不过本文只是简单介绍RealPlayer组件,它还拥有许多属性和方法,诸君可以自由发挥想像力,设计一个更加完善的播放器。
用Delphi再现Windows纸牌游戏
--------------------------------------------------------------------------------
使用过Windows 98的用户对其自带的纸牌游戏一定不会陌生,在您的鼠标点击、拖动等操作之下,扑克牌上下翻飞、腾挪组合;在您不经意的操作中,其实您已经触发了一系列预设事件,这些事件过程的响应最终让您体会到成功的喜悦和失败的痛苦。但您想不想体会一下借助于某种开发工具自己去编程实现的感觉呢,充分体会Delphi的事件驱动机制,这将是另外一番享受,并且理解了事件驱动机制后,再作其他更深层次的开发,这样您会变得更加得心应手。
一、单张牌的实现
Delphi编程环境中提供了图形按钮控件,设计时采用了一个按钮就是一张牌,我们可以将选定的图形(如BMP图形,大小合适)作为其背面和前面。在Delphi中,图形的装入显示的方法为:
图形按钮.glyph.loadfromfile('图形文件路径+文件名')
在设计中可以事先准备52张扑克正面图形和几张背景图形,用控件(控件数组)动态生成的方法(Create(Self))逐一调用。
二、关于图形按钮
在游戏中要对扑克牌进行正确的操作还要借助在其图形按钮上增加几个属性(如图1)
图1
HS:标识一张牌的花色(方块、黑桃、红心或梅花)。
DS:标识一张牌的点数(1-13即A-K)。
HB:标识一张牌的黑色和红色。
Over:标识本张牌上面是否有牌压着。
Look:标识本张牌的正面或背面。
Area:指定本张牌的操作区域,在设计中将各操作区定义为如图2所示各操作区。
发牌源区(Source):即左上角两叠牌。
回归区(Home):即右上角四门回收处。
操作拖放区(Operate):即下排(7叠)主要拖放区。
PTR属性:用于支持多张扑克牌的拖动操作,为一指针,指向单张牌。笔者用此属性来实现一叠牌的拉单向链表。也可以再加一属性拉双向链表方便操作。
三、扑克牌的操作
扑克牌的操作多数是通过Delphi提供的事件驱动编程实现的,开始一个拖动牌操作:Delphi是从OnMouseDown事件开始。请参考OnMouseDown模块。
接受/拒绝被拖动的牌:这里由OnDragOver事件决定,要接受被拖动的牌,必须把图形按钮的Accept属性设为TRUE。
释放处理被拖动的牌:这里由EndDrag和DragDrop事件被激发来处理,这里选用了DragDrop事件来处理,因为该事件只有当DragOver事件的Accept设为TRUE时,只有这个事件被激发。
图2
另外,扑克牌的位置改动是通过Top和Left属性实现的。
这里在设计时,52个控件共享Click、OnMouseDown、OnDragOver、OnDragDrop事件。
在运行时是动态赋予的。程序中如下例赋予事件代码:
Mainpk[i].OnMouseDown:=pk1mousedown;
Mainpk[i].OnDragOver:=pk1DragOver;
Mainpk[i].OnDragDrop:=pk1Dragdrop;
Mainpk[i].OnClick:=pk1Click;
四、程序的实现
程序开始时先动态生成52张牌(图形按钮),赋予花色、点数、正面图形等,接着利用Delphi提供的随机函数RANDOM(), 将52张牌次序打乱,完成洗牌。接着开始发牌,动态赋予事件代码。之后由接受用户选择进入游戏,游戏处理过程实际上就是相应事件代码在运作。
游戏调试通过后,笔者还查阅了其他相关资料,有的系统还提供了专门的关于扑克牌方面类库或API函数供程序员直接调用,减少了程序员的设计复杂性,有兴趣的读者也可以不妨一试。
在Delphi里播放Flash动画
--------------------------------------------------------------------------------
在Flash大行其道的今天,是否想过在你的程序里也加入几幅Flash动画炫一炫呢?OK,心动不如行动,让我们现在就开始吧!
首先,你的机器里要装有Flash播放软件(你的IE能显示Flash)。IE之所以能显示Flash是安装了由Macromedia公司提供的sw#{3tech.sina.com.cn/introduction/focus/flash.shtml target=_blank>flash3}#.ocx控件,我们可以在Win98的SystemMacromed Flash中或在W
in2000中的System32 MacromedFlash中找到它。ActiveX控件在Windows里是通用的,Delphi也同样支持。
运行Delphi后,选择选单Component→Import ActiveX Control,找到SWFlash.OCX 文件进行安装。安装完成后,ActiveX面板里出现TShockwaveFlash控件,这是Delphi对SWFlash.OCX的封装,现在我们就可以用这个控件来播放Flash了。拖一个Flash过来,放在Form上,指定其Movie属性为d: est.SWF,并按F9键加以运行即可。怎么样,运行效果不错吧?下面,笔者将具体介绍TShockwaveFlash主要属性、方法和事件,以便于读者开发。
TShockwaveFlash主要属性如下:
ReadyState:读一个flash文件时的状态,其中包括0=Loading、1=Uninitialized、2=Loaded、3=Interactive和4=Complete;
TotalFrames:总帧数,只有当ReadyState = 4时才能访问该属性;
FrameNum:当前播放的帧;
Playing:播放或暂停一个flash;
Quality:指定当前渲染的质量,包括0=Low, 1=High、2=AutoLow、3=AutoHigh;
ScaleMode:缩放模式,0=ShowAll、1= NoBorder、2 = ExactFit;
AlignMode:对齐模式,Left=+1、Right=+2、Top=+4、Bottom=+8;
BackgroundColor:背景色,-1为默认颜色;
Loop:是否循环;
Movie:指定播放的flash文件路径,可以为一个URL。
TShockwaveFlash主要方法如下:
Play():开始播放动画;
Stop();停止播放动画;
Back();播放前一帧动画;
Forward():播放后一帧动画;
Rewind():播放第一帧动画;
SetZoomRect(int left, int top, int right, int bottom):设置缩放的区域;
Zoom(int percent):按百分比缩放;
Pan(int x, int y, int mode):缩放播放面板,其中模式0为按像数、1为按窗口百分比。
TShockwaveFlash主要事件如下:
OnProgress(int percent):读取一个flash时触发;
OnReadyStateChange(int state):状态改变时触发。states的值可以为0=Loading、1=Uninitialized、2=Loaded、3=Interactive和4=Complete。
利用Delphi实现系统状态栏图标
--------------------------------------------------------------------------------
下面以一个具体的例子,详细介绍一下利用Delphi实现系统状态栏图标的步骤和方法。
1.创建一个应用程序,在主窗体上增加一个TpopupMenu组件。并为该弹出选单组件增加选单项Exit,标题为“退出”。
2.在Uses中添加ShellAPI,因为在系统状态栏中增加图标时需调用ShellAPI中的函数
Shell_NotifyIconA。该函数需要两个参数,其中一个是TnotifyIconDataA结构,需在主窗体中增加TnotifyIconDataA类型的全局变量ntida。
3.定义消息mousemsg,并编写主窗体的mousemessage消息处理函数,此函数说明在图标上用鼠标左键单击时,会打开应用程序窗口;用鼠标右键单击时,会弹出一个选单。
下面给出步骤2和3的实现代码:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Menus, shellapi;
const
mousemsg = wm_user + 1; //自定义消息,用于处理用户在图标上点击鼠标的事件
iid = 100; //用户自定义数值,在TnotifyIconDataA类型全局变量ntida中使用
type
TForm1 = class(TForm)
......
private
//自定义消息处理函数,处理鼠标点击图标事件
procedure mousemessage(var message: tmessage); message mousemsg;
public
{ Public declarations }
end;
var
Form1: TForm1;
ntida: TNotifyIcondataA;
//用于增加和删除系统状态图标
implementation
{.DFM}
procedure TForm1.mousemessage(var message: tmessage);
var
mousept: TPoint; //鼠标点击位置
begin
inherited;
if message.LParam = wm_rbuttonup then begin //用鼠标右键点击图标
getcursorpos(mousept); //获取光标位置
popupmenu1.popup(mousept.x, mousept.y);
//在光标位置弹出选单
end;
if message.LParam = wm_lbuttonup then begin //用鼠标左键点击图标
//显示应用程序窗口
ShowWindow(Handle, SW_SHOW);
//在任务栏上显示应用程序窗口
ShowWindow(Application.handle, SW_SHOW);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
not (GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW AND NOT WS_EX_APPWINDOW));
end;
message.Result := 0;
end
4.编写FormCreate的代码如下:
procedure TForm1.FormCreate(Sender: TObject);
begin
ntida.cbSize := sizeof(tnotifyicondataa); //指定ntida的长度
ntida.Wnd := handle; //取应用程序主窗体的句柄
ntida.uID := iid; //用户自定义的一个数值,在uCallbackMessage参数指定的消息中使
ntida.uFlags := nif_icon + nif_tip + nif_message;//指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
ntida.uCallbackMessage := mousemsg;
//指定的窗口消息
ntida.hIcon := Application.Icon.handle;
//指定系统状态栏显示应用程序的图标句柄
ntida.szTip := 'Icon';
//当鼠标停留在系统状态栏该图标上时,出现该提示信息
shell_notifyicona(NIM_ADD, @ntida);
//在系统状态栏增加一个新图标
end;
5.编写Tform1.OnClose的代码如下:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone; //不对窗体进行任何操作
ShowWindow(Handle, SW_HIDE); //隐藏主窗体
//隐藏应用程序窗口在任务栏上的显示
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.handle, GWL_EXSTYLE)
or WS_EX_TOOLWINDOW AND NOT WS_EX _APPWINDOW);
end;
6.编写Exit代码如下:
当用户点击Exit时实现完全退出应用程序。具体代码如下:
procedure TForm1.ExitClick(Sender: TObject);
begin
//为ntida赋值,指定各项参数
ntida.cbSize := sizeof(tnotifyicondataa);
ntida.wnd := handle;
ntida.uID := iid;
ntida.uFlags := nif_icon + nif_tip + nif_message;
ntida.uCallbackMessage := mousemsg;
ntida.hIcon := Application.Icon.handle;
ntida.szTip := 'Icon';
shell_notifyicona(NIM_DELETE, @ntida);
//删除已有的应用程序图标
Application.Terminate;
//中断应用程序运行,退出应用程序
end
通过以上步骤,我们即可用Delphi轻松实现系统状态栏图标。
用Delphi编写SMTP邮件发送程序
--------------------------------------------------------------------------------
构件组成
Delphi 5构件板的FastNet页中,提供了TNMSmtp构件,它的功能就在于将邮件发送到指定的邮件服务器。其最常用的属性和方法如下:
Host:SMTP邮件服务器的地址,如SMTP.SINA.COM.CN
Port:SMTP邮件服务器的端口号,一般用其默认值25即可
UserID:用户名,当与邮件服务器建立连接时,需验证用户名
PostMessage.FromAddress:发件人地址
PostMessage.ToAddress:收件人地址
PostMessage.Attachments:邮件附件的文件列表
PostMessage.Body:邮件的正文
PostMessage.Subject:邮件的主题
Connect方法:建立与SMTP服务器的连接,连接前需指定Host和UserID
Disconnect方法:断开与服务器之间的连接
SendMail方法:将当前邮件发送到服务器
当然,TNMSmtp构件还有很多其它的属性、方法、事件,在这里我们不作介绍,需要时大家可以查阅相关资料或Delphi的帮助信息。
实现方式
首先在Form1中加入相应的TLabel、TEdit、TMemo、TButton、TListBox、TOpenDialog和TNMSmtp构件。其中,TMemo用于书写邮件内容,TListBox显示附件项目,TOpenDialog(文件打开对话框)用于选择附件文件,按钮Button1添加附件,按钮Button2连接服务器并发送邮件。程序的具体代码如下:
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then ListBox1.Items.Add(OpenDialog1.FileName);
//将选择的文件项添加到ListBox1中,作为附件
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
NMSmtp1.Host:=Edit3.Text; //SMTP服务器地址
NMSmtp1.UserID:=Edit4.Text; //你在对应服务器上的注册用户名
NMSmtp1.Connect; //与服务器建立连接
NMSmtp1.PostMessage.FromAddress:=Edit5.Text; //发件人的邮件地址
NMSmtp1.PostMessage.Subject:=Edit2.Text; //邮件主题
NMSmtp1.PostMessage.ToAddress.Add(Edit1.Text); //收件人的邮件地址
NMSmtp1.PostMessage.Attachments.AddStrings(ListBox1.Items); //附件
NMSmtp1.PostMessage.Body.Assign(Memo1.Lines); //邮件的正文
NMSmtp1.SendMail; //发送邮件
NMSmtp1.Disconnect; //断开连接
ShowMessage('发送完毕!'); //发送完时显示提示信息
end;
以作者为例:我的一个邮箱为[email]dyhuyz@163.com[/email],利用SMTP.163.com邮件服务器向《中国电脑教育报》编辑部发信时,在Edit1中填入编辑部的地址[email]soft@cce.com.cn[/email],Edit2中写上主题,Edit3中填入SMTP.163.com,Edit4中填入用户名dyhuyz,Edit5中填入我的地址[email]dyhuyz@163.com[/email],添加附件后,单击发送按钮,一切OK了!
注意事项
需要特别说明的是:目前部分网站的SMTP邮件服务器要对发送邮件的用户进行身份验证,即要求给出用户名和密码信息,否则无法发送,包括163.net,263.net,sina.com,sohu.com等均在此列。而Delphi 5的TNMSmtp构件本身未提供“密码”属性,采用以上简单方法,不能利用这些服务器发送邮件,否则会出现错误信息;Delphi 6中用Indy构件组取代了Delphi 5中的FastNet构件组,其中的SMTP包含有身份验证的相关信息,可以很方便地解决这个问题。另一部分网站,如China.com,163.com等,则不要求身份验证,利用本程序,尽可畅通无阻。
如何在Delphi中使用资源文件
--------------------------------------------------------------------------------
资源也是数据,它相当于我们熟悉的只读数据。在应用程序的可执行代码中,它是单独存储的,当其被调用时才载入程序,在程序执行完后又退出。Delphi中的资源有很多类型,适用于不同的地方,大致有以下几类:
●图标资源:是一种小型位图,用户常常用不同的图标代替不同的应用程序。
●光标资源:也是小型的位图,不过它适用的颜色不多。Delphi已经给光标指定了一个光标图案集,就是我们操作中常用到的Cursor属性,同时用户也可自定义光标图案。
●位图资源:Delphi只是将位图资源存入资源文件中,在使用时从资源文件中调出。
●字符串资源:将字串符文件存储于资源文件中。
本文通过实例程序来说明资源在Delphi中的用法,所有示例程序均在Delphi 4中调试通过。
1、生成资源文件
在Delphi中提供了一个图形编辑器(Image Editor),通过该编辑器可以编辑生产Bitmap、Icon和Cursor三种资源文件,也可以直接绘制ICO、CUR和BMP文件。该编辑器不能进行文字处理,具体文字处理在后面介绍。编辑图形类资源文件时,首先启动Image Editor,选择:File->New->Resource File;在弹出的窗口中用鼠键右键单击“Contents”,再弹出的菜单中单击:New;选择需要编辑的资源文件的类型(Bitmap、Icon或Cursor)。
2、装载与使用资源文件
资源文件编辑生成后(文件名后缀为.res),要使用这些资源文件,首先要通过添加代在表单文件的implementation关键字中加入:
{ *.DFM}
{资源文件名.RES}
定义了资源文件并且在单元文件中包括了资源文件名,需要调用Windows的API函数调用资源文件里的内容,如:LoadIcon,LoadString,LoadBitmap,LoadResource等。
例如:下面的语句装入了一个名为mybmp.bmp的文件:
Bmp.Handle := LoadBitmap(Hinstance , 'mybmp.bmp');
下面示例程序说明了图标、光标和位图资源的使用方法,在资源文件TEST.RES中定义了两个光标(cur1和cur2)、两个位图(bmp1和bmp2)以及两个图标(in1和in2),在程序中对这些资源都进行了调用。并利用定时器使位图和图标的显示有类似动画的感觉。当鼠标移动到Ladel1上时,光标会变成你定义的第一个光标形状;当单击Button1后,再把光标移到Ladel1上时,光标会变成你定义的第二个光标形状。
unit testtes;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
bmp12 : Integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{ *.DFM}
{ TEST.RES}
const
crMycur1 = 1;
crMycur2 = 2;
procedure TForm1.FormCreate(Sender: TObject);
var
bmp : TBitmap;
ico : TIcon;
begin
Screen.Cursors[crMycur1] := LoadCursor(Hinstance,'CUR1');
Screen.Cursors[crMycur2] := LoadCursor(Hinstance,'CUR2');
Label1.Cursor := crMycur1;
bmp := TBitmap.Create ;
bmp.Handle := LoadBitmap(Hinstance,'BMP1');
Image1.Width := bmp.Width + 10;
Image1.Height := bmp.Height + 10;
Image1.Canvas.Draw(4,8,bmp);
bmp12 := 1;
ico := TIcon.Create ;
ico.Handle := LoadIcon(Hinstance,'IN1');
Icon := ico;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Cursor := crMycur2;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
bmp:TBitmap;
ico : TIcon;
begin
bmp := TBitmap.Create ;
ico := TIcon.Create ;
if bmp12=1 then bmp12 := 2 else bmp12 :=1;
bmp.Handle := LoadBitmap(Hinstance,PChar('BMP'+IntToStr(bmp12)));
ico.Handle := LoadIcon(Hinstance,PChar('IN'+IntToStr(bmp12)));
Image1.Width := bmp.Width + 10;
Image1.Height := bmp.Height + 10;
Image1.Canvas.Draw(4,6,bmp);
Icon := ico;
end;
end.
3、字符串资源的定义与使用
字符串的存储在应用程序中是独立的,应用程序只有在使用资源时载入,使用完之后清除,从而节省内存,同时字符串也可以用于翻译,一些汉化软件都利用了字符串。编辑的字符串放在一个文本文件中,可以使用Delphi中的:File->New->Text,编辑字符串文件,字符串文件的格式如下:
stringtable
begin
1,"book"
2,"apple"
3,"desk"
4,"pen"
5,"computer"
end
编辑完字符串文件后,选择Save as,注意要将文件类型改为资源编译文件(.RC),这还不是资源文件,它还必须经过编译才能成为资源文件(.RES)。编译命令为Dos提示符下的BRCC32,其路径为:D:Program FilesBorlandDelphi4Binrcc32.exe;例如上面的字符串资源编译文件名为:StrRes.rc,在DOS提示符下输入:brcc32 mydirStrRes.rc;则编译后会生成一个名为:StrRes.res的资源文件,使用该文件即可访问字符串资源。具体使用见下例:
unit teststr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
count : integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{ *.DFM}
{ StrRes.RES}
const
wordcount = 5;
procedure TForm1.Button1Click(Sender: TObject);
var
strword : string;
begin
if count>wordcount then count := 1;
strword := LoadStr(count);
label1.Caption := strword;
count := count + 1;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
label1.Caption := LoadStr(1);
count := 2;
end;
end.
程序中常量wordcount用来记录字符串资源文件中字符串的数量,变量count用来记录显示的字符串编号。程序运行后单击Button1按钮,则将循环显示字符串资源文件中的每一个字符串。
Delphi开发用DOA运行存储过程
--------------------------------------------------------------------------------
用Delphi开发C/S结构的Oracle数据库软件时,为提高效率,通常将大批量的数据处理交给后台存储过程来完成。由于Delphi需通过BDE才能操作和处理各种数据库文件,这样不仅效率低,而且存在一定局限性,所以考虑采用第三方工具DOA来提高交互效率,方便前后台信息的传递。
DOA(即Direct Oracle Access的缩写)是荷兰Allround Automations公司开发的访问O
racle的工具,运用DOA构件可以在Delphi或C++Builder开发环境下跳过BDE,而直接通过SQLNet访问Oracle。初次接触DOA,一些编程人员对怎样运用DOA调用存储过程感到困惑,笔者将结合电信综合管理系统中数据加工审核这一具体实例,详细阐述其具体的方法和步骤。
实现方法
1.用TOraclePackage的CallProcedure / CallXXXFunction
用TOraclePackage的CallProcedure方法,我们就可简单地调用Oracle存储过程,该方法中参数以数组的形式传递。当TOraclePackage的ParameterMode属性为pmNamed时要按照名称传递参数,每个参数前面必须有指定名称的字符串,其格式为:
CallProcedure(ProcedureName, [ParameterName1, Parameter1, ParameterName2, Parameter2…]);
当TOraclePackage的ParameterMode属性为pmPositional时,要按照位置传递参数:
CallProcedure(ProcedureName,[Parameter1, Parameter2,…]);
输出参数通过传递parString、parInteger、parFloat、parDate或parBoolean常数来定义,输出参数值在过程调用后用GetParameter方法获得,格式为:
PackageName.CallProcedure('ProcedureName',[parString]);
GetParameter(ParameterId);
如果没有参数,则用parNone获得:
PackageName.CallProcedure('ProcedureName', parNone);
与上面类似,我们用TOraclePackage的Call...Function方法也可简单地调用Oracle函数,只是根据返回值的不同,调用相应的方法CallBooleanFunction、CallDateFunction、CallFloatFunction、CallIntegerFunction或CallStringFunction。
2.用TOracleQuery或TOracleDataSet的Execute
用TOracleQuery或TOracleDataSet执行存储过程的步骤为:
(1)设置SQL属性
将TOracleQuery或TOracleDataSet的SQL属性设为:
begin
ProcedureName (:Parameter1, : Parameter2,…);
end;
(2)定义参数
定义参数的方式有两种,一是在对象查看器Properties选项卡的Variables属性中,单击省略号按钮,打开变量属性编辑器;二是用DeclareVariable方法。DOA支持PL/SQL表,它可以作为输入/输出参数传递给后台存储过程和函数,通过一次调用即可传递大量信息,使得在C/S结构中,网络通信量显著减少。在TOracleQuery或TOracleDataSet中定义PL/SQL表既可使用变量属性编辑器(选中PL/SQL Table复选框,然后定义表的大小,如果是字符串型的,还需定义字符串大小),也可在运行时定义PL/SQL表(先调用DeclareVariable方法定义变量,再调用DimPLSQLTable方法定义表大小)。
(3)参数赋值
给输入参数赋值用SetVariable方法,给PL/SQL表赋值首先要创建数组变量,分别赋值数组的各元素,再通过该数组用SetVariable方法给PL/SQL表赋值。
ArrayName := VarArrayCreate([LowBounds, UpBounds], VarType);
Table[LowBounds] := value1;

Table[UpBounds] := valuen;
OracleQueryName.SetVariable(':TableName', ArrayName);
(4)执行存储过程
调用Execute方法执行存储过程,代码如下:
OracleQueryName. Execute;
(5)获得输出参数
用GetVariable方法获得输出参数值,输入/输出参数为PL/SQL表时,返回的数组变量下限与输入相同;输出参数为PL/SQL表时,返回的数组变量下限从零开始。
应用实例
以下是笔者运用上述第二种方法在电信综合统计管理系统中调用加工审核存储过程的一段源代码:
create or replace package pk_sh is
type t_object is table of varchar2(15) index by binary_integer;
type t_formula is table of number index by binary_integer;
procedure sp_audit(sh_time in varchar2,sh_dx in t_object,sh_gs in t_formula);
end pk_sh;
我们首先在服务器端创建包pk_sh,包中定义了两种PL/SQL表,其中t_object存储审核对象,t_formula存储审核公式ID,存储过程sp_audit根据传递的参数(时间、对象、公式)对后台数据进行加工审核。
客户端用Delphi编写,即通过DOA访问sp_audit,具体源代码如下:
Var
OracleSession1: TOracleSession;
OracleQuery1: TOracleQuery;
Begin
//连接数据库
OracleSession1:= TOracleSession.Create(nil);
OracleSession1.LogonDatabase := 'chicago';
OracleSession1.LogonUsername := 'scott';
OracleSession1.LogonPassword := 'tiger';
OracleSession1.Connected:= True;
OracleQuery := TOracleQuery.Create(nil);
OracleQuery1.Session := OracleSession1;
//创建数组并赋值
sh_dx:=VarArrayCreate([0, LV_object.Items.Count -1], varVariant);
for i:=0 to LV_object.Items.Count -1 do
begin
sh_dx[i] :=LV_object.Items[i].caption;
end;
sh_gs:=VarArrayCreate([0, LV_formula.Items.Count -1], varVariant);
for i:=0 to LV_formula.Items.Count -1 do
begin
sh_gs[i] :=strtoint(LV_formula.Items[i].caption);
end;
sql_str :='pk_sh.sp_audit(:sh_time,:sh_dx,:sh_gs);';
with OracleQuery1 do
begin
//设置SQL属性
Clear;
SQL.Add('begin');
SQL.Add(' ' + sql_str );
SQL.Add('end;');
//定义参数
DeleteVariables;
DeclareVariable('sh_time', otString);
DeclareVariable('sh_dx', otString);
DeclareVariable('sh_gs', otInteger);
DimPLSQLTable('sh_dx', 2000, 15);
DimPLSQLTable('sh_gs', 500, 0);
//参数赋值
SetVariable(': sh_time ', sh_time);
SetVariable(':sh_dx', sh_dx);
SetVariable(':sh_gs', sh_gs);
//执行存储过程
Execute;
Free;
end;
OracleSession1.Connected:= False;
OracleSession1.Free;
End;
以上源代码采用Delphi 5、Oracle 8开发,在Windows 98/Windows2000系统平台下调试通过。
通过以上分析可知,利用BDE访问Oracle,由于它不支持PL/SQL表,参数只能分行传递,需反复多次调用存储过程,而用DOA则使问题圆满解决。此外,将TOracleQuery的Threaded属性设置为True,就可简单地编写多线程应用程序,而将Debug属性设置为True,可在运行时显示SQL语句和变量值,以方便调试。
用Delphi开发ASP分页组件
--------------------------------------------------------------------------------
随着网络技术的发展和Internet的普及,Browser/Server在软件开发中已成为主流,笔者在开发一个ERP系统时,就采用了B/S软件模式,具体架构为SQL Server+IIS+IE网页采用的是Active Server Page文件。由于系统涉及大量的数据操作和查询,若纯粹采用ASP脚本语言编写势必造成效率低下,为了提高系统的整体效率和安全性,笔者采用了ASP组件来代替ASP脚本语言。
由于Delphi在开发数据库应用系统中具有的强大的功能和极高的效率,所以笔者开发ASP组件较常用的是Delphi 5.0(当然也可采用Visual Basic或VC++开发ASP组件),Delphi本身在Internet和InternetExpress两个组件面板提供了众多的组件可以直接生成Web页面,但是这些组件都缺少网页中数据显示常见的分页功能。众所周知,ASP是通过建立ADO连接数据库后建立RecordSet对象,然后利用RecordSet的AbsolutePage进行页面定位,而在Delphi 5.0中,已提供了ADO组件封装了Microsoft的ADO库,所以同样具有页面定位功能。下面笔者将分步来开发一个通用的显示分页Web页面的ASP组件。
第一步:新建一个Activex Library,命名为PadoPage,然后再新建一个Active Server Object Class,命名为AdoPage,即建立了一个名为AdoPage的ASP组件,文件命名为Adopage.pas。
第二步:打开Type Library,新建一个方法Get_Page,然后在Get_Page加入一个参数Pconnandsgl,用于传递数据库连接语句和SQL语句,参数选择为BSTR类型。
第三步:新建一个DataModule,放入Adoconnection组件和AdoQuery组件,将Data Module命名为AdoDataModule。由于新建立的组件中的方法Get_Page要从DataModule中取得数据,所以需在Adopage.pas的Uses子句中加入AdoDataModule,然后声明一个数据模块的变量fadodm,同时加入Initialize和Destroy这两个方法,以便在ASP组作中生成数据模块。Adopage.pas具体代码如下所示:
unit Adopage;
interface
uses
ComObj, SysUtils, Classes, ActiveX, AspTlb, Pbasedata_TLB, StdVcl, AdoDataModule;
//将AdoDataModule加入USE子句
type
T Adopage = class(TASPObject, Ibasedata)
private
fadodm:TAdoDataModuleform;
protected
procedure OnEndPage; safecall;
procedure OnStartPage(const AScriptingContext: IUnknown); safecall;
procedure get_page(const pconnandsql: WideString); safecall;
public
procedure initialize;override;
destructor destroy;override;
end;
implementation
uses ComServ,forms;
destructor Tadopage.destroy;
begin
inherited;
fadodm.Destroy;
end;
procedure Tadopage.initialize;
begin
inherited;
fadodm:=tadodmform.Create(forms.application);
end;
第四步:建立通用的分页显示数据的方法get_page,具体代码如下:
procedure Tadopage.get_page(const pconnandsql: WideString);
var i,j,n:integer;
connstr,sqlstr:widestring;
rs:_recordset;
cur_url:widestring;
page_no:integer;
begin
//首先从传递过来的参数中分别取出连接串和SQL语句
pconnandsql:=uppercase(pconnandsql);
i:=pos('CONNSTR',pconnandsql);
j:=pos('SQLSTR',pconnandsql);
if i=0 or j=0 then
begin
response.write('数据库连接串或SQL语句错误!');
abort;
end;
for n:=I+8 to j-1 do
connstr:=connstr+pconnandsql[n];
for n:=j+7 to length(pconnandsql) do
sqlstr:=sqlstr+pconnandsql[n];
//将取得的连接串和SQL语句分别赋给ADOconnection和ADOQuery
fadodm.adoconnection1.connstring:=connstr;
fadodm.adoquery1.sql.add(sqlstr);
//以下为打开数据库并进行分页的过程
try
fadodm.adoquery1.open;
//打开数据库
rs:=fadodm.adoquery1.recordset;
//取得当前打开页面的URL和页码
try
if request.servervariable['url'].count>0 then
cur_url:= request.servervariable.item['url'];
if request.querystring['page_no'].count>0 then
page_no:=request.querystring.item['page_no']
else
page_no:=1;
except
end;
rs.pagesize:=20;
//每页设为20行
rs.AbsolutePage:=page_no;
//页面定位
response.write('共'+inttostr(rs.pagecount)+'页& ');
response.write('第'+inttostr(page_no)+'页& ');
//对每个页码建立超链接
for i:=1 to rs.pagecount do
response.write('<a href="'+cur_url+'?page_no='+inttostr(i)+'">'
+inttostr(i)+'</a>');
//数据记录按表格显示
response.write('<table>');
//取得表格标题
response.write('<tr>');
for I:=0 to fadodm.adoquery1.fields.count-1 do
response.write('<td>'+fadodm.adoquery1.fields[i].fieldname+'</td>');
response.write('</tr>');
j:=1
with fadodm.adoquery1 do
while (not eof) and j<=rs.pagesize do
begin
response.write('<tr>');
//取得表格内容
for i:=1 to fields.count do
response.write('<td>'+fields[i].asstring+'</td>');
response.write('</tr>');
next;
end;
response.write('</table>');
fadodm.adoquery1.close;
except
response.write('数据出错啦!');
end;
end;
以上即为取得通用分页数据的过程,需要注意的是编译时部分函数会出错,只需在USES子句中加入sysutils、classes和adodb单元即可。
第五步:编译并注册adopage组件,即可在ASP代码中调用,调用示例如下:
<%
dim webpageobj
set webpageobj=server.createobject("padopage.adopage")
webpageobj.get_page("conn=provider=SQLOLEDB.1;presist security info=false;
user id=sa;initical catalog=sale_data;data source=(local),
sqlstr=selectfrom customer")
%>
通过以上步骤,我们就顺利地利用Delphi开发出了具有分页功能的ASP组件了。
利用Delphi实现图像的淡入淡出
--------------------------------------------------------------------------------
我们在浏览网页时见过不少图像淡入淡出的特技,其实,用Delphi也可以实现这样的效果。
用Delphi显示图像,有两个不可缺少的步骤,一是将图像装入Delphi隐形控件TBitmap中,二是用Canvas(画布)的Draw(x,y,Bitmap)或StretchDraw(Rect,Bitmap)方法将图像显示出来。淡出的效果就是将图像上每一个像素的颜色值进行设置,使它逐渐减少到0(黑色),实
现图像的渐渐隐去。利用Canvas的Scanline属性可读取和设置图像每一行的像素颜色,我们就是利用它来实现特技的。淡入则是将一幅图像装入两个TBitmap对象,一个用来保存原始颜色,另一个用来处理,将像素的颜色从0逐渐递增到原始图的颜色,实现淡入的效果。
准备工作:新建一个窗体并加入一个Image控件(用来显示图像特技),两个Button控件(用来切换淡入淡出)。下面我们将两个Button的Click事件源码介绍如下:
unit drdc;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
x,y,i:integer;
Bitmap:TBitmap;
pixcolo:PByteArray;
begin
Bitmap:=TBitmap.Create;
//创建TBitMap实例
try
Bitmap.LoadFromFile
('c:windows ouds.bmp');
Bitmap.PixelFormat:=pf24bit;
for i:=0 to 255 do
begin
for y:=0 to Bitmap.Height-1 do
begin
pixcolo:=Bitmap.Scanline[y];
//扫描每行像素颜色
for x:=0 to ((Bitmap.Width3)-1) do
if pixcolo[x]>0 then pixcolo[x]:=(pixcolo[x]-1);
//递减颜色值,不同的递减值可改变不同的速度
end;
Image1.Canvas.Draw(0,0,Bitmap);
//画出图像
Application.ProcessMessages;
//系统做其他工作
end;
finally
Bitmap.free; //释放位图
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
x,y,i,j:integer;
Bitmap1,Bitmap2:TBitmap;
pixcolo1,pixcolo2:PByteArray;
begin
Bitmap1:=TBitmap.Create;
Bitmap2:=TBitmap.Create;
try
Bitmap1.LoadFromFile('c:windows ouds.bmp');
//将同一幅图像装入两个TBitmap实例
Bitmap2.LoadFromFile('c:windows ouds.bmp');
Bitmap1.pixelFormat:=pf24bit;
Bitmap2.pixelFormat:=pf24bit;
for y:=0 to Bitmap2.height-1 do
begin
pixcolo2:=Bitmap2.Scanline[y];
for x:=0 to ((Bitmap2.Width3)-1) do
pixcolo2[x]:=0;
//先将要处理的图像的像素颜色值设为0
end;
for i:=0 to 255 do
begin
for y:=0 to Bitmap2.Height-1 do
begin
pixcolo2:=Bitmap2.Scanline[y];
pixcolo1:=Bitmap1.Scanline[y];
for x:=0 to ((Bitmap2.Width3)-1) do if pixcolo2[x]<pixcolo1[x] then pixcolo2[x]:=(pixcolo2[x]+1);
end;
//与原始图的像素颜色值比较,并递增其值直到与原始图相等
Image1.Canvas.Draw(0,0,Bitmap2);
Application.ProcessMessages;
end;
finally
Bitmap1.free
end;
end;
end.
利用上面的程序,我们就在Delphi中初步实现了图像的淡入淡出效果。
看实例学Delphi编程四例
--------------------------------------------------------------------------------
在编程爱好者中流传着这样一句话:“业余的程序员用VB,真正的程序员用VC,聪明的程序员用Delphi”。这当然不尽贴切,但从中不难体会到Delphi作为Windows下的主要编程工具之一,其功能完善、灵活多变且易学易用的特点。
下面,我们就通过四则具体的实例来学习Delphi编程的一般思路和技巧。
将程序加入启动
Windows自启动的信息存放于注册表HKEY_LOCAL_MACHINESoftwareMicrosoftWindowsCurrentVersionRun中,Delphi为程序员提供了专用于注册表操作的类型TRegistry:首先利用它声明一个变量,变量的RootKey属性表明当前是对哪一个根键进行操作;使用变量的OpenKey方法打开子键,使用ReadString方法读子键内容,使用WriteString方法写入子键内容。可以自定义一个过程AutoRun来实现此功能,格式为:AutoRun(任意名称,要自动运行的程序名)。实例如下:
implementation
uses Registry; //声明注册表单元
procedure AutoRun(sCaption,sExeName:string); //sCaption为项目名称,sExeName为程序名
var
RegF:Tregistry; //定义变量RegF
begin
RegF:=Tregistry.Create; //创建变量
RegF.RootKey:=HKEY_LOCAL_MACHINE; //指定要操作的根键
if RegF.Openkey('SoftwareMicrosoft
WindowsCurrentVersionRun',true) then
RegF.WriteString(sCaption,sExeName);
RegF.Free; //释放变量
end;
procedure TForm1.Button1Click(Sender:
TObject);
begin
AutoRun('MyAutoRun',Paramstr(0));
//调用过程,Paramstr(0)函数返回带路径的程序名
end;
实现文件拷贝
在本例中,我们使用数据压缩的API函数LZCopy来实现一个文件拷贝的过程,其调用格式为:CopyFile(源文件名,目标文件名)。
implementation
uses LZExpand;
procedure CopyFile(sFileName,dFileName:String);
var sFile,dFile:file;
begin
AssignFile(sFile,sFileName);
Reset(sFile);
AssignFile(dFile,dFileName);
Rewrite(dFile);
LZCopy(TFileRec(sFile).Handle,TFileRec
(dFile).Handle);
CloseFile(sFile);
CloseFile(dFile);
end;
避免多次打开同一程序
Windows是一个多任务的操作系统,允许用户同时打开多个实例,但这样做有可能会造成不良后果。例如:自己设计屏幕保护程序时,只要屏保程序已经被打开运行,就不能再运行其第二个实例;如果不加以限制,则可能出现每隔一定时间就运行一个屏保程序的不正常情况。
要使系统只能打开程序的一个实例,需要对工程文件(*.dpr)进行少许改动,使用API函数FindWindow,其格式为:FindWindow(窗体类名,窗体标题),返回一个窗体的句柄或零(如果没有找到窗体)。假设程序主窗体的标题为MainForm,则工程文件的具体代码如下:
program Project1;
uses Forms,Windows, Unit1 in 'Unit1.pas' {Form1};
var Hwnd:THandle;
begin
Hwnd:=FindWindow('TForm1','MainForm'); //查找是否已有窗体MainForm
if Hwnd<>0 then begin
SetForegroundWindow(Hwnd); //激活已运行的程序实例,但程序最小化时无效
Application.Terminate; //终止本次实例
end
else begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
//运行本次实例
end;
end.
限制窗体的大小
当编程者为窗体选择可变化的边框时,用户可以按自己的意愿拖动边框,改变窗体大小。Delphi为窗体和所有控件提供了一个特殊的属性:Constraints。只需为Constraints属性的子属性设置合适的最大值与最小值,就能建立一个大小不超过指定限制的窗体或控件。我们可以将这些语句放在窗体创建事件中(FormCreate):
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.Height:=200;
form1.Width:=300;
form1.Constraints.MaxHeight:=400;
form1.Constraints.MaxWidth:=600;
form1.Constraints.MinHeight:=100;
form1.Constraints.MinWidth:=150;
end;
Delphi趣味编程实例三则
--------------------------------------------------------------------------------
隐藏任务栏屏蔽热键
在自己的程序中将任务栏隐藏起来,并屏蔽Ctrl+Alt+Del和Alt+Tab等系统热键,也是很有趣的。要实现它们比较容易,但千万别忘了恢复正常,另外,本例中使用了3个API函数:FindWindow、ShowWindow和SystemParametersInfo,在使用它们之前一定要进行申明。
Implementation
var Hwnd:THandle;
Tmp:integer;
procedure TForm1.Button1Click(Sender: TObject);
begin
Hwnd:=FindWindow('Shell_TrayWnd',nil);
if Hwnd<>0 then ShowWindow(Hwnd,SW_HIDE); //隐藏任务栏
SystemParametersInfo(SPI_SCREEN
SAVERRUNNING,1,@Tmp,0); //屏蔽系统热键
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Hwnd:=FindWindow('Shell_TrayWnd',nil);
ShowWindow(Hwnd,SW_SHOW); //恢复任务栏
SystemParametersInfo(SPI_SCR
EENSAVERRUNNING,0,@Tmp,0);
//恢复系统热键
end;
动态调整显示器分辨率
Delphi提供了可以动态改变屏幕分辨率的函数,分别是EnumDisplaySettings()和ChangeDisplaySettings()。有了它们,编程时可以随时改变分辨率以适应要求。下面的CRTReset函数能方便实现这一功能:
implementation
function CRTReset(X, Y: Word): Boolean;
var
lpDevMode: TDeviceMode;
begin
Result:= EnumDisplaySettings(nil, 0, lpDevMode); //获取显示模式
if Result then begin
lpDevMode.dmFields := DM_PELSWID
TH Or DM_PELSHEIGHT;
lpDevMode.dmPelsWidth := X;
lpDevMode.dmPelsHeight := Y; //设置屏幕的宽度和高度
Result:= ChangeDisplaySettings(lpDevMode, 0) = DISP_CHANGE_SUCCESSFUL;
//改变屏幕分辨率并返回成功与否
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if CRTReset(800, 600) then ShowMessage('Now is 800*600'); //调用函数,设置分辨率为800×600
end;
鼠标滚轮如何编程
我们使用的鼠标,很多都带有一个滚轮,方便用户的操作。但遗憾的是,平时编程多数只利用到鼠标的左、右两键,如果将滚轮操作功能也加进你的程序,定能使其增色不少。
当鼠标指针指向窗体中时,Delphi为滚轮滚动提供OnMouseWheel事件,我们可以对它进行相应的处理。本例中,在窗体内放置一标签Label1,用于显示滚轮滚动的效果。
implementation
var i:integer;
procedure TForm1.FormCreate(Sender: TObject);
begin
i:=0;
Label1.Caption:=inttostr(i);
end;
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
if WheelDelta>0 then i:=i+1 else i:=i-1;
//wheelDelta参数表示滚动一格的值,向上滚动为正数,向下滚动则为负数
Label1.Caption:=inttostr(i);
end;
用Delphi打造RealPlayer播放器
--------------------------------------------------------------------------------
如今RealPlayer的流式媒体文件以其强大的视频压缩比正逐步悄然兴起。RealPlayer Plus播放器也理所当然地成为大家播放RealPlayer格式文件的首选软件。不过RealPlayer Plus也不是十全十美的,比如启动时间慢,占用空间大,留有历史记录等等。其实我们可以利用Delphi打造一个完全符合自己要求的RealPlayer播放器。下面我将向大家介绍如何利用Delphi来帮助你实现这一愿望。但前提是:你的机器中必须装有RealPlayer Plus播放器,因为我们要用到其自带的ActiveX控件。
首先,我们要在Delphi中导入所需的ActiveX控件。点击菜单“Component→Import ActiveX Control...”打开“Import ActiveX”对话框,在“Import ActiveX”列表框中,我们可以看到Windows中所有注册的AxctiveX控件。选择其中的“RealPlayer ActiveX Control Library(Version 1.0)”控件。然后单击“Install”按钮。
回到Delphi主界面,你会发现在VCL面板中的ActiveX标签中增加了一个名为RealAudio的组件。我们先把它放入窗体中。不过在默认情况中RealAudio组件没有视频播放窗口,也就是只能播放声音。这是我们不愿看到的,这时我们可以在RealAudio组件的Controls属性中添加如下代码:
IMAGEWINDOW,CONTROLPANEL,STATUSBAR
其中:IMAGEWINDOW、CONTROLPANEL、STATUSBAR分别表示显示视频播放窗口、控制条状态条。
添加代码后,我们可以发现控件外观已经改变成了视频播放窗口形状。然后设置Align属性为alClient,使播放窗口可以随窗体的变化而变化,方便大家在观看影视动画时可以随意拉动播放窗口大小。
然后,在窗中加入TMainMenu组件、TOpenDialog组件各一个。用于选择并打开播放影视文件。双击TMainMenu组件,进入菜单设计器。在这里,我们要设计一个菜单项File,及其2个子菜单Open、Exit。设计完毕后:
双击Open添加如下代码:
if OpenDialog1.Execute then
begin
RealAudio1.source:=OpenDialog1.FileName;
RealAudio1.doplay; //打开并启动播放器
End;
双击Open添加如下代码:
Application.terminate; //终止程序运行
为了在打开一个文件时,便于用户选择文件,要将OpenDialog组件的Filter属性设置如下:所有媒体文件(*.rm,*.ram,*.ra,*.swf,*.mp3)|*.rm;*.ram;*.ra;*.swf;*.mp3|*.*|*.*。
最后就可以进行编译、运行。此程序在Windows Me,Delphi 5.0的环境中调试通过。如果朋友们有什么不解之处,可与我联系:[email]tjyihui@sohu.com[/email]。
用Delphi控制Windows的关闭功能
--------------------------------------------------------------------------------
我们经常会遇到在安装驱动程序或应用程序时,对系统配置进行了修改而必须重新启动Windows才能使设置生效,这时往往会弹出一个提示用户是否重新启动Windows的对话框。但有时又不希望关闭Windows,例如:一个程序正在工作,数据尚未保存,而另一个程序执行了“关闭Windows”的操作(如“网络蚂蚁”的定时关机功能),就会影响用户工作甚至造成数据丢失。此时,我们可在程序中设置防止关闭Windows的代码,只要本程序在运行中关闭Windows时,都将弹出对话框要求用户确认。
对于以上功能,我们完全可以通过编程来实现,下面就以Delphi编程来完成。
关闭(或重启)Windows
要关闭Windows,可利用API函数ExitWindowsEx(),它能够实现“注销当前用户”、“关闭Windows”以及“关闭Windows并重启”等功能,具体格式和用法如下:
ExitWindowsEx(关闭类型参数,系统保留参数);
其中,系统保留参数无特定意义,一般写0即可;关闭类型可以是以下几种:
EWX_FORCE:强制关闭,Windows不会发送任何消息给正运行的程序,这可能导致数据丢失;
EWX_LOGOFF:关闭所有正在运行的程序,注销当前用户并重新登录;
EWX_POWEROFF:关闭Windows并关机,当然,系统必须支持电源管理;
EWX_REBOOT:关闭Windows并重新启动;
EWX_SHUTDOWN:关闭Windows,缓冲区内的数据将被写入磁盘。
我们来看一个实例,首先新建一窗体,在上面放置一组单选钮,命名为rgExit,共三个选项:注销当前用户并重新登录;关闭Windows并重新启动;关闭Windows。再放置两个按钮,Botton1用于确认,Botton2用于取消。代码如下:
Implementation
{ *.dfm}
Procedure tform1.button1click(sender: tobject);
Begin
case rgexit.itemindex of
0: exitwindowsex(ewx_
logoff,0); //注销当前用户并重新登录
1: exitwindowsex(ewx_reboot,0); //关闭Windows并重新启动
2: exitwindowsex(ewx_shutdown,0); //关闭Windows
end;
End;
Procedure tform1.button2click(sender: tobject);
Begin
close;
End;
防止关闭Windows
要实现“防止关闭Windows”这一功能其实很简单,只要在程序主窗体的OnCloseQuery事件中加入以下代码即可:
Procedure tform1.formclosequery(Sender: tobject; var canclose: Boolean);
Begin
If messagedlg('是否允许关闭?', mtconfirmation, mbokcancel, 0) = mrok then
Canclose := True
Else
Canclose := False;
End;
如果把CanClose设为False,表示不允许关闭Windows;如果CanClose设为True,则允许关闭。
CORBA技术及在Delphi中的实现
--------------------------------------------------------------------------------
一、 引言
进入90年代以来,分布式组件对象标准极大地推动了以异构环境下协同工作为目标的虚拟环境研究。当今国际上已有三大分布式组件对象标准:一个是OMG组织推出的CORBA,即公共对象请求代理结构;一个是微软公司推出的DCOM,即分布式组件对象模型;还有一个是SUN公司推出的用JAVA语言开发开发的分布对象模型RMI,即远程方法激活。在三种分布式组件标准中,CORBA标准在结构标准实现的灵活性、跨语言能力、跨平台实现及安全性等方面的综合对比中优于DCOM和RMI,所以它往往成为真正的开放式结构应用程序的首选标准。本文主要讨论CORBA技术,并探讨了在Delphi中的实现方法。
二、 CORBA及相关技术
1、 CORBA的概念和用途
CORBA是OMG(Object Management Group)提出的一个分布式对象技术的规范,它是针对多种对象系统在分布式计算环境中如何以对象方式集成而提出的,它为对象管理定义了一个对象模型-OMG参考模型(OMG reference model)及其框架结构。该模型由ORG、对象服务、公共设施、领域接口及应用对象等5个主要部分组成。该模型及其框架结构将面向对象技术与客户/服务器计算模式结合起来,有效地解决了对象封装和分布式计算环境中资源共享、代码可重用、可移植及应用间地互操作性等问题。
2、 Com与Corba的比较
COM和CORBA都提供了一种创建分布式、面向对象的结构体系的方法,即它们都提供了从另一台机器中调用一个存在于二进制可执行文件中的对象方法。COM和CORBA都有许多用于支持它们的实用程序,例如MTS、ITS、调度程序、注册表。然而,每个结构体系都有各自独特的优点。
COM作为一项以Microsoft和Windows为基础的技术,具有归并到全世界90%的台式计算机的优势,它不受约束并且拥有广泛的厂家支持。
CORBA可能是目前可真正提供全方位支持的较好系统。如,它在处理故障及加载分布方面比COM有更好的支持。当然,CORBA还是比COM更好地支持广泛的操作系统。
3、 Org
ORG(Object Request Broker)常被称作一组服务的类名称,这组服务用于连接客户和服务器,并在客户和服务器之间来回传递方法调用和信息。
因为ORG是在DLL里实现的,所以,它们驻留在服务器和客户实现的处理中,它们必须安装在所有使用CORBA的客户及服务器上。
4、 Smart Agent?
Smart Agent是一项用来帮助客户自动对一个服务器进行定位的目录服务。其宗旨在于帮助客户机连接到服务器上,并执行其他一些类似负载均衡和重启崩溃对象这样的重要任务。即:Smart Agent具有目录服务,它能查出对象的位置,并把客户程序接到这些对象上。
5、 代理、存根和框架
在一个分布式的应用程序里,客户不能直接与服务器通信,同样一个服务器也不直接与客户交流。函数的调用及其参数都必须通过网络从一个应用程序中调度到另一个应用程序里。为了使该体系工作,客户和服务器两边都要建立一个代理。客户这边的代理称为存根(Stub),而服务器的代理则叫框架(Skeleton)。
存根实现方法如下:
function TcorbaTestObjectStub.GetName:WideString;
var
OutBuf:ImarshalOutBuffer;
InBuf:ImarshalInBuffer;
Begin
Fstub.createRequest('GetName',True,OutBuf);
Fstub.Invoke(OutBuf,InBuf);
Result:=UnmarshalWideText(InBuf);
End;
其中,Fstub数据成员来自于CorbaObj单元,在CorbaObj单元里它被声明为Istub类型。Fstub.createRequest方法用一个ImarshalOutBuffer类型的变量与想调用的函数的名字进行连接,这个变量可通过Internet传输。当该包建好后,就可以调用Invoke将信息传递到服务器并从同一个服务器中得到反馈信息。ImarshalInBuffer类型的InBuf变量包含了该反馈信息,可以调用UnmershalWideText。
框架的目的在于接收由存根对Invoke的调用而传来的消息。当它收到消息后,就调用真正的GetName方法,接着把结果包装起来迅速传给客户,实现方法如下:
Procedure
TcorbaTestSkeleton.GetName(constInBuf:ImarshalInBuffer;Cookie:Pointer);
Var
OutBuf: ImarshalOutBuffer;
Retval: WideString;
Begin
Retval:=Fintf.GetName;
Fskeleton.GetReplyBuffer(Cookie,OutBuf);
OutBuf.PutWideText(PwideChar(Pointer(Retval)));
End;
该程序分两步:
第一步:是从由Delphi自动设置的内部Fintf变量调用Get Name。Fintf仅仅是一个指向对象真实接口的指针。因为现在正处于服务器本身当中,因此,这是指向你所创建的实际对象的真实指针。
第二步:是将函数结果包装起并把它送回客户端,你将通过调用GetReplyBuffer和PutWideText完成该步骤。
6、 接口定义语言
接口定义语言(IDL)用于定义对象的接口,一个对象的接口指定该对象所支持的类型和操作,因而唯一定义了可用于该对象的请求形式。所有接口均隐式从CORBA模块中定义的Object接口中导出。
接口定义语言(IDL)的重要特征是其语言无关性,这使得对象可用不同的程序设计语言构造,且依然可相互通信,CORBA规范通过精确定义基本数据类型的长度,保证了在异构硬件平台上的互操作性。
三、 Delphi4中CORBA客户和服务器对象分布式工作机理
Delphi4工具支持CORBA标准,并为开发分布式应用程序提供了优良的环境。
图中客户和服务器两边都有一个代理。在Delphi4中,真实的存根与框架由Delphi4在创建CORBA对象时自动生成,并存放于CORBA对象_TLB.pas命名的文件中。存根与框架这对代理使客户感觉到好象真的与服务器直接通信,而它们的具体实现存在于服务器中。在Delphi4中ORB就是一组动态连接库,它们提供了网络传输层以下的通信机制。图中的OsAgent不是CORBA标准中的一部分,它的宗旨在于帮助客户机连接到服务器上去,并执行其它一些类似于负载均衡和重启崩溃等重要任务。当客户程序启动时,它使用ORB与OsAgent进行通信,使客户机自动连接到服务器上去,换句话说,OsAgent有目录服务功能,它能够自动找出对象的位置。应该指出的是,在实现分布式应用程度过程中,客户、服务器双方必须都安装有OsAgent程序,同时必须在通信之前启动了OsAgent服务。
四、 Delphi中两个重要的CORBA存储库
1、 Interface Reposity
Interface Reposity是一个用来存储有关对象的具体内容的地方。该资源库有三种用途:
1)、它为用户提供了一个场所,用户可以通过它来查看有关对象的详细信息。
2)、它提供了允许CORBA对方法调用进行类型检查的机制。
3)、它允许在运行期间对一个对象进行动态调用。
2、 Implementation Reposity
Implementation Reposity用来存储有关服务器的信息,这样服务器才能自动被Smart Agent启动,尤其是Implementation Reposity含有有关服务器的名字及用来找到它的可执行程序的路径信息。
当一项叫做OAD(即Object Activation Daemon)的CORBA服务器需要启动一个服务器时,OAD可以通过查看Implementation Reposity,并执行其中的文件来给服务器定位。换句话说,Implementation Reposity中存储着服务器的路径、可执行文件名及其他一些相关的信息,如果该服务器并未运行但却已在Implementation Reposity中注册过了,那么Smart Agent可以请求OAD来启动它。
五、 在Delphi中使用CORBA
为在Delphi中使用Corba技术,首先要创建服务器和客户,然后在此基础上创建各类实用程序。服务器和客户程序创建如下:
1、 服务器的创建
创建CORBA服务器所需的步骤如下:
1)、创建一个标准的应用程序并保存到自己的目录中。在该目录下建立两个附加子目录,一个叫Client,另一个叫Server。
2)、选择New|File,转到multitier页面,选择CORBA Object。当提示为对象取个名字的时候,应叫它CorbaTestObject,而让其他所有设置都处在默认的状态。
3)、打开Type Library Edit建立一个叫GetName的方法,它是IcorbaTestObject的一部分,小心别把它加到根上(Project Name).在此处编辑器是不允许一个方法加入的。
4)、该方法的返回类型应该是一个WideString。在Parameters页面的靠近顶端处设置它,这个方法的COM IDL是:HRESULT_Stdcall GetName([out,retval])BSTR *Name).而Delphi的声明是:Function GetName:WideString[dispid$00000001];safecall;这个方法自动说明为Safecall,但这在Type Library Editor中可能不太明显。
5)、单击Refresh按钮来产生方法的代码。完成这个方法的实现代码,让它返回一个对象名字的字符串。
6)、存盘,执行一次该程序。到这一阶段,该应用程序必须提前运行,否则客户就无法访问它。
2、 客户程序的创建
建立一个客户应用程序的步骤:
1)、启动一个正规的应用程序
2)、将由服务器创建的XXX_TLB.pas文件加到主窗体的uses子句中,然后再把CornInit也加到uses子句中。
3)、创建一个按钮响应方法。
4)、从XXX_TLB.pas文件中获得CreateInstance的调用,并将它复制到按钮响应方法中,去掉无关的存储单元,保存其返回的类型。
5)、声明一个叫FcorbaTest的局部变量,它是属于对象返回的类型,在此处便是ICorbaTestObject,将从TLB中复制来的函数的返回值赋给它,将你所选择的任何字符串输送给CreateInstance.
FcorbaTest:=TcorbaTestObjectCorbaFactory.CreateInstance('CorbaTest');
6)、写一段代码从对象实例中调用方法,该对象实例是从TLB中复制的函数中返回的。
7)、确定Smart Agent已启动,然后启动服务器与客户应用程序,接着调用服务器所定义的方法(注:除非正在使用OAD,否则要明确启动服务器与客户应用程序,因为它是不会自动启动的)。
四、结束语
CORBA通过ORG机制为远程对象的激活提供了基本机制,而不管实现这些对象所使用的平台和技术,而且CORBA还为对象管理提供了一组对象服务,如名字服务、事件服务、事物处理服务及永久对象服务等。因此该技术为分布式应用的开发提供了强有力的支持,具有广泛的应用基础。
 
DELPHI的中文版安装程序制作大揭密
--------------------------------------------------------------------------------
DELPHI是目前WINDOWS95/NT环境下优秀的软件开发系统。虽然它目前还不是中文版的,但仍可以开发出完全中文版的应用程序。DELPHI附带的应用程序安装工具ISEXPRESS也是让程序员们如虎填翼,快速生成最终的应用软件的安装程序。但许多从事DELPHI软件开发的程序员可能都觉得它有一个不足,就是用ISEXPRESS工具制作的安装程序的界面是英文的,这对最终用户来说是很难接受的。勉强应付的办法是在制作安装程序时尽量减少对话框,这也难免不出英文提示。
能不能将ISEXPRESS制作的安装程序的显示全部变为中文的呢?
回答是肯定的。目前大多数软件的操作界面和信息都是写在RESOURCE(资源)中,所以我们只要把EXE文件和DLL文件中的RESOURCE摘取出来,就可以轻易的把信息翻译修改成中文。而目前不少编程系统中的资源编辑器(RESOURCE EDIT)都可以将一个已经编辑完成的EXE文件和DLL文件中的RESOURCE摘取出来让我们编辑。
修改的目标
首先让我们来分析一下ISEXPRESS制作安装程序时需要的一些必要的安装文件都是哪些。知道了哪个文件内部包含着安装时需要显示的信息,修改起来就有针对性了。对于安装时显示信息有影响的文件有以下几个:
1._SETUP.DLL
安装程序SETUP.EXE刚刚运行时使用的资源文件,包含一个对话框窗体、三组字符串和两个图标。(汉化的对话框如右所示,这是在准备建立安装程序的临时文件时显示的提示窗体)
2._ISUSR32.DLL
进行安装过程中需要显示的一些字信息符串资源。如下面的两个提示信息对话框中显示的中文信息就是从这个修改后的资源文件中取得的。
3._ISRES32.DLL
包含安装程序运行过程中使用的大部分位图、对话框、字符串、图标等资源。是进行中文化的主要部分。如下面的一个安装时的显示用户名、单位名和序列号的对话框就是修改了这个文件后显示成中文的:
4.RESDLL.DLL
这个资源文件是ISEXPRESS系统自己使用的,如果修改这个资源文件,将其中的英文替换为中文,则ISEXPRESS自己运行时,显示的就已经全是中文了。以下是修改后的RESDLL.DLL在ISX.EXE运行时出现的中文效果。
但是要注意,对于DELPHI3和DELPHI4两个不同版本的ISEXPRESS工具中,RESDLL.DLL文件的版本是有比较大的区别,不能将一个版本的文件汉化后放到另一个系统中运行,否则有些对话框不一样(如右面一个对话框只是DELPHI4中的ISEXPRESS才有的,而DELPHI3中的没有这么复杂),可能会导致系统死机。当然了,由于这个文件只是为ISEXPRESS自己使用,对于制作好的安装盘来说,它是一点作用也不起的,所以不修改它可没有关系。再者由于版本之间的差异,弄不好还会出乱子,不改它也罢。
5.UNINST.EXE
这个文件用在系统进行卸载时使用。所有的资源信息都保存在文件本身内部,如果要进行汉化,则会显示出如下的两个对话框:
修改的方法
(使用Borland C++5.02将软件中文化)
软件要求
1. Borland C++5.02 ,只要基本安装就可以了。
2. Windows95或Windows NT。
3. 您要中文化软件,此软件必须为Uni-code格式。
中文化过程
1. 摘录Resource
首先,运行Borland C++ 5.02,然后开启要编辑的文件。要注意,Viewer必须选择为Edit Resource,文件类型选择.DLL(如有必要也可选择*.EXE类型)。如右图。打开文件后,将显示此资源文件中的所有资源类型,下面是一个动态链接库形式的资源文件_ISRES32.DLL的剖析,我们可以看到这个文件中包含了BITMAP位图信息,DIALOG对话框信息,STRINGTABLE字符串列表及ICON图标和VERSIONINFO版本信息。将它们左边的加号用鼠标点一下或按"+"号键,就可以展开其中的详细条目。
2. 编辑Resouce
编辑DIALOG对话框
有两种方法编辑DIALOG对话框,可视化编辑方法和按文本方式编辑。选择DIALOG项中的某一个对话窗体,按鼠标右键,就可看到弹出菜单中的前两个编辑方法:EDIT和EDIT as Text。前一种方式是逐个修改控件,特别是它们的相对位置,就象在VB和DELPHI的可视化的环境中调整控件一样方便,这对控件的大小位置调整很管用,如果控件的英文文本改为中文后大小不合适了,使用这种方法进行大小调整是比较方便的;后者是纯文本方式,对于大量的英文内容的控件信息的修改,使用这种编辑方法是速度比较合适的。两种编辑显示如右图所示。
编辑STRINGTABLE等其它资源
STRINGTABLE字符串资源中有一种编辑方式,其它的资源的编辑方式也大体上与上在提的方法差不多,相信只要是有经验的程序员,稍加指点就会轻松完成所有中文化工作的。
使用VC++也可将软件中文化,但在使用前要注意的是,只有在WINDOWS NT下才可以将编辑过的RESOURCE存回到原本的exe 文件 (或 dll 文件),且读取时要以Resource资源文件的形式打开,在此不做多述。
Delphi控件的使用经验
--------------------------------------------------------------------------------
一.Delphi中树型控件的使用技巧
我们都知道,开发者主要用Delphi来开发数据库管理软件,正因如此,树型控件的使用最好与数据库联系起来。Delphi提供了一个树型控件TTreeView,可以用来描述复杂的层次关系。
1.树节点信息的存储和加载
常用的方法是用树控件的 LoadFromFile和SavetoFile方法,来实现树控件和文件之间的交互;或用Assign方法实现树控件和DBMemo,也就是和数据库间的交互。该方法的优点是编程相对简单,缺点是树控件的实际节点数可能会很大,对于“大树”,每次加载和存储的数据量会加大,将降低速度,增大系统开销,造成数据冗余。另一种方法,就是只在树上产生“看得见”的节点,没有专门记录全部树节点结构的文件或数据库字段,而将树节点结构分散在数据库的每一个记录中。
具体方法是:创建一个数据库,字段根据实际业务而定,其中必然有一个字段的信息将在树型控件的节点上显示,另外还要一个字段来保存节点的惟一标识号,该标识号由长度相等的两部分组成,前段表示当前节点的父节点号,后段表示当前节点的节点号,此标识号相当于一个“链表”,记录了树上节点的结构。该方法的优点:用户操作“大树”时,一般不会展开所有的节点,而只用到有限的一部分,同时只能从树根一层一层地展开,该法只在树上产生“看得见”的节点,所以,存储和加载“大树”的速度快,数据量小,系统开销和数据冗余较小。缺点:编程较复杂,但可以结合该方法编成一个新的树控件,将大大提高编程效率。值得注意的是,ID号必须惟一,所以在编程中如何合理产生ID尤为重要。
2.数据库结构示例
创建一个数据库,为简化程序,我只创建两个数据库字段,定义如下:
字段名 类型 长度
Text C 10
LongID C 6
LongID字段实际上由两段组成,每一段3位,LongID只能表示1000条记录。将LongID定义为索引字段,存为c:\testtree\tree.dbf。编辑该DBF文件,新建一条记录,Text字段设为TOP,LongID字段设为“000”(3个“0”前为三个空格)。
3.创建演示程序
在Form1上放置TreeView1、Table1、PopupMenu1、Edit1、Edit2。TreeView1的PopupMenu属性设为PopupMenu1;Table1的DataBaseName属性设为c:\testtree,TableName属性设为tree.dbf,IndexFieldNames属性设为LongID;为PopupMenu1加选单项Add1和Del1,Caption分别为Add和Del;Edit1用来输入新节点的Text属性值,Edit2用来输入新节点的3位ID号。存为c:\testtree\treeunit.pas和c:\testtree\testtree.dpr。
在treeunit.pas的Type关键字后加入一行:Pstr:^string;{Pstr为字符串指针}
为Form1的OnCreate事件添加代码:
procedure TForm1.FormCreate(Sender: TObject);
var p:Pstr;Node:TTreeNode;
begin
with Table1,Treeview1 do
begin
open;
first;
new(p);{为指针p分配内存}
p^:=FieldByName(′LongID′).AsString;
Node:=Items.AddChildObject(nil,FieldByName(′Text′).AsString,p);
if HasSubInDbf(Node) then Items.AddChildObject(Node,′ ′,nil);{有子节点则加一个空子节点}
end;
end;
HasSubInDbf为自定义函数,自变量为Node,检查节点Node有无子节点,有则返回True,反之返回False,并在TForm1的类定义里加入原型声明(其它自定义函数的原型也在TForm1的类定义里声明,不另作解释),函数代码如下:
function TForm1.HasSubInDbf(Node:TTreeNode):Boolean;
begin
with Table1 do
begin
Table1.FindNearest([copy(Pstr(Node.Data)^,4,3)+′000′]);
result:=copy(FieldByName(′LongID′).AsString,1,3)=copy(Pstr(Node.Data)^,4,3);{如数据库里当前记录的LongID字段内容的前3位和节点Node的Data的后3位相同,则Node应该有子节点}
end;
end;
为TreeView1控件的OnDeletion事件添加代码,需要指出的是,不仅调用Delete方法可以触发OnDeletion事件,而且当树控件本身被释放前,也触发OnDeletion事件,所以,在此处加入dispose(node.data)会很“安全”:
procedure TForm1.TreeView1Deletion(Sender: TObject; Node: TTreeNode);
begin
Dispose(Node.Data);{释放节点数据内存}
end;
为Add1选单项的OnClick事件添加代码如下:
procedure TForm1.Add1Click(Sender: TObject);
var p:pstr;Tmpstr:string;i:integer;
begin
try
StrToInt(Edit2.Text);
Tmpstr:=Edit2.Text;{注:在实用中,必须用更好的方法来产生ID}
except;
ShowMessage(′重新输入Edit2的内容′);
abort;
end;
with TreeView1 do
begin
new(p);
p^:=copy(Pstr(Selected.Data)^,4,3)+TmpStr;
Items.AddChildObject(Selected,Edit1.Text,p);
end;
with Table1 do{ 在数据库里添加记录 }
begin
Append;
FieldByName(′Text′).AsString:=Edit1.text;
FieldByName(′LongID′).AsString:=p^;
Post;
end;
TmpStr:=inttostr(strtoint(TmpStr)+1);
for i:=length(TmpStr) to 2 do TmpStr:=′0′+TmpStr;
Edit2.Text:=TmpStr;
end;
为Del1菜单项的OnClick事件添加代码如下:
procedure TForm1.Del1Click(Sender: TObject);
var DelList:TStringList;LongID,NSubLongID:string;
begin
DelList:=TStringList.create;
DelList.Sorted:=True;
DelList.Add(Pstr(TreeView1.Selected.Data)^);
while DelList.Count>0 do
begin
LongID:=DelList.Strings[0];
DelList.Delete(0);
Table1.SetKey;
Table1.FieldByName(′LongID′).AsString:=LongID;
if Table1.GotoKey then Table1.Delete;
if HasSubInDbf(TreeView1.Selected) then
begin
NSubLongID:=Table1.FieldByName(′LongID′).AsString;
while (copy(NSubLongID,1,3)=copy(LongID,4,3))and(not Table1.Eof) do
begin
dellist.Add(NSubLongId);
Table1.Next;
NSubLongId:=Table1.FieldByName(′LongID′).AsString;
end;
end;
end;
DelList.Free;
TreeView1.Items.Delete(TreeView1.Selected);
end;
为TreeView1的OnExpanding事件添加代码:
procedure TForm1.TreeView1Expanding(Sender: TObject; Node: TTreeNode;
var AllowExpansion: Boolean);
var TmpNode:TTreeNode;NSubLongID:String;p:Pstr;bm:TBookMark;
begin
with Table1,TreeView1 do
begin
Items.BeginUpdate;
SetKey;
FieldByName(′LongID′).AsString:=Pstr(Node.Data)^;
if not GotoKey then Items.Delete(Node)
else
begin
TmpNode:=Node.GetFirstChild;
if (TmpNode.Text=′ ′)and(TmpNode.Data=nil) then
begin
TmpNode.Delete;
if HasSubInDbf(Node) then
begin
NSubLongID:=FieldByName(′LongID′).AsString;
while (copy(NSubLongID,1,3)=copy(Pstr(Node.Data)^,4,3))and(not Eof) do
begin
new(p);
p^:=FieldByName(′LongID′).AsString;
bm:=GetBookMark;
TmpNode:=Items.AddChildObject(Node,FieldByName(′Text′).AsString,p);
if HasSubInDbf(TmpNode) then Items.AddChildObject(TmpNode,′ ′,nil);
GotoBookMark(bm);
FreeBookMark(bm);
Next;
NSubLongId:=FieldByName(′LongID′).AsString;
end; end; end;
end;
Items.EndUpdate;
end;
end;
以上简要谈了谈数据库的树状显示的基本方法,另外,编辑树上节点的Text属性的同时对数据库进行修改、同一数据库在多用户同时操作时数据库以及树的一致性、树上节点的拷贝与复制等就不再赘述,读者可自行完善。
二.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)。
1. 初始化Windows自定义控制库
Windows提供了两个API函数,InitCommonControls和InitCommonControlsEx,用来初始化自定义控制库。从名字我们不难看出这两个API函数的关系:后者是前者的增强。如果你希望在程序中使用IP控件,你必须用InitCommonControlsEx来完成对自定义控制库以及类的初始化。函数InitCommonControlsEx的原型如下(Pascal语法):
... ...
创建IP控件
... ...
使用IP控件。 在程序中,我们通过向IP控件发送消息来与它通讯。IP控件可以响应的消息有以下6个,这些消息及它们的含义,见下表:
... ...
若想要获取IP控件中IP串所对应的IP值,你应该向IP控件发送IPM_GETADDRESS消息,并且需要把一个32位整数的地址作为SendMessage的最后一个参数。
... ...
2. 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;
三.动态生成控件的方法及应用
1.Delphi中生成控件的两种方法
(1). Form(表单)设计中生成控件
在进行Form设计时,直接在控件工具箱选择所需控件,再设置其属性与响应事件,这种方法比较常见。
(2).程序中动态生成控件
有时候,我们需要在程序运行时动态生成控件,这样做有两大优点:一是可以增加程序的灵活性;二是如果生成控件的多少与程序中间运行结果相关,显然方法一是无法的实现的,必须用程序中动态生成方法。
程序中动态生成控件的方法分为三步,首先,定义生成的控件类型,再用Create函数生成控件,最后对控件的相关属性赋值。以TButton控件为例,步骤如下:
a. 定义控件类型
var
Button1:TButton;
b.生成控件
Button1:=TButton. Create(self);
Button1.Parent:=Self;
//一般将其父控件设置为Self,如果不设置Parent的值,
则控件不会在屏幕
//显示出来
c.设置其它属性及定义相关事件响应函数,如Caption,Left,Top,Height,Width,Visible,Enabled,Hint和onClick事件响应函数等。
2.动态生成控件方法的应用
在开发生产调度与管理系统中,需要动态生成排产计划图,以甘特图表示,应用Shape控件来显示零件的加工状况(每道工序的加工开始时间与结束时间)是非常适合的。应用Chart控件,对加工设备利用率以三维直方图显示,非常直观。现分别将在程序中动态生成Shape控件和Chart控件的过程加以说明。
(1).动态生成Shape控件显示排产计划图(甘特图)
procedure TCreateMultiCharts.ProcCreateCharts;
var
i,j,Rows,Columns,RowSpace,ChartsHeight:Integer;
ShapeChart:array of array of TShape;
begin
Rows:=16; //Shape控件数组行数
Columns:=8; // Shape控件数组列数
RowSpace:=20; // Shape控件行间距
ChartsHeight:=20; // Shape控件高度
SetLength(ShapeChart,Rows,Columns);
//设置ShapeChart数组大小
for i:=0 to Rows do
for j:=0 to Columns do
begin
ShapeChart[i][j]:=TShape.Create(self);
with ShapeChart[i,j] do
begin
Parent:=Self; //此行必不可少,
否则Shape控件在屏幕显示不出
Shape:=stRectangle; // Shape控件形状为矩形
Top:=45+i*(RowSpace+ChartsHeight);
Left:=Round(180+Q[i,j].StartTime);
//因Q[i,j].StartTime为实数,故需进行四舍五入取整
Width:=Round(Q[i,j].Value)
Height:=ChartsHeight;
Brush.Color:=RandomColor;
//自定义函数,说明附后
Brush.Style:=bsSolid; //设置填充方式
Enabled:=True;
end;
end;
end;
注:
a.Q为一记录型二维数组,定义如下:
type
TempData=Record
Value:Real;
StartTime:Real;
end;
Q:array of array of TempData
并且在另一过程已对Q的分量进行赋值。
b.为了区分不同的零件,Shape以不同颜色显示,此时,调用了函数RandomColor。该函数为:
function TCreateMultiCharts.RandomColor;
var
red,green,blue:byte;
begin
red:=random(255);
green:=random(255);
blue:=random(255);
result:=red or (green shl 8) or (blue shl 16);
end;
(2).动态生成Charts控件的ChartSeries组件,显示设备利用率
procedure TFormMultiMachinesBurthen.
ShowMachineBurthenCharts;
var
i:Integer;
Burthen:Real;
SeriesClass:TChartSeriesClass;
NewSeries:array of TChartSeries;
begin
SetLength(NewSeries,CreateMultiCharts.Rows);
MachinesBurthenCharts.height:=200;
MachinesBurthenCharts.Width:=550;
for i:=0 to CreateMultiCharts.Rows do
begin
SeriesClass:=TBarSeries; //设置形状为三维条形图
NewSeries[i]:=SeriesClass.Create(Self);
NewSeries[i].ParentChart:=MachinesBurthenCharts;
NewSeries[i].Clear;
Burthen:=MachineBurthen[i];
Burthen:=Round(Burthen*100)/100; //只取小数点后两位数字
NewSeries[i].add(Burthen,'',NewSeries[i].SeriesColor);
end;
end;
注:
(a).MachineBurthen[i]为一实型数组,其值为对应设备的利用率,已在另一函数中计算得到;
(b). MachinesBurthenCharts为TChart控件,在type段说明。
3.程序运行结果显示
(1).动态生成Shape控件,显示零件排产计划图(略)
(2).动态生成Chart控件的ChartSeries组件,显示设备利用率(略)
jamnce 2006-5-12 14:48
支持啊!好东西啊
ieqqlin13 2006-5-12 14:51
在Delphi中简单实现多重查询
--------------------------------------------------------------------------------
在数据库管理系统中,查询是一项必不可少的功能。查询功能是直接体现系统功能的一项重要指标。查询的方式主要有以下几种:1固定字段的单一查询;2可选择字段的单一查询;3限制若干个字段的多重查询;4可任意选择字段的多重查询。前两种也称为单条件查询,后两种称为多重(或多条件)查询。在实际中,系统(实为程序员)提供给用户的查询方式以单条件查询为多,即使提供了多条件方式,通常也只有两或三个条件,因为编写多重查询是一项非常棘手且繁琐的事情。仅为此,程序员吃尽了苦头。实际上,利用表格Grid功能,就能轻松地实现多重查询。本人以Delphi为例,介绍具体的实现方法,但这种思想,也同样适合于其它的编程语言(如Visual Foxpro)。
另外,为使程序方便“移植”, 本人把各功能模块化,使其更具有通用性。
程序主要按如下三个功能来实现:
①设置DBGrid
②生成查询条件(语句)
③执行查询
具体步骤如下:
⑴新建一工程文件,取名为PDBGrid.dpr;
⑵给单元文件取名为UDBGrid.pas,在其相应的表单(取名为frmDBGrid)中添加如下控件并编写相应的代码:因程序代码较长,请直接按此下载。
值得说明的是,⑴为从一定程序上简化程序,逻辑关系只提供了AND和OR两种,但为允许用户修改SQL语句,如:在多条件之间增加括号来改变运算顺序等,使得查询功能更加强大,因此增加了Memo控件;⑵在实际系统中,为方便用户的操作,可增加几个Button(按钮),功能分别是对Table2的“增加”、“删除”,这样用户界面会更友好些。
利用这种方法来设置查询,条件个数是无限制的,且在屏幕上不会占据太大的空间,程序员实现起来要简单得多了。
软件环境:中文Win98/中文Delphi5.0。
用Delphi获取当前系统时间
--------------------------------------------------------------------------------
在开发应用程序时往往需要获取当前系统时间。尽管Y2K似乎已经平安过去,但在我们新开发的应用程序中还是要谨慎处理“时间”问题。
在《融会贯通--Delphi4.0实战技巧》(以下简称“该书”)第89页专门介绍了两种获取当前系统时间的方法,但这两种方法都存在不足或错误,以下就此进行讨论。
该书第一种方法是利用Time()函数获得当前系统时间,返回结果是TDateTime结构类型的变量。例如:
procedure TForm1.Button2Click(Sender: TObject);
var
DateTime:TDateTime;
begin
DateTime:=Time();
Caption:=DateToStr(DateTime)+' '+TimeToStr(DateTime);
end;
但不论何日期,其结果却都是99-12-30 xx:xx:xx, 显然日期出错了。通过分析Delphi的帮助,Time()用于返回正确的“时间--时分秒”即TimeToStr(DateTime),而不应该用于返回“日期”。事实上,单独用于返回日期的系统函数是Date。
那么有什么是既可返回正确的“时分秒”又可返回正确的“年月日”呢? 可以用Now函数,例如:
procedure TForm1.Button1Click(Sender: TObject);
var
mytime: TDateTime;
begin
mytime:=Now;
Caption:=DateToStr(mytime)+' '+TimeToStr(mytime);
//或直接用 Caption := DateTimeToStr(Now);
end;
用Now返回的日期格式中年只有2位,即2000年显示为00, 这似乎不太令人满意. 此外Now和Time都只能获得精确到秒的时间,为了得到更精确的毫秒级时间,可以使用API函数GetSystemTime,它对应的TSystemTime类型的定义为:
TSystemTime = record
wYear: Word;
wMonth: Word;
wDayOfWeek: Word;
wDay: Word;
wHour: Word;
wMinute: Word;
wSecond: Word;
wMilliseconds: Word;
end;
显然,在程序逻辑中还能够方便地使用其结构成?时---各类时间值,因此使用函数GetSystemTime具有很大优越性。但该书中该函数的用法是错误的,通过查阅Windows SDK帮助可知,该函数原型为:
VOID GetSystemTime(LPSYSTEMTIME lpst),参数指针lpst获取系统时间,因此可如以下程序段实现:
procedure TForm1.Button3Click(Sender: TObject);
var
SysTime: TsystemTime;
begin
GetSystemTime(SysTime);
Caption:=IntToStr(SysTime.wYear)+' '+IntToStr(SysTime.wMonth);
//if SysTime.wYear>2000 then
// ......在程序逻辑中利用获取的各类时间值
end;
综合以上讨论,获取当前系统时间利用函数GetSystemTime比较方便而且灵活。
DELPHI环境中组件的创建技巧
--------------------------------------------------------------------------------
一、创建组件
从应用程序员的角度,即从某些使用组件去创建应用程序的人的角度看,组件是你能从组件板上选取,作为正在开发的应用程序的一部分,并编写事件处理代码使之成为专用。对一个组件开发者,DELPHI组件是一个直接地或间接地从TCOMPONENT派生的对象PASCAL类。
用DELPHI成功地开发和综合专用组件的关键是,它能够服从界面的各种需要和习惯以及DELPHI环境所期望组件的行为。
专用组件是一个对象PASCAL类,这个对象类是TCOMPONENT的后代,这使它本身就服从基本需要的大部分。例如,它给新组件出现在组件板上的能力,并且有能力与窗体设计者(FORM DESIGNEER)和对象检查器(OBJECT INSPECTOR)相互作用。可是,除了这些基本功能外,组件还可以定义任意复杂的行为和可以显示任意丰富的属性集给组件用户或应用程序员。这些对组件的标准及基本行为的扩充是组件编写者的责任。
要记住,有关专用组件最重要的事情是你可以用不同的方法来制作组件。几乎每一个做好的组件在设计和运用时通过它的属性和事件允许某中程度的专门化。但是,不可避免,你将触及到有关每个组件的限制或缺点。实际上,你需要一种特殊的组件编写者并没有预见的行为,给组件扩展新能力。或者,你需要使组件做某些根本不同的,在开始设计时并没有决定要做的事情。
二、扩展已有专用组件
在DELPHI中创建新组件的最容易的方法是通过对已存在组件类派生。你能使用任何DELPHI具有的标准组件作为派生你自己组件的基础。
例如,你可能要修改标准组件的某个特定属性的缺省值,使得这个缺省值在你将此组件放置到窗体上时自动地起作用。如果你发现你经常在运行时使用相同的方法调用序列去启动组件,或者,你发现只要你放置这个组件在窗体上后你就打算修改属性值,这可能是创建新组件的好机会,这个组件将通过缺省做所有事情,并且因此不需要将其放置在窗体上后做专门的初始化。
另外一个使你要定制一个已存在的可视控制的理由是,在某些标准窗口控制情形,例如编辑框和组合框,你可能想使用它们的一些非常规特征。为此,你必须在创建时设置专门的可选标志,以告知WINDOWS你需要建立一个专用控制,重载WINDOWS用于决定控制可视外观的创建属性。
三、创建从非专有类中派生一个新组件
创建一个“全新”可视组件仍然要从已存在VCL类中派生。扩展一个已有专用组件和创建一个全新组件之间的主要差别是,在后一种情况,你必须从一个非专用基类中派生,例如TWINCONTROL或TGRAPHICCONTRL,而不是从一个专用控制类派生,例如TLABLE,TMEMO或TCHECKBOX。
从非专用基类派生,确定将很多责任交到了组件创建者的手中。你必须关心组件与程序用户相互之间的细节和设计时界面的细节。
当你创建新组件时,你存取了一个对象的保护界面,这个界面是组件用户不可见的。对象PASCAL在类元素上定义4层保护,或成存取控制:私用的(private)、保护的(protected)、公共的(public)、和发表的(published)。通过指定保护层次,你能控制类元素被存取的上下文:谁可以从代码的那一块对它们存取。
组件用户可以存取实例的公共的和发表的元素。组件编写者,至少可以存取发表的,公共的和保护的元素。另外,如果派生类是与基础类被定义在同一个编译单元中,私有的元素也可以存取。
将类元素声明为私有的是隐藏它们的实现细节,与存取定义单元外的类实例的客户代码分开。将类元素作为私有的,使类的界面(发表的、公共的、保护的元素)与类的实现分开。这样,你可以在后来修改其实现而毫不影响客户代码。类用户自由地存取公共可用的元素而不必关心实现的细节。
可是,组件编写者的情况则多少有些进退两难。一方面,他们必须存取类实现的细节,以便修改或增强其父类提供的行为。另一方面,编写者是从一个已有组件派生新类,因此他也是组件的用户。从这个意义上讲,他应尽可能多地直接使用基础类,而不关心基础类实现的细节。
对象中这个两难问题是用提供保护界面解决的。存取控制的保护层恰恰给后继组件编写者足够的存取权,以便通过可能的继承方法扩展和修改组件。类对外部世界或对组件用户的封装仍然保持没有被析构,因此类封装的好处没有丢失。
当你派生新组件类时的主要考虑是决定哪个类是新类的父类。你必须研究已存在类的层次,以决定保护界面的哪些方面你要继承,而哪些方面你是不需要的。但是,一旦一个特殊类元素是公共的,它就不能成为私用的或保护的。类似地,一旦类元素已是发表的,它就保持发表状态,并且在所有那个类后代中都可以从对象视察器窗口可见。
四、创建组件示例
该例子说明的是:如何从一个已存在的专用类TDBText派生一个新组件类,通过增加BorderStyle属性以及重载PAINT事件产生一个类似TSTATICTEXT组件。具体实现如下:
首先选择Component/New Component; Ancestor Type:选择TDBText; Class Name:可以自己任意制定,这里为TDBStaticText;Palette Page:可以自己任意制定,这里为MyComponents;Unit File Name:可以自己任意制定,这里为c:my documents\dstatictext1.pas;Search path:为缺省值。选择 OK 之后,请输入以下源程序。
以上全部作完后保存你的新组件,选择Component/Install Component 并编译你的新组件。你将有一个名称为MyComponents 的新组件板,其中就有你刚制作的新组件TDBStaticText。
源程序清单:
unit DBStaticText;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DBCtrls;
type
TDBStaticBorderStyle = (sbsNone,sbsSingle,sbsSunken,sbsRaised);
TDBStaticText = class(TDBText)
private
{ Private declarations }
fBorderStyle : TDBStaticBorderStyle;
function GetBorderStyle:TDBStaticBorderStyle;
procedure SetBorderStyle(Value:TDBStaticBorderStyle);
protected
{ Protected declarations }
procedure Paint; override;
public
{ Public declarations }
published
{ Published declarations }
property BorderStyle : TDBStaticBorderStyle
read GetBorderStyle
write SetBorderStyle;
end;
procedure Register;
implementation
function TDBStaticText.GetBorderStyle:TDBStaticBorderStyle;
begin
Result := fBorderStyle
end;
procedure TDBStaticText.SetBorderStyle(Value:TDBStaticBorderStyle);
begin
if fBorderStyle <> Value then
begin
fBorderStyle := Value;
Invalidate;
end;
end;
procedure TDBStaticText.Paint;
var
Rect : TRect;
begin
// 设置颜色
Canvas.Brush.Color := Color;
// 获取长方形面积
Rect := GetClientRect();
// 用 DrawEdge API 画不同的边界
case fBorderStyle of
sbsSingle : DrawEdge(Canvas.Handle,Rect,EDGE_RAISED,BF_RECT+BF_FLAT);
sbsRaised : DrawEdge(Canvas.Handle,Rect,EDGE_RAISED,BF_RECT);
sbsSunken : DrawEdge(Canvas.Handle,Rect,EDGE_SUNKEN,BF_RECT);
end;
// 填充颜色
InflateRect(Rect,-2,-2);
Canvas.FillRect(Rect);
// 置文本对齐方式
case Alignment of
taLeftJustify : DrawText(Canvas.Handle,PChar(GetLabelText),-1,Rect,DT_LEFT + DT_VCENTER + DT_SINGLELINE);
taRightJustify : DrawText(Canvas.Handle,PChar(GetLabelText),-1,Rect,DT_RIGHT + DT_VCENTER + DT_SINGLELINE);
taCenter : DrawText(Canvas.Handle,PChar(GetLabelText),-1,Rect,DT_CENTER + DT_VCENTER + DT_SINGLELINE);
end;
end;
procedure Register;
begin
RegisterComponents('MyComponents', [TDBStaticText]);
end;
end.
以上代码在win98/Delphi5环境下调试通过.
用Delphi实现远程屏幕抓取
--------------------------------------------------------------------------------
在网络管理中,有时需要通过监视远程计算机屏幕来了解网上微机的使用情况。虽然,市面上有很多软件可以实现该功能,有些甚至可以进行远程控制,但在使用上缺乏灵活性,如无法指定远程计算机屏幕区域的大小和位置,进而无法在一屏上同时监视多个屏幕。其实,可以用Delphi自行编制一个灵活的远程屏幕抓取工具,简述如下。
一、软硬件要求。
Windows95/98对等网,用来监视的计算机(以下简称主控机)和被监视的计算机(以下简称受控机)都必须装有TCP/IP 协议,并正确配置。如没有网络,也可以在一台计算机上进行调试。
二、实现方法。
编制两个应用程序,一个为VClient.exe,装在受控机上,另一个为VServer.exe,装在主控机上。VServer.exe指定要监视的受控机的IP地址和将要在受控机屏幕上抓取区域的大小和位置,并发出屏幕抓取指令给VClient.exe,VClient.exe得到指令后,在受控机屏幕上选取指定区域,生成数据流,将其发回主控机,并在主控机上显示出抓取区域的BMP图象。由以上过程可以看出,该方法的关键有二:一是如何在受控机上进行屏幕抓取,二是如何通过TCP/IP协议在两台计算机中传输数据。
UDP(User Datagram Protocol,意为用户报文协议)是Internet上广泛采用的通信协议之一。与TCP协议不同,它是一种非连接的传输协议,没有确认机制,可靠性不如TCP,但它的效率却比TCP高,用于远程屏幕监视还是比较适合的。同时,UDP控件不区分服务器端和客户端,只区分发送端和接收端,编程上较为简单,故选用UDP协议,使用Delphi 4.0提供的TNMUDP控件。
三、创建演示程序。
第一步,编制VClient.exe文件。新建Delphi工程,将默认窗体的Name属性设为“Client”。加入TNMUDP控件,Name属性设为“CUDP”;LocalPort属性设为“1111”,让控件CUDP监视受控机的1111端口,当有数据发送到该口时,触发控件CUDP的OnDataReceived事件;RemotePort属性设为“2222”,当控件CUDP发送数据时,将数据发到主控机的2222口。
在implementation后面加入变量定义
const BufSize=2048;{ 发送每一笔数据的缓冲区大小 }
var
BmpStream:TMemoryStream;
LeftSize:Longint;{ 发送每一笔数据后剩余的字节数 }
为Client的OnCreate事件添加代码:
procedure TClient.FormCreate(Sender: TObject);
begin
BmpStream:=TMemoryStream.Create;
end;
为Client的OnDestroy事件添加代码:
procedure TClient.FormDestroy(Sender: TObject);
begin
BmpStream.Free;
end;
为控件CUDP的OnDataReceived事件添加代码:
procedure TClient.CUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var
CtrlCode:array[0..29] of char;
Buf:array[0..BufSize-1] of char;
TmpStr:string;
SendSize,LeftPos,TopPos,RightPos,BottomPos:integer;
begin
CUDP.ReadBuffer(CtrlCode,NumberBytes);{ 读取控制码 }
if CtrlCode[0]+CtrlCode[1]+CtrlCode[2]+CtrlCode[3]='show' then
begin { 控制码前4位为“show”表示主控机发出了抓屏指令 }
if BmpStream.Size=0 then { 没有数据可发,必须截屏生成数据 }
begin
TmpStr:=StrPas(CtrlCode);
TmpStr:=Copy(TmpStr,5,Length(TmpStr)-4);
LeftPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)
-Pos(':',TmpStr));
TopPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
TmpStr:=Copy(TmpStr,Pos(':',TmpStr)+1,Length(TmpStr)-
Pos(':',TmpStr));
RightPos:=StrToInt(Copy(TmpStr,1,Pos(':',TmpStr)-1));
BottomPos:=StrToInt(Copy(TmpStr,Pos(':',TmpStr
)+1,Length(TmpStr)-Pos(':',TmpStr)));
ScreenCap(LeftPos,TopPos,RightPos,BottomPos); {
截取屏幕 }
end;
if LeftSize>BufSize then SendSize:=BufSize
else SendSize:=LeftSize;
BmpStream.ReadBuffer(Buf,SendSize);
LeftSize:=LeftSize-SendSize;
if LeftSize=0 then BmpStream.Clear;{ 清空流 }
CUDP.RemoteHost:=FromIP; { FromIP为主控机IP地址 }
CUDP.SendBuffer(Buf,SendSize); { 将数据发到主控机的2222口 }
end;
end;
其中ScreenCap是自定义函数,截取屏幕指定区域,
代码如下:
procedure TClient.ScreenCap(LeftPos,TopPos,
RightPos,BottomPos:integer);
var
RectWidth,RectHeight:integer;
SourceDC,DestDC,Bhandle:integer;
Bitmap:TBitmap;
begin
RectWidth:=RightPos-LeftPos;
RectHeight:=BottomPos-TopPos;
SourceDC:=CreateDC('DISPLAY','','',nil);
DestDC:=CreateCompatibleDC(SourceDC);
Bhandle:=CreateCompatibleBitmap(SourceDC,
RectWidth,RectHeight);
SelectObject(DestDC,Bhandle);
BitBlt(DestDC,0,0,RectWidth,RectHeight,SourceDC,
LeftPos,TopPos,SRCCOPY);
Bitmap:=TBitmap.Create;
Bitmap.Handle:=BHandle;
BitMap.SaveToStream(BmpStream);
BmpStream.Position:=0;
LeftSize:=BmpStream.Size;
Bitmap.Free;
DeleteDC(DestDC);
ReleaseDC(Bhandle,SourceDC);
end;
存为“C:\VClient\ClnUnit.pas”和“C:\VClient\VClient.dpr”,并编译。
第二步,编制VServer.exe文件。新建Delphi工程,将窗体的Name属性设为“Server”。加入TNMUDP控件,Name属性设为“SUDP”;LocalPort属性设为“2222”,让控件SUDP监视主控机的2222端口,当有数据发送到该口时,触发控件SUDP的OnDataReceived事件;RemotePort属性设为“1111”,当控件SUDP发送数据时,将数据发到受控机的1111口。加入控件Image1,Align属性设为“alClient”;加入控件Button1,Caption属性设为“截屏”;加入控件Label1,Caption属性设为“左:上:右:下”;加入控件Edit1,Text属性设为“0:0:100:100”;加入控件Label2,Caption属性设为“受控机IP地址”;加入控件Edit2,Text属性设为“127.0.0.1”;
在implementation后面加入变量定义
const BufSize=2048;
var
RsltStream,TmpStream:TMemoryStream;
为Server的OnCreate事件添加代码:
procedure TServer.FormCreate(Sender: TObject);
begin
RsltStream:=TMemoryStream.Create;
TmpStream:=TMemoryStream.Create;
end;
为Client的OnDestroy事件添加代码:
procedure TServer.FormDestroy(Sender: TObject);
begin
RsltStream.Free;
TmpStream.Free;
end;
为控件Button1的OnClick事件添加代码:
procedure TServer.Button1Click(Sender: TObject);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.Text;
StrpCopy(ReqCode,ReqCodeStr);
TmpStream.Clear;
RsltStream.Clear;
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;
为控件SUDP的OnDataReceived事件添加代码:
procedure TServer.SUDPDataReceived(Sender: TComponent;
NumberBytes: Integer; FromIP: String);
var ReqCode:array[0..29] of char;ReqCodeStr:string;
begin
ReqCodeStr:='show'+Edit1.text;
StrpCopy(ReqCode,ReqCodeStr);
SUDP.ReadStream(TmpStream);
RsltStream.CopyFrom(TmpStream,NumberBytes);
if NumberBytes< BufSize then { 数据已读完 }
begin
RsltStream.Position:=0;
Image1.Picture.Bitmap.LoadFromStream(RsltStream);
TmpStream.Clear;
RsltStream.Clear;
end
else
begin
TmpStream.Clear;
ReqCode:='show';
SUDP.RemoteHost:=Edit2.Text;
SUDP.SendBuffer(ReqCode,30);
end;
end;
存为“C:\VServer\SvrUnit.pas”和“C:\VServer\VServer.dpr”,并编译。
四、测试。
1、本地机测试:在本地机同时运行Vserver.exe和VClient.exe,利用程序的默认设置,即可实现截屏。查看“控制面板”-“网络”-“TCP/IP”-“IP地址”,将程序的“客户IP地址”设为该地址 ,同样正常运行。
2、远程测试:选一台受控机,运行VClient.exe;另选一台主控机,运行VServer.exe,将“受控机IP地址”即Edit2的内容设为受控机的IP地址,“截屏”即可。以上简要介绍了远程屏幕抓取的实现方法,至于在主控机上一屏同时监视多个受控机,读者可自行完善。以上程序,在Windows98对等网、Delphi 4.0下调试通过。
如何在Delphi中使用资源文件
--------------------------------------------------------------------------------
资源也是数据,它相当于我们熟悉的只读数据。在应用程序的可执行代码中,它是单独存储的,当其被调用时才载入程序,在程序执行完后又退出。Delphi中的资源有很多类型,适用于不同的地方,大致有以下几类:
●图标资源:是一种小型位图,用户常常用不同的图标代替不同的应用程序。
●光标资源:也是小型的位图,不过它适用的颜色不多。Delphi已经给光标指定了一个光标图案集,就是我们操作中常用到的Cursor属性,同时用户也可自定义光标图案。
●位图资源:Delphi只是将位图资源存入资源文件中,在使用时从资源文件中调出。
●字符串资源:将字串符文件存储于资源文件中。
本文通过实例程序来说明资源在Delphi中的用法,所有示例程序均在Delphi 4中调试通过。
1、生成资源文件
在Delphi中提供了一个图形编辑器(Image Editor),通过该编辑器可以编辑生产Bitmap、Icon和Cursor三种资源文件,也可以直接绘制ICO、CUR和BMP文件。该编辑器不能进行文字处理,具体文字处理在后面介绍。编辑图形类资源文件时,首先启动Image Editor,选择:File->New->Resource File;在弹出的窗口中用鼠键右键单击“Contents”,再弹出的菜单中单击:New;选择需要编辑的资源文件的类型(Bitmap、Icon或Cursor)。
2、装载与使用资源文件
资源文件编辑生成后(文件名后缀为.res),要使用这些资源文件,首先要通过添加代在表单文件的implementation关键字中加入:
{ *.DFM}
{资源文件名.RES}
定义了资源文件并且在单元文件中包括了资源文件名,需要调用Windows的API函数调用资源文件里的内容,如:LoadIcon,LoadString,LoadBitmap,LoadResource等。
例如:下面的语句装入了一个名为mybmp.bmp的文件:
Bmp.Handle := LoadBitmap(Hinstance , 'mybmp.bmp');
下面示例程序说明了图标、光标和位图资源的使用方法,在资源文件TEST.RES中定义了两个光标(cur1和cur2)、两个位图(bmp1和bmp2)以及两个图标(in1和in2),在程序中对这些资源都进行了调用。并利用定时器使位图和图标的显示有类似动画的感觉。当鼠标移动到Ladel1上时,光标会变成你定义的第一个光标形状;当单击Button1后,再把光标移到Ladel1上时,光标会变成你定义的第二个光标形状。
unit testtes;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
Image1: TImage;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
bmp12 : Integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{ *.DFM}
{ TEST.RES}
const
crMycur1 = 1;
crMycur2 = 2;
procedure TForm1.FormCreate(Sender: TObject);
var
bmp : TBitmap;
ico : TIcon;
begin
Screen.Cursors[crMycur1] := LoadCursor(Hinstance,'CUR1');
Screen.Cursors[crMycur2] := LoadCursor(Hinstance,'CUR2');
Label1.Cursor := crMycur1;
bmp := TBitmap.Create ;
bmp.Handle := LoadBitmap(Hinstance,'BMP1');
Image1.Width := bmp.Width + 10;
Image1.Height := bmp.Height + 10;
Image1.Canvas.Draw(4,8,bmp);
bmp12 := 1;
ico := TIcon.Create ;
ico.Handle := LoadIcon(Hinstance,'IN1');
Icon := ico;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Cursor := crMycur2;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
bmp:TBitmap;
ico : TIcon;
begin
bmp := TBitmap.Create ;
ico := TIcon.Create ;
if bmp12=1 then bmp12 := 2 else bmp12 :=1;
bmp.Handle := LoadBitmap(Hinstance,PChar('BMP'+IntToStr(bmp12)));
ico.Handle := LoadIcon(Hinstance,PChar('IN'+IntToStr(bmp12)));
Image1.Width := bmp.Width + 10;
Image1.Height := bmp.Height + 10;
Image1.Canvas.Draw(4,6,bmp);
Icon := ico;
end;
end.
3、字符串资源的定义与使用
字符串的存储在应用程序中是独立的,应用程序只有在使用资源时载入,使用完之后清除,从而节省内存,同时字符串也可以用于翻译,一些汉化软件都利用了字符串。编辑的字符串放在一个文本文件中,可以使用Delphi中的:File->New->Text,编辑字符串文件,字符串文件的格式如下:
stringtable
begin
1,"book"
2,"apple"
3,"desk"
4,"pen"
5,"computer"
end
编辑完字符串文件后,选择Save as,注意要将文件类型改为资源编译文件(.RC),这还不是资源文件,它还必须经过编译才能成为资源文件(.RES)。编译命令为Dos提示符下的BRCC32,其路径为:D:Program FilesBorlandDelphi4Binrcc32.exe;例如上面的字符串资源编译文件名为:StrRes.rc,在DOS提示符下输入:brcc32 mydirStrRes.rc;则编译后会生成一个名为:StrRes.res的资源文件,使用该文件即可访问字符串资源。具体使用见下例:
unit teststr;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
count : integer;
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{ *.DFM}
{ StrRes.RES}
const
wordcount = 5;
procedure TForm1.Button1Click(Sender: TObject);
var
strword : string;
begin
if count>wordcount then count := 1;
strword := LoadStr(count);
label1.Caption := strword;
count := count + 1;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
label1.Caption := LoadStr(1);
count := 2;
end;
end.
程序中常量wordcount用来记录字符串资源文件中字符串的数量,变量count用来记录显示的字符串编号。程序运行后单击Button1按钮,则将循环显示字符串资源文件中的每一个字符串。
利用Delphi开发旅游景点微机售票系统
--------------------------------------------------------------------------------
一、引言
随着计算机局域网和广域网的出现,网络产品(包括软、硬件)质量不断提高;品种、数量迅速增长和发展;以及数据库技术的成熟和软件工程方法的发展,各种计算机网络管理系统越来越完善。旅游景点微机售票系统是计算机技术与网络技术相结合的产物。方便快捷的查询统计使管理者能准确地掌握景点的经营情况并对售票人员进行监督、管理,并为其提供准确、可信的决策依据。其成功实现提高了旅游景点的售票效率和管理水平,使一直由人工售票的局面划上句号,从而进入智能化售票的新阶段。
本文介绍以Delphi 4.0为开发语言,Microsoft SQL Server 6.5为后台,运行于Windows NT 4.0的旅游景点微机售票系统的开发方法。该系统适合各大、中、小旅游景点售票系统的自动化管理,具有较强的实际推广应用价值。
二、系统总体方案设计
微机售票系统采用星形拓扑局域网结构,由服务器、集线器、计算机、打印机组成,见图1。服务器上运行数据库及系统管理程序,实现查询、统计、报表打印、系统维护等功能。各售票微机与相应的打印机放置在售票窗口,运行售票程序,完成界面输入、门票打印及售票员个人信息查询统计等功能。
对于售票系统来说,打印机的速度和数据通过网络的传输速度是非常关键的指标。如秦皇岛野生动物园在其高峰期,每天有大约2万人入园游览,要求使用三台微机进行售票,而入园客人大都集中在同一段时间,如早晨刚开园到上午10点左右,下午2点~3点之间等,所以减少游客排队等候时间、加快售票速度就是微机售票系统必须解决的问题。影响售票速度有两方面因素,一是硬件打印机的打印速度,二是打印程序启动打印和传输数据的速度。经实际测试,EPSON stylus color 850彩色喷墨打印机,其打印速度为A4纸8页/分钟,能够满足要求。
在程序方面为了满足打印速度的要求,经过测试和精心选择,确定用Delphi 4.0做为程序设计语言。Delphi把强大的对象Pascal语言和快捷便利的RAD相结合,是一个通用的图形用户界面(GUI)开发工具,它是基于可视化和组件的概念而设计出来的,而且能非常方便地操纵数据库及实现各种报表,使得编程迅速,且是目前调试编译速度最快的编程语言之一。在门票打印时直接调用Delphi的类Printers中的各种过程和函数,如Printers.Canvas.Textout(x:integer;y:integer;const Text:string)再结合其他的过程和函数即可实现快速打印,解决了程序打印速度的问题。
系统选择SQL Sever做为数据库,SQL Sever是一个客户机/服务器关系型数据管理系统(RDBMS),使用Transact-SQl在客户机和SQL Sever之间发送请求,能够满足系统的网络传输要求。Delphi中可以通过BDE(数据库引擎)和ODBC进行数据库访问,或者通过ADO直接进行数据库访问。
另外在总的程序设计时,考虑到使用本系统的操作员素质参差不齐,计算机操作水平相对较低,所涉及的操作要尽可能简单,尽量少输入信息,尽量使用下拉框和选择框,避免出错。本系统操作员要输入的只有游客人数(成人和小孩或学生)和车辆数。其他信息如票价,程序启动时从数据库中自动调出,时间取自系统时间,总价由计算机自动生成,界面简单、操作容易、易学易用。
三、系统软件总体设计
1.数据库表设计
系统数据库中共有零售票信息表、密码表、操作员信息表、票价信息表,以及为统计查询建造的视图等。以零售票信息表为例介绍表的结构。其字段定义如表1所示。
序列号:由售票员的标识符号,随机号和微机售票开始的票数记录组成。如GK006662,代表标识号为G的售票员,随机号为K,第6662张票。
退票否:此字段用来标识票是否有效,若有效,则为1,无效为0。
2.软件结构设计
系统软件设计遵循模块化程序设计的思想,自顶向下,步步求精。系统程序由系统管理模块和售票模块组成。售票模块运行在售票微机上,系统管理模块运行在服务器上。
四、系统主要功能特性及实现方法
系统主要模块:登录及密码输入模块;系统主界面输入模块;统计、查询、报表、打印模块;门票打印模块。下面分述各模块的功能以及关键部分的实现。
1.登录及密码输入模块
登录及密码输入模块用于限制操作员的权限,程序完成的功能:从界面上取出密码,查询数据库密码表,有相同密码操作员有权进入下一界面,三次输入失败,程序自动退出。另外在售票模块中,根据密码要取出对应的操作员的名字,以便将售票信息与操作员相关联。从数据库中根据输入密码取相应的操作员函数如下,其中handletbl为密码表名称,id、handlename、handlecode为表中字段,代表编号、操作员姓名、操作员密码。
function TFormPswd.gethandlename(code:String):String;
var name:String;
begin
name:='';
Query2.Close;
Query2.SQL.Clear;
Query2.DisableControls;
Query2.SQL.Add('Select id,handlename,handlecode from handletbl');
Query2.Open;
if Query2.locate('handlecode',code,[]) then
begin
name:=query2.FieldByName('handlename').AsString;
end;
Query2.close;
Result:=name;
end;
2.系统主界面输入模块
系统的主界面输入模块用于输入和显示售票信息,根据其信息和票价自动计算出游客的总人数以及票价。在此模块中要求操作员只输入游客人数,按“确定”,即可自动计算和显示总价,按“打印”则打印门票。为了防止操作员误输入除整型数据以外的其他字符如A、B等而导致程序出错,程序中在需要数据输入的Tedit位置,设置判断条件,只允许整型数据输入。
3.统计与查询、报表打印模块
统计与查询、报表打印模块用于实现售票信息的统计与查询,可以设定起止日期等信息,并可生成报表打印。统计与查询用内嵌的SQL查询语言实现,报表使用Delphi的快速报表组件Qreport部件组中的各种控件。
4.门票打印模块
门票打印模块实现门票的打印输出功能。在门票打印中需根据门票的样式确定输出的位置,为了实现快速打印,在打印时直接调用printers的过程和函数。
打印的过程如下:
procedure printmsg(thesyqo,Totalpeople,adultNum, childNum,Totalcar,bigcar,middlecar,minicar,totalmoney, prtdate:String);
begin
Printer.Canvas.Font.Charset := GB2312_CHARSET;
Printer.BeginDoc;
Printer.PageHeight;
Printer.PageWidth;
Printer.Canvas.Font.Size :=14;//字体设置
……//根据用户需要插入要打印的内容
Printer.Canvas.TextOut(x+2370,y,thesyqo);//打印内容
Printer.EndDoc;
end;
5.退票管理模块
实际的售票过程中涉及到由于各种原因游客退票的情况,而计算机打印售出的门票及相关信息已经存入数据库中,当有退票情况发生时,必然存在操作员售票金额与数据库查询结果不一致的现象,为了解决这一现象,增加了退票管理模块。
Delphi 应用编程实例简介
--------------------------------------------------------------------------------
1. 控制INI文件几法
要利用.INI文件做程序有关数据的存储工作,就需要能读和写.INI文件,所以列了如下方法给大家参考:
从.INI文件中获取字符串
var
strResult:pchar;
begin
GetPrivateProfileString(
'windows', // []中标题的名字
'NullPort', // =号前的名字
'NIL', // 如果没有找到字符串时,返回的默认值
strResult, //存放取得字符
100, //取得字符的允许最大长度
'c:\forwin95\win.ini' // 调用的文件名
);
edit1.text:=strResult; //显示取得字符串
从.INI文件中获取整数
edit1.text:=inttostr(GetPrivateProfileInt(
'intl', // []中标题的名字
'iCountry', // =号前的名字
0,// 如果没有找到整数时,返回的默认值
'c:\forwin95\win.ini' // 调用的文件名
));
向.INI文件写入字符串
WritePrivateProfileString(
'windows', // []中标题的名字
'load', // 要写入“=”号前的字符串
'accca', //要写入的数据
'c:\forwin95\win.ini' // 调用的文件名
);
向.INI文件写入整数
WritePrivateProfileSection(
'windows', // []中标题的名字
'read=100', // 要写入的数据
'c:\forwin95\win.ini' // 调用的文件名
);
上面的方法是调用API函数,下面介绍另一种不用API从.INI文件中获取字符的方法
var MyIni: TIniFile;
begin
MyIni := TIniFile.Create('WIN.INI');//调用的文件名
edit1.text:=MyIni.ReadString('Desktop', 'Wallpaper', '');//取得字符
end;
向.INI文件中写入字符的方法
var MyIni: TIniFile;
begin
MyIni := TIniFile.Create('WIN.INI');//调用的文件名
DelphiIni.WriteString('Desktop', 'Wallpaper', 'c:\a.bmp');
end;
2.转让控制权
有时由于长时间的循环语句占用了cpu的处理权,无法运行 其他程序,照成死循环。这时用以下命令转让控制权,让操作系统处理其他事件。
Application.ProcessMessages;
3.得到执行程序的目录
SysUtils 单元中有 ExtractFileDir 与 ExtractFilePath两个类似的函数, 用哪一个?没有太大的关系。
不过有以下的差别: ExtractFilePath 传回值的最後一个字元是反斜杠“/”。
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(ExtractFileDir(Application.Exename));
// ie: c:\temp
ShowMessage(ExtractFilePath(Application.Exename));
// ie: c:\temp\
end;
相同点: 如果执行文件在根目录下(如:C:\SAMPLE.EXE)的话, 两者的传回值相同, 且最后一个字符都是“/”。
4.打开已注册文件
打开Windows已经注册的文件其实很简单,根据以下代码定义一个过程:
procedure URLink(URL:PChar);
begin
ShellExecute(0, nil, URL, nil, nil, SW_NORMAL);
end;
在要调用的地方使用
URLink('Readme.txt');
如果是链接主页的话,那么改用
URLink('[url]http://qqxw.yeah.net[/url]');
5.得到Windows用户名和序列号
如何得到Windows的用户名称和产品序列号呢?
1. 可以用 WNetGetUser() 这个函数来得到 user name;
2. Windows 95 的产品序号可以用 TRegistry 到 Registry Database 中找出来;
// 取得用户名称
function GetUserName: AnsiString;
var
lpName: PAnsiChar;
lpUserName: PAnsiChar;
lpnLength: DWORD;
begin
Result := '';
lpnLength := 0;
WNetGetUser(nil, nil, lpnLength); // 取得字串长度
if lpnLength > 0 then
begin
GetMem(lpUserName, lpnLength);
if WNetGetUser(lpName, lpUserName, lpnLength) = NO_ERROR then
Result := lpUserName;
FreeMem(lpUserName, lpnLength);
end;
end; { GetUserName }
// 取得 Windows 产品序号
function GetWindowsProductID: string;
var
reg: TRegistry;
begin
Result := '';
reg := TRegistry.Create;
with reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('Software\Microsoft\Windows\CurrentVersion', False);
Result := ReadString('ProductID');
end;
reg.Free;
end;
6.关闭外部应用程序
如何在 Delphi 应用程序中, 去关闭外部已开启的应用程序?
下面给出一段在 Delphi 中关闭“计算器”程序为例:
var
HWndCalculator : HWnd;
begin
// find the exist calculator window
HWndCalculator := Winprocs.FindWindow(nil, '计算器'); // close the exist Calculator
if HWndCalculator <> 0 then
SendMessage(HWndCalculator, WM_CLOSE, 0, 0);
end;
7.查阅可视窗口标题
下面只是举出一个例子提供参考:
运用API函数GetWindow()配合GetWindowText()逐一查出各视窗的标题
1. File | New Project 开始一个新的工程
2. 在 Form1 中安排 Button 与 Memo 各一
3. 在 Button1 的 OnClick 事件中撰写程式如下:
procedure TForm1.Button1Click(Sender: TObject);
var
hCurrentWindow: HWnd;
szText: array[0..254] of char;
begin
hCurrentWindow := GetWindow(Handle, GW_HWNDFIRST);
while hCurrentWindow <> 0 do
begin
if GetWindowText(hCurrentWindow, @szText, 255)>0 then
Memo1.Lines.Add(StrPas(@szText));
hCurrentWindow:=GetWindow(hCurrentWindow, GW_HWNDNEXT);
end;
end;