对于一些非多文档类的程序,我们只想让用户打开一个程序的实例,当用户再次点击图标的时候只需将原来运行的程序界面打开即可。那么如何实现这种功能呢?首先,要实现进程的单实例运行,我们可以用互斥对象实现,互斥对象即在系统层上只能创建一个这样标识的对象,当第二个此标识的互斥对象创建时将会返回一个已存在的标志。
单实例运行实现后,我们还要通过消息实现打开前面已经打开的窗口,我们可以用EnumWindows函数来遍例所有窗口以找到已打开窗口的句柄,并通过ShowWindow函数或者自定义消息来激活那个窗口。具体的代码如下:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 |
program SingleProc; uses Forms, TlHelp32, Windows, SysUtils, uFmSingleProc in 'uFmSingleProc.pas' {FmSingleProc}; {$R *.res} var HMutex: Hwnd; Ret: Integer; I: integer; // 根据进程ID获取进程名称 function GetProcessNameById(const AID: Integer): String; var h:thandle; f:boolean; lppe:tprocessentry32; begin Result := ''; h := CreateToolhelp32Snapshot(TH32cs_SnapProcess, 0); lppe.dwSize := sizeof(lppe); f := Process32First(h, lppe); while integer(f) <> 0 do begin if Integer(lppe.th32ProcessID) = AID then begin Result:= StrPas(lppe.szExeFile); break; end; f := Process32Next(h, lppe); end; end; function EnumWindowsOpen1stApp(hwnd: HWND; lParam: LPARAM): Boolean ;stdcall; var WindowText : string ; // 窗体标题 procId: Cardinal; wText: array[0..255] of char; begin // 获取进程ID GetWindowThreadProcessId(HWND, procId); if GetProcessNameById(procId) = ExtractFileName(Application.ExeName) then begin GetWindowText(HWND, @wText, 255); if wText = 'Form Title' then begin //ShowWindow有的时候会导致其他的问题,如果ShowWindow有问题可以用下面的发送消息的方法解决 //ShowWindow(hwnd, SW_SHOW); //通过发送消息方式来激活前面的窗口 SendMessage(hwnd, WM_SHOWTHEFORM, 0, 0); end; end; Result := True; end; begin Application.Initialize; Application.MainFormOnTaskbar := True; hMutex := CreateMutex(nil, False, PChar('SingleProcTest')); Ret := GetLastError ; if Ret <> ERROR_ALREADY_EXISTS Then begin Application.CreateForm(TFmSingleProc, FmSingleProc); end else begin // 互斥对象已存在,则遍历查找已打开的程序 EnumWindows(@EnumWindowsOpen1stApp, 0); ReleaseMutex(hMutex); end; Application.Run; end. |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 |
unit uFmSingleProc; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; const WM_SHOWTHEFORM = WM_USER + 1; type TFmSingleProc = class(TForm) procedure FormCreate(Sender: TObject); private { Private declarations } public // 如果通过ShowWindow函数显示窗口,则不用此消息 procedure WMShowTheForm(Var msg: TMessage); message WM_SHOWTHEFORM; end; var FmSingleProc: TFmSingleProc; implementation {$R *.dfm} { TFmSingleProc } procedure TFmSingleProc.FormCreate(Sender: TObject); begin Self.Caption := 'Form Title'; end; procedure TFmSingleProc.WMShowTheForm(var msg: TMessage); begin Self.WindowState := wsNormal ; Self.Show; Self.BringToFront ; end; end. |