De mucha utilidad la unidad, la uso desde hace tiempo
, aunque realice unos cambios a la unidad para convertirla en funcion:
Código Delphi
[-]
unit MclApplication;
interface
uses
Windows, SysUtils, Forms;
procedure ApplicationActive(Handle: HWND); overload;
procedure ApplicationActive; overload;
function InstanceExists(Identifier: string): Boolean;
implementation
procedure ApplicationActive(Handle: HWND); overload;
var
FgThreadId : DWORD;
AppThreadId : DWORD;
begin
if IsIconic(Handle) then
ShowWindow(Handle, SW_RESTORE)
else
begin
FgThreadId := GetWindowThreadProcessId(GetForegroundWindow, nil);
AppThreadId := GetWindowThreadProcessId(Handle, nil);
AttachThreadInput(AppThreadId, FgThreadId, true);
SetForegroundWindow(Handle);
AttachThreadInput(AppThreadId, FgThreadId, false);
end;
end;
procedure ApplicationActive;
begin
ApplicationActive(Application.Handle);
end;
var
mActivar : Cardinal;
Mutex : Cardinal;
PrevWndProc : TFarProc;
function AppWndProc(Handle: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LongInt; stdcall;
begin
if Msg = mActivar then
begin
ApplicationActive(Handle);
Result := 0;
end else
Result := CallWindowProc(PrevWndProc, Handle, Msg, wParam, lParam);
end;
procedure InstanceActivar;
begin
SendMessage(HWND_BROADCAST, mActivar, 0, 0);
end;
procedure InstanceRegistrar(Identifier: string);
const
sMutex = '10D73234-C9F7-4C2D-BC7E-39B5820AF456';
sActivar = '3F154732-CCDE-4BC7-9439-AFCD3BCFA84D';
begin
mActivar := RegisterWindowMessage(PChar(sActivar + Identifier));
Mutex := CreateMutex(nil, true, PChar(sMutex + Identifier));
if GetLastError = ERROR_ALREADY_EXISTS then
begin
Mutex := 0;
Abort;
end else
begin
PrevWndProc := TFarProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
SetWindowLong(Application.Handle, GWL_WNDPROC, LongWord(@AppWndProc));
end;
end;
function InstanceExists(Identifier: string): Boolean;
begin
Result := True;
try
InstanceRegistrar(Identifier);
Result := False;
except
InstanceActivar;
end;
end;
initialization
finalization
if Mutex <> 0 then ReleaseMutex(Mutex);
end.
un ejemplo de uso, en el dpr:
Código Delphi
[-]
program Project1;
uses
Forms,
Unit1 in 'Unit1.pas' ;
{$R *.res}
begin
if InstanceExists('MI APLICACION') then
Exit;
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.