Советы по Delphi. Версия 1.0.6

Озеров Валентин

begin

 PrevInstWnd:= 0;

 EnumWindows(@EnumApps,LongInt(@PrevInstWnd));

 if PrevInstWnd <> 0 then if IsIconic(PrevInstWnd) then

ShowWindow(PrevInstWnd,SW_Restore)

 else

BringWindowToTop(PrevInstWnd);

end;

end.

Решение 2

Предоставленное разработчиками Delphi 2

Пачекой (Pacheco) и Тайхайрой (Teixeira) и значительно переработанное.

unit multinst;

{Применение:

 Необходимый код в исходном проекте

 if InitInstance then begin

Application.Initialize;

Application.CreateForm(TFrmSelProject, FrmSelProject);

Application.Run;

 end;

 Это все понятно (я надеюсь)}

interface

uses Forms, Windows, Dialogs, SysUtils;

const

 MI_NO_ERROR = 0;

 MI_FAIL_SUBCLASS = 1;

 MI_FAIL_CREATE_MUTEX = 2;

{ Проверка правильности запуска приложения с помощью описанных ниже функций. }

{ Количество флагов ошибок MI_* может быть более одного. }

function GetMIError: Integer;

Function InitInstance : Boolean;

implementation

const

 UniqueAppStr : PChar; {Различное для каждого приложения}

var

 MessageId: Integer;

 WProc: TFNWndProc = Nil;

 MutHandle: THandle = 0;

 MIError: Integer = 0;

function GetMIError: Integer;

begin

 Result:= MIError;

end;

function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint): Longint; StdCall;

begin

 { Если это – сообщение о регистрации… }

 if Msg = MessageID then begin

{ если основная форма минимизирована, восстанавливаем ее }

{ передаем фокус приложению }

if IsIconic(Application.Handle) then begin

Application.MainForm.WindowState:= wsNormal;

ShowWindow(Application.Mainform.Handle, sw_restore);

end;

SetForegroundWindow(Application.MainForm.Handle);

 end

 { В противном случае посылаем сообщение

предыдущему окну }

 else Result:= CallWindowProc(WProc, Handle, Msg, wParam, lParam);

end;

procedure SubClassApplication;

begin

 { Обязательная процедура. Необходима, чтобы обработчик }

 { Application.OnMessage был доступен для использования. }

 WProc:= TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC, Longint(@NewWndProc)));

 { Если происходит ошибка, устанавливаем подходящий флаг }

 if WProc = Nil then MIError:= MIError or MI_FAIL_SUBCLASS;

end;

procedure DoFirstInstance;

begin

 SubClassApplication;

 MutHandle:= CreateMutex(Nil, False, UniqueAppStr);

 if MutHandle = 0 then

MIError:= MIError or MI_FAIL_CREATE_MUTEX;

end;

procedure BroadcastFocusMessage;

{ Процедура вызывается, если уже имеется запущенная копия Вашей программы. }

var

 BSMRecipients: DWORD;

begin

 { Не показываем основную форму }

 Application.ShowMainForm:= False;

 { Посылаем другому приложению сообщение и информируем о необходимости }

 { перевести фокус на себя }

 BSMRecipients:= BSM_APPLICATIONS;

 BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE, @BSMRecipients, MessageID, 0, 0);

end;

Function InitInstance : Boolean;

begin

 MutHandle:= OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);

 if MutHandle = 0 then begin

{ Объект Mutex еще не создан, означая, что еще не создано }

{ другое приложение. }

ShowWindow(Application.Handle, SW_ShowNormal);

Application.ShowMainForm:=True;

DoFirstInstance;

result:= True;

 end else begin

BroadcastFocusMessage;

result:= False;

 end;

end;

initialization

begin

 UniqueAppStr:= Application.Exexname;