If want to allow users to run just one instance of application, one of possible methods is to use “mutext” (mutual exclusion).
First of all, we need to edit DPR (project) file of our application.
Before we initialize application and create main form, we try to create mutext
of specific name. If no error occurs, we can continue to start
application. But if “mutext” already exists, it means, that it was
created previously by first instance of application. In this case, we
just switch to this first instance and stop starting a new one.
The rest of the code is for handling messages and to bring “front”
existing instance. Put it in the main form unit. In example below,
project file (DPR) code and main form unit code are in the same “file”,
but you must put it in the right separate files in your real
application.
program Project1; uses Windows, Forms, Unit1 in 'Unit1.pas' {Form1}; {$R *.res} begin CreateMutex(nil, false, 'MyApp'); if GetLastError = ERROR_ALREADY_EXISTS then begin SendMessage(HWND_BROADCAST, RegisterWindowMessage('MyApp'), 0, 0); Halt(0); end; Application.Initialize; Application.CreateForm(TForm1, Form1); Application.Run; end. ////////////////////////////////////////// unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; OldWindowProc: Pointer; MyMessage: DWord; implementation {$R *.dfm} function NewWindowProc(WindowHandle : hWnd; TheMessage : LongInt; ParamW : LongInt;
ParamL : LongInt) : LongInt stdcall; begin if TheMessage = MyMessage then begin SendMessage(Application.Handle, WM_SYSCOMMAND, SC_RESTORE, 0); SetForegroundWindow(Application.Handle); Result := 0; exit; end; Result := CallWindowProc(OldWindowProc, WindowHandle, TheMessage, ParamW, ParamL); end; procedure TForm1.FormCreate(Sender: TObject); begin MyMessage := RegisterWindowMessage('MyApp'); OldWindowProc := Pointer(SetWindowLong(Form1.Handle, GWL_WNDPROC,
LongInt(@NewWindowProc))); end; procedure TForm1.FormDestroy(Sender: TObject); begin SetWindowLong(Form1.Handle, GWL_WNDPROC, LongInt(OldWindowProc)); end; end.
And don’t forget to add Windows unit to project file (DPR), because CreateMutex
function is in this unit.
Δεν υπάρχουν σχόλια:
Δημοσίευση σχολίου