如题,加了防止二次启动的代码,第二次启动程序时,当程序最小化着的时候,可以做到将程序还原,但发现程序会失去焦点,任务栏闪烁,不知什么原因,请有经验的朋友不吝赐教
PS:我的程序有悬浮窗(副窗体),二次启动时,测试发现主窗体和悬浮窗都不是焦点。也许我的代码有问题,防止两个实例比较好的代码是什么呢?要求是第二次启动时,将程序主窗体置前。谢谢
PS:我的程序有悬浮窗(副窗体),二次启动时,测试发现主窗体和悬浮窗都不是焦点。也许我的代码有问题,防止两个实例比较好的代码是什么呢?要求是第二次启动时,将程序主窗体置前。谢谢
Forms,
windows,
ut_main in 'ut_main.pas' {fm_main},
ut_var in 'ut_var.pas',
ut_function in 'ut_function.pas',
ut_subject in 'ut_subject.pas' {fm_subject},
ut_edu in 'ut_edu.pas' {fm_edu},
ut_display in 'ut_display.pas' {fm_display},
ut_display_f in 'ut_display_f.pas' {fm_display_f},
ut_help in 'ut_help.pas' {fm_help},
ut_about in 'ut_about.pas' {fm_about};{$R *.res}var
myMutex, FindHid: HWND; //需要Uses Windows单元
MoudleName: string;//由于用于api回调函数,请使用windows传统的参数传递方式stdcall
function EnumWndProc(hwnd: Thandle; param: Cardinal): bool; stdcall;
var
ClassName, WinMoudleName: string;
WinInstance: THandle;
begin
result := true;
SetLength(ClassName, 100);
//获得当前遍历窗口的类名
GetClassName(hwnd, pchar(ClassName), length(ClassName));
ClassName := pchar(ClassName); //在字符串后加结束符,确定字符串结束
if ClassName = Tfm_main.ClassName then //比较
begin
//获得当前遍历窗口的实例
WinInstance := GetWindowLong(hwnd, GWL_HINSTANCE);
setlength(WinMoudleName, 100);
//获得当前遍历窗口的程序文件名
GetModuleFileName(WinInstance, pchar(WinMoudleName), length(WinMoudleName));
WinMoudleName := pchar(WinMoudleName);
//MoudleName为工程全局变量,自身程序的文件名
if WinMoudleName = MoudleName then
begin
FindHid := hwnd; //FindHid为工程全局变量保存找到的句炳
result := false; //找到以后就结束遍历
end;
end;
end;begin
// CreateMutex建立互斥对象,并且给互斥对象起一个唯一的名字。
myMutex := CreateMutex(nil, false, 'hkOneCopy');
//程序没有被运行过
if WaitForSingleObject(myMutex, 0) <> wait_TimeOut then
begin
Application.Initialize;
Application.CreateForm(Tfm_main, fm_main);
Application.Run;
end
else
begin
SetLength(MoudleName, 100);
GetModuleFileName(HInstance, pchar(MoudleName), length(MoudleName));
//获得自己程序文件名
MoudleName := pchar(MoudleName);
EnumWindows(@EnumWndProc, 0); //调用枚举函数
if FindHid <> 0 then
//SetForegroundWindow(FindHid); //聚焦
ShowWindow(
FindHid, // handle of window
SW_SHOWMAXIMIZED // show state of window
);
end;
end.
var
myMutex:HWND;//互斥对象myMutex:=CreateMutex(nil,false,'MyApp');
if not(WaitForSingleObject(myMutex,0)<>wait_TimeOut) then
begin
//这里加入窗口操作代码,可以用自定义消息等等方法
Halt;
end;
比如说直接新建一个Project,应该添加哪些代码呢
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs;type
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.dfm}var
mHandle: THandle;
//仅运行一次的检查
procedure TForm1.FormCreate(Sender: TObject);
begin
//
end;initialization
mHandle:= CreateMutex(nil, True, 'Form1_test');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
Application.Title:= '防止程序多个实例';
ShowMessage('防止程序多个实例, 已经运行!');
halt;
end;
finalization
if mHandle <> 0 then CloseHandle(mHandle);
end.
防止程序多个实例的解决办法,前面别人已经说了要让窗体恢复显示,试试下面这些:ShowWindow(主窗体.Handle, SW_RESTORE);//主要是这个
SetActiveWindow(主窗体.Handle);
Windows.SetFocus(主窗体.Handle);
var
ZAppName:array[0..127] of char;
Hold:string;
Found:HWND;begin
//********以下代码用于控制只能启动一个程序实体*****// Hold:=application.Title;
Application.Title:='OnlyOne'+Inttostr(HInstance);//暂时修改窗口标题
strpcopy(ZAppName,Hold);//原窗口标题
Found:=findwindow(nil,ZAppName);//查找窗口
Application.Title:=Hold;//恢复窗口标题
if Found<>0 then
begin //若找到则结束自身
messagedlg('该程序只能启动一个!',mtError,[mbyes],0);
application.Terminate;
exit;
end;
end;
像这种经典问题难道就没人会吗?
Delphi实现程序只运行一次并激活已打开的程序
关键就在于激活原来的程序,一般的做法是在工程开始时,打开互斥量对象,如果打不开表示程序还没有运行,创建一个互斥量对象;如果打得开表示程序已经运行了,查找程序中一个特定的窗口,一般是主窗口,然后发送一个自定义消息,主窗口在这个消息处理中激活自己。我原来就是这么做的,却发现有很多问题。
主窗口在消息处理函数中激活不了自己,众所周知激活一个窗口最有效的方法当然就是SetForegroundWindow,但在主窗口中调用这个函数激活自己的效果却是只在标题栏闪了一闪,如果在其他进程调用该函数则不会有问题;另外,如果程序是最小化的,它连闪都不闪了。
对于这些问题,我想了下面的办法,在知道原程序已经运行后,用FindWindow找原程序主窗口的句柄,找到了,就发送一个自定义消息过去,而在原程序主窗口的消息处理函数中,只是调用Application.Restore方法,这样如果原程序是最小化的就会还原过来。在发送消息之后,紧接着我调用SetForegroundWindow并传入原程序主窗口的句柄,由于上面的处理,原程序肯定不是最小化了,且调用SetForegroundWindow的地方已经不是原程序了(是第二次运行的程序,也可以说是另一个进程),所以原程序可以很好的被激活。
看来一切都很好,当然不是,不然就不会有下面的代码了,我又发现了一些问题,首先当主窗体不是活动窗口时,比如主窗体被隐藏了,而目前活动的窗体是其他窗体,则上面的代码无效。另一个,如果主窗体前面有一个ShowModal的窗体,则上面的代码后,主窗体跑到ShowModal窗体的前面了。
只有继续探索了,看来问题出在SetForegroundWindow上,激活那个窗体都不好,因为那个窗体都有可能不在,有没有办法激活工程呢,我在Application中找方法,我找到Application.BringToFront,也许这个有点用,于是新建一个工程,加一个Timer控件,然后每隔3秒调用一次Application.BringToFront,运行看结果。可惜窗体仍然只是闪一下,并没有激活,这和我上面说的在自己进程中激活自己的结果一样,可能BringToFront方法里面也调用了SetForegroundWindow了吧,但它激活哪个窗口呢,这让我好奇,打开源码来看,看到了如下有代码:
procedure TApplication.BringToFront;
var
TopWindow: HWnd;
begin
if Handle <> 0 then
begin
TopWindow := GetLastActivePopup(Handle);
if (TopWindow <> 0) and (TopWindow <> Handle) and
IsWindowVisible(TopWindow) and IsWindowEnabled(TopWindow) then
SetForegroundWindow(TopWindow);
end;
end;
原来是用GetLastActivePopup这个API找到程序拥有的窗体中最近激活的窗体,然后再激活它。
哈,我有了一个技术方案,首先我要在第二次运行的程序中找到第一次运行的程序的Application的Handle,然后调用SendMessage(APPHandle, WM_SYSCOMMAND, SC_RESTORE, 0),Application类有处理这个消息的,最终它会调用Application.Restore方法,让自己变为显示的状态,即最大化或正常。接着,就执行上面方法中的代码,让第一次运行的程序激活。现在关键是怎么找到第一次运行的Application的Handle,自然而然就想到了共享内存的技术,程序第一次运行时,先打开一个内存映射文件,如果打不开,则表示程序第一次运行,建一个内存映射文件对象,开辟一块共享的内存,这块内存保存Application的Handle。程序第二次运行,打开内存映射文件,可以打开了,得到一块共享内存,并取得了第一次运行程序的Application的Handle,然后,用我上面说的方法,即可大功告成。
花了一个小时的试验,最终有了下面的代码,结果非常成功:
unit wdRunOnce;{*******************************************
* brief: 让程序只运行一次
* autor: linzhenqun
* date: 2005-12-28
* email: [email protected]
* blog: http://blog.csdn.net/linzhengqun
********************************************}interface(* 程序是否已经运行,如果运行则激活它 *)
function AppHasRun(AppHandle: THandle): Boolean;
implementation
uses
Windows, Messages;const
MapFileName = '{CAF49BBB-AF40-4FDE-8757-51D5AEB5BBBF}';type
//共享内存
PShareMem = ^TShareMem;
TShareMem = record
AppHandle: THandle; //保存程序的句柄
end;var
hMapFile: THandle;
PSMem: PShareMem;procedure CreateMapFile;
begin
hMapFile := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MapFileName));
if hMapFile = 0 then
begin
hMapFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0,
SizeOf(TShareMem), MapFileName);
PSMem := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
if PSMem = nil then
begin
CloseHandle(hMapFile);
Exit;
end;
PSMem^.AppHandle := 0;
end
else begin
PSMem := MapViewOfFile(hMapFile, FILE_MAP_WRITE or FILE_MAP_READ, 0, 0, 0);
if PSMem = nil then
begin
CloseHandle(hMapFile);
end
end;
end;procedure FreeMapFile;
begin
UnMapViewOfFile(PSMem);
CloseHandle(hMapFile);
end;function AppHasRun(AppHandle: THandle): Boolean;
var
TopWindow: HWnd;
begin
Result := False;
if PSMem <> nil then
begin
if PSMem^.AppHandle <> 0 then
begin
SendMessage(PSMem^.AppHandle, WM_SYSCOMMAND, SC_RESTORE, 0);
TopWindow := GetLastActivePopup(PSMem^.AppHandle);
if (TopWindow <> 0) and (TopWindow <> PSMem^.AppHandle) and
IsWindowVisible(TopWindow) and IsWindowEnabled(TopWindow) then
SetForegroundWindow(TopWindow);
Result := True;
end
else
PSMem^.AppHandle := AppHandle;
end;
end;initialization
CreateMapFile;finalization
FreeMapFile;end.
你所要做的,就是将这个单元加进你的程序中,然后在你的工程文件中调用AppHasRun,并传入Application的Handle,你的程序就可以只运行一次了,工程大概如下:
program Project1;uses
Forms,
Unit1 in 'Unit1.pas' {Form1}
wdRunOnce in 'wdRunOnce.pas',
Unit2 in 'Unit2.pas' {Form2}{$R *.res}begin
Application.Initialize;
if not AppHasRun(Application.Handle) then
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
多新建一些窗口测试一下吧,不过要注意新建的窗口得不能是自动创建的。
Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=1143115
2.在此工程中添加新建一个单元Unit1,将unit wdRunOnce;至end.间的代码完整覆盖新建的Unit1,将工程中的Unit1.pas改为wdRunOnce.pas;
3.运行之你会看到结果。
4.Good luck.