Не создавать копию окна

[lowercase]

всем доброго времени суток... я пишу программу и мне надо сделать так что бы в памяти была только одна копия моей программы... то есть если я запускаю еще одно такое же окно, то оно запустится не должно, а прсто должен перейти фокус на уже окрытое окно... я пробовал таким вот способом:

procedure TmainForm.FormCreate(Sender: TObject);
var wnd:HWnd;
begin
  wnd := findWindow('TmainForm','Редактор тестов');
  if wnd <> 0 then begin
    showWindow(wnd,sw_shownormal);
    application.Terminate;
  end
end;

но программа находит сама себя и вырубает...
подскажие как решить этот вопрос...
может както опредилить есть ли еще окна с таким же классом и кепшеном...

[ZvEr_HaCkEr]

в OnCreate пиши:

If WaitForSingleObject(g,0)<>o
then begin 
exitprocess(0);
end;

После последнего end последней процедуры:

initialization
g:=createmutex(nil,true,pchar(extractfilename(application.exename)));
finalization
closehandle(g);
end.

g глобальная переменая типа thandle.
Только фокус возвращать не будет,а просто предотвратит повторный запуск приложения.

[MaxNik2009]

еще как вариант:

program Project1;
uses
  Forms,
  Unit1 in 'Unit1.pas', Windows { Form1 } ;
{$R *.res}

var
  h: HWND;
  WinText: array [0 .. Max_Path] of WideChar;

begin

  h:= GetWindow(GetForegroundWindow, GW_HWNDFIRST);
  while h <> 0 do
  begin
    if (IsWindowVisible(h)) and
      (GetWindowText(h, WinText, sizeOf(WinText)) <> 0) then
    begin
      GetWindowText(h, WinText, sizeOf(WinText));
      if WinText = 'Form1' then  // сравнивай с заголовком своей программы
      begin
        SetForegroundWindow(h); // если программа запущена, то выводим ее на передний план
        exit;
      end;
    end;
    h:= GetWindow(h, gw_hwndNext);
  end;

  application.Initialize;
  application.MainFormOnTaskbar:= True;
  application.CreateForm(TForm1, Form1);
  application.Run;
end.

[FaTaL]

Что то всё долго. Вот простой вариант:

program Project1;

uses
  Forms, Windows,
  Unit1 in 'Unit1.pas' {MainForm};

{$R *.res}
Var HM :THandle;

function Check: boolean;
begin
  HM:=OpenMutex(MUTEX_ALL_ACCESS, false, 'Proj');
  Result:=(HM<>0);
  if HM=0 then HM:=CreateMutex(nil, false, 'Proj');
end;

begin
    // Проверка на запуск второй копии программы
    If Check then
    exit;
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.Run;
end.

[Sparkman]

Сообщение от MaxNik2009

еще как вариант:

program Project1;
uses
  Forms,
  Unit1 in 'Unit1.pas', Windows { Form1 } ;
{$R *.res}

var
  h: HWND;
  WinText: array [0 .. Max_Path] of WideChar;

begin

  h:= GetWindow(GetForegroundWindow, GW_HWNDFIRST);
  while h <> 0 do
  begin
    if (IsWindowVisible(h)) and
      (GetWindowText(h, WinText, sizeOf(WinText)) <> 0) then
    begin
      GetWindowText(h, WinText, sizeOf(WinText));
      if WinText = 'Form1' then  // сравнивай с заголовком своей программы
      begin
        SetForegroundWindow(h); // если программа запущена, то выводим ее на передний план
        exit;
      end;
    end;
    h:= GetWindow(h, gw_hwndNext);
  end;

  application.Initialize;
//  application.MainFormOnTaskbar:= True;
  application.CreateForm(TForm1, Form1);
  application.Run;
end.

WinText: array [0 .. Max_Path] of WideChar;

WideChar не ест, ест просто Char

[MaxNik2009]

WideChar не ест, ест просто Char

у меня D2010, а вообще можно и Char оставить.

[Nater]

Сообщение от lowercase

всем доброго времени суток... я пишу программу и мне надо сделать так что бы в памяти была только одна копия моей программы... то есть если я запускаю еще одно такое же окно, то оно запустится не должно, а прсто должен перейти фокус на уже окрытое окно... я пробовал таким вот способом:

procedure TmainForm.FormCreate(Sender: TObject);
var wnd:HWnd;
begin
  wnd := findWindow('TmainForm','Редактор тестов');
  if wnd <> 0 then begin
    showWindow(wnd,sw_shownormal);
    application.Terminate;
  end
end;

но программа находит сама себя и вырубает...
подскажие как решить этот вопрос...
может както опредилить есть ли еще окна с таким же классом и кепшеном...

Перед проверкой меняй Caption := ''; после проверки ставь обратно.

Где то так:

procedure TmainForm.FormCreate(Sender: TObject);
var wnd:HWnd;
begin
Caption := '';
  wnd := findWindow(nil,'Редактор тестов');
  if wnd <> 0 then begin
    showWindow(wnd,sw_shownormal);
    application.Terminate;
  end
Caption :=''; // здесь делай какой был.
end;

У меня была похожая проблема, решил именно так. И не надо ничего мудрить.

P.S. а не лучше ли переменную wnd убрать?

[Johnson]

P.S. а не лучше ли переменную wnd убрать?

поиск - довольно длительная процедура. в большинстве случаев лучше занять немного памяти, избавившись от лишних занятий процессора...