Ver Mensaje Individual
  #8  
Antiguo 17-11-2006
Avatar de seoane
[seoane] seoane is offline
Miembro Premium
 
Registrado: feb 2004
Ubicación: A Coruña, España
Posts: 3.717
Reputación: 24
seoane Va por buen camino
Se me ocurre una solución, modificamos la unit de roman de esta manera:
Código Delphi [-]
unit UIApp;

interface

uses
  Windows, SysUtils, Forms;

procedure Registrar(sActivar, sMutex: string);
procedure Activar;

implementation

var
  mActivar    : Cardinal; { Mensaje para activar la instancia anterior }
  Mutex       : Cardinal; { Mutex                                      }
  PrevWndProc : TFarProc; { Procedimiento de ventana original          }


function AppWndProc(Handle: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LongInt; stdcall;
var
  FgThreadId  : DWORD; { Hilo de la app. que tenga el foco }
  AppThreadId : DWORD; { Hilo de nuestra aplicación        }

begin
  if Msg = mActivar then
  begin
    { Si está minimizada basta restaurarla }
    if IsIconic(Handle) then
      ShowWindow(Handle, SW_RESTORE)
    else
    begin
      { Obtener los hilos }
      FgThreadId  := GetWindowThreadProcessId(GetForegroundWindow, nil);
      AppThreadId := GetWindowThreadProcessId(Handle, nil);

      { Anexar el hilo de nuestra app. al de la  que tenga el foco }
      AttachThreadInput(AppThreadId, FgThreadId, true);

      { Ahora sí, activar la applicación }
      SetForegroundWindow(Handle);

      { Separar el hilo de nuestra app de la otra }
      AttachThreadInput(AppThreadId, FgThreadId, false);
    end;

    Result := 0;
  end
  else
    { Dejar que el procedimiento original se encargue de los otros mensajes }
    Result := CallWindowProc(PrevWndProc, Handle, Msg, wParam, lParam);
end;

procedure Activar;
begin
  { Mandamos el mensaje a todas las ventanas }
  SendMessage(HWND_BROADCAST, mActivar, 0, 0);
end;

procedure Registrar(sActivar, sMutex: string);
begin
  mActivar := RegisterWindowMessage(sActivar);
  Mutex    := CreateMutex(nil, true, sMutex);

  { Si ya existe el mutex lanzamos una excepción silenciosa }
  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
   Mutex := 0;
   abort;
  end
  else
  begin
    { Sustituimos el procedimiento de ventana }
    PrevWndProc := TFarProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
    SetWindowLong(Application.Handle, GWL_WNDPROC, LongWord(@AppWndProc));
  end;
end;

initialization 

finalization
  if Mutex <> 0 then ReleaseMutex(Mutex);
end.

Luego en el dpr de nuestra aplicación, colocamos esto al principio:
Código Delphi [-]
 try
    Registrar(sActivar, sMutex); // SActivar, sMutex son constantes del dpr
  except
    Activar;
    Halt;
  end;

¿que te parece?
Responder Con Cita