拷一份来看看:把以下代码代码加到工程文件里(选择Project-->view source)var WinHandle:THANDLE; begin WinHandle:=FindWindow(nil,'某某系统'); if WinHandle=0 then Application.Initialize; Application.CreateForm(TForm1,Form1); Application.Run; else begin showmessage('程序已经运行!') //这句可去掉,直接切换到已运行的实例 windows.setfocus(WinHandle) windows.setforeground(WinHandle) end; end.
copy from DELPHI 5编程实例与技巧同时只运行程序的一个实例 对于有些应用程序,只希望在系统中运行它的一个实例,也就是在程序运行期间,禁止它 图16-50 例程S16_31 的运行界面ഊ第二次运行。 为了实现上述功能,可以采用下面的方法:在主窗体初始化的时候,设置窗体的类名。应 用程序在运行的最开始,判断当前系统中是否存在该窗体类名。如果存在,则给已经运行的应 用程序发送一个还原或在前台显示的消息,并且退出;如果不存在,则继续执行应用程序。 例程S16_32 该例程对上述功能进行了说明。 首先在主窗体中自定义一个消息,并为主窗体的类名定义一个字符串常量。为了设置窗体 的类名,需要重载T C u s t o m F o r m 类的方法C r e a t e P a r a m s 。在U n i t 1 . p a s 中添加代码如下: i n t e r f a c e u s e s Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; c o n s t C M _ R E S TORE = WM_USER + $1000; // 自定义一个消息,用来恢复窗口 APPNAME = 'S16_33'; // 窗体类名字符串常量 t y p e TForm1 = class(TForm) . . . p u b l i c procedure CreateParams(var Params: TCreateParams); override; Procedure RestoreRequest(var message: TMessage); message CM_RESTO R E ; e n d ; . . . i m p l e m e n t a t i o n {$R *. D F M } { TForm1 } procedure TForm1.CreateParams(var Params: TCreateParams); b e g i n // 设置窗体的类名 inherited CreateParams(Params); P a r a m s . WinClassName := APPNAME; e n d ; 下面添加测试窗体类名的代码。 为了在程序运行的一开始就测试当前系统中是否存在主窗体中要定义的类名,可以在工程 文件中添加代码进行测试。测试前需要定义与主窗体中一致的自定义消息和窗体类名字符串常 量。工程文件中的有关代码如下: program Project1; u s e s F o r m s , M e s s a g e s , Wi n d o w s , Unit1 in 'Unit1.pas' {Form1}; c o n s t // 自定义一个消息,用来恢复窗口 C M _ R E S TORE = WM_USER + $1000; APPNAME = 'S16_33'; // 窗体类名字符串常量 v a r 430 基本第三部分Delphi 高级编程技术 下载ഊRvHandle : hWnd; // 窗口句柄 {$R *. R E S } b e g i n RvHandle := FindWindow(APPNAME, NIL); // 根据窗体类名查找窗口句柄 if RvHandle > 0 then // 如果找到则发送自定义的消息并退出 b e g i n PostMessage(RvHandle, CM_RESTORE, 0, 0); E x i t ; e n d ; A p p l i c a t i o n . I n i t i a l i z e ; Application.CreateForm(TForm1, Form1); A p p l i c a t i o n . R u n ; e n d . 最后将在主窗体中添加接收自定义消息的代码。 在U n i t 1 . p a s 文件中T F o r m 1 的定义中添加接收自定义消息的过程R e s t o r e R e q u e s t ,并在类的 定义体中按下C t r l + S h i f t + C ,完善过程的定义体。具体代码如下: t y p e TForm1 = class(TForm) . . . p u b l i c procedure CreateParams(var Params: TCreateParams); override; Procedure RestoreRequest(var message: TMessage); message CM_RESTO R E ; e n d ; . . . procedure TForm1.RestoreRequest(var message: TMessage); b e g i n // 接到自定义的消息后,如果处于最小化状态则恢复,否则放置到桌面的最前面 M e s s a g e B o x ( H a n d l e , '程序" ' + A P P N A M E + ' "已经运行了。' , '信息' , M B _ O K + M B _ I C O N I N F O R M AT I O N + M B _ S Y S T E M M O D A L ) ; if IsIconic(Application.Handle) = TRUE then A p p l i c a t i o n . R e s t o r e e l s e A p p l i c a t i o n . B r i n g To F r o n t ; e n d ; 程序编译、链接通过后,可以在Wi n d o w s 的资源管理器中运行测试。 第16 章章其他编程技术章名431 下载
简单方法: 窗体加载时 procedure TForm1.FormCreate(Sender: TObject); Var atom:integer; begin if GlobalFindAtom('PROGRAM_RUNNING') = 0 then atom := GlobalAddAtom('PROGRAM_RUNNING') else begin Application.MessageBox('程序已运行','系统提示',MB_OK+MB_IconInformation+MB_SystemModal); Halt; end; end; 窗体关闭时 procedure TForm1.FormDestroy(Sender: TObject); begin GlobalDeleteAtom(atom); end;
WinHandle:THANDLE;
begin
WinHandle:=FindWindow(nil,'某某系统');
if WinHandle=0 then
Application.Initialize;
Application.CreateForm(TForm1,Form1);
Application.Run;
else
begin
showmessage('程序已经运行!') //这句可去掉,直接切换到已运行的实例
windows.setfocus(WinHandle)
windows.setforeground(WinHandle)
end;
end.
对于有些应用程序,只希望在系统中运行它的一个实例,也就是在程序运行期间,禁止它
图16-50 例程S16_31 的运行界面ഊ第二次运行。
为了实现上述功能,可以采用下面的方法:在主窗体初始化的时候,设置窗体的类名。应
用程序在运行的最开始,判断当前系统中是否存在该窗体类名。如果存在,则给已经运行的应
用程序发送一个还原或在前台显示的消息,并且退出;如果不存在,则继续执行应用程序。
例程S16_32 该例程对上述功能进行了说明。
首先在主窗体中自定义一个消息,并为主窗体的类名定义一个字符串常量。为了设置窗体
的类名,需要重载T C u s t o m F o r m 类的方法C r e a t e P a r a m s 。在U n i t 1 . p a s 中添加代码如下:
i n t e r f a c e
u s e s
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
c o n s t
C M _ R E S TORE = WM_USER + $1000; // 自定义一个消息,用来恢复窗口
APPNAME = 'S16_33'; // 窗体类名字符串常量
t y p e
TForm1 = class(TForm)
. . .
p u b l i c
procedure CreateParams(var Params: TCreateParams); override;
Procedure RestoreRequest(var message: TMessage); message CM_RESTO R E ;
e n d ;
. . .
i m p l e m e n t a t i o n
{$R *. D F M }
{ TForm1 }
procedure TForm1.CreateParams(var Params: TCreateParams);
b e g i n
// 设置窗体的类名
inherited CreateParams(Params);
P a r a m s . WinClassName := APPNAME;
e n d ;
下面添加测试窗体类名的代码。
为了在程序运行的一开始就测试当前系统中是否存在主窗体中要定义的类名,可以在工程
文件中添加代码进行测试。测试前需要定义与主窗体中一致的自定义消息和窗体类名字符串常
量。工程文件中的有关代码如下:
program Project1;
u s e s
F o r m s , M e s s a g e s , Wi n d o w s ,
Unit1 in 'Unit1.pas' {Form1};
c o n s t
// 自定义一个消息,用来恢复窗口
C M _ R E S TORE = WM_USER + $1000;
APPNAME = 'S16_33'; // 窗体类名字符串常量
v a r
430 基本第三部分Delphi 高级编程技术
下载ഊRvHandle : hWnd; // 窗口句柄
{$R *. R E S }
b e g i n
RvHandle := FindWindow(APPNAME, NIL); // 根据窗体类名查找窗口句柄
if RvHandle > 0 then // 如果找到则发送自定义的消息并退出
b e g i n
PostMessage(RvHandle, CM_RESTORE, 0, 0);
E x i t ;
e n d ;
A p p l i c a t i o n . I n i t i a l i z e ;
Application.CreateForm(TForm1, Form1);
A p p l i c a t i o n . R u n ;
e n d .
最后将在主窗体中添加接收自定义消息的代码。
在U n i t 1 . p a s 文件中T F o r m 1 的定义中添加接收自定义消息的过程R e s t o r e R e q u e s t ,并在类的
定义体中按下C t r l + S h i f t + C ,完善过程的定义体。具体代码如下:
t y p e
TForm1 = class(TForm)
. . .
p u b l i c
procedure CreateParams(var Params: TCreateParams); override;
Procedure RestoreRequest(var message: TMessage); message CM_RESTO R E ;
e n d ;
. . .
procedure TForm1.RestoreRequest(var message: TMessage);
b e g i n
// 接到自定义的消息后,如果处于最小化状态则恢复,否则放置到桌面的最前面
M e s s a g e B o x ( H a n d l e , '程序" ' + A P P N A M E + ' "已经运行了。' ,
'信息' , M B _ O K + M B _ I C O N I N F O R M AT I O N + M B _ S Y S T E M M O D A L ) ;
if IsIconic(Application.Handle) = TRUE then
A p p l i c a t i o n . R e s t o r e
e l s e
A p p l i c a t i o n . B r i n g To F r o n t ;
e n d ;
程序编译、链接通过后,可以在Wi n d o w s 的资源管理器中运行测试。
第16 章章其他编程技术章名431 下载
窗体加载时
procedure TForm1.FormCreate(Sender: TObject);
Var
atom:integer;
begin
if GlobalFindAtom('PROGRAM_RUNNING') = 0 then
atom := GlobalAddAtom('PROGRAM_RUNNING')
else begin
Application.MessageBox('程序已运行','系统提示',MB_OK+MB_IconInformation+MB_SystemModal);
Halt;
end;
end;
窗体关闭时
procedure TForm1.FormDestroy(Sender: TObject);
begin
GlobalDeleteAtom(atom);
end;