// Der folgende Code verhindert mehrere Instanzen eines Programms.
// Stattdessen wird das Programmfenster nach vorn geholt, wenn es verdeckt
// ist, bzw. wird restauriert, wenn es minimiert ist.
// Siehe auch:
die Anzahl der Programm-Instanzen steuern

// Variante 1

// Getestet mit D4 unter XP

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; 
 
type 
  TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
  private 
    { Private-Deklarationen } 
  public 
    procedure WndProc(var M: TMessage); override; 
  end; 
 
var 
  Form1: TForm1; 
  MyMsg: Cardinal; 
  UniqueStr: string = 'DBR_Mutex'; // eindeutig pro Programm, evtl. GUID
 
implementation 
 
{$R *.DFM} 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  MyMsg := RegisterWindowMessage(PChar(UniqueStr)); 
end; 
 
procedure TForm1.WndProc(var M: TMessage); 
begin 
  if M.Msg = MyMsg then begin 
    SendMessage(Application.handle, WM_SYSCOMMAND, SC_RESTORE, 0); 
    SetForegroundWindow(Application.Handle); 
  end; 
  inherited; 
end; 
 
end. 
 
//------------------ und im Projekt-Quelltext ------------------------- 
 
program Project1; 
 
uses 
  Forms, Windows, 
  Unit1 in 'Unit1.pas' {Form1}; 
 
{$R *.RES} 
 
var 
  h: THandle; 
 
begin 
  h := CreateMutex(nil, false, PChar(UniqueStr)); 
  if GetLastError = ERROR_ALREADY_EXISTS then begin 
    SendMessage(HWND_BROADCAST, RegisterWindowMessage(PChar(UniqueStr)), 0, 0); 
    exit; 
  end; 
 
  Application.Initialize; 
  Application.CreateForm(TForm1, Form1); 
  Application.Run; 
   
  if h <> 0 then closehandle(h); 
end.
 
//-------------------------------------------------------
// Variante 2
// Getestet mit D2010 unter W7
program TEST; 
 
uses 
  Forms, 
  Windows, 
  Unit1 in 'Unit1.pas' { Form1 } , 
  Unit2 in 'Unit2.pas' { Form2 } ; 
 
{$R *.res} 
 
var 
  mh, nf: THandle; 
 
const 
  UniqueStr = '*DBR Einmalig*'; // z.B. 
 
  MyCaption = 'TestProgramm '; 
 
begin 
  mh := CreateMutex(nil, false, PChar(UniqueStr)); 
  if GetLastError = ERROR_ALREADY_EXISTS then 
  begin 
    nf := findwindow(nil, MyCaption); 
    if isiconic(nf) then 
      showwindow(nf, sw_restore); 
    SetForegroundWindow(nf); 
    exit; 
  end; 
  Application.Initialize; 
  Application.MainFormOnTaskbar := True; 
  Application.Title := 'TEST'; 
  Application.CreateForm(TForm1, Form1); 
 
  Form1.Caption := MyCaption; 
 
  Application.CreateForm(TForm2, Form2); 
  Application.Run; 
 
  if mh <> 0 then 
    closehandle(mh); 
 
end.

//-------------------------------------------------------
// Zusätzliche Variante

// Der folgende Code erreicht, dass ein Programm nur einmal // pro Sitzung gestartet werden kann.
program Project1; 
 
uses 
  Forms, Windows, Dialogs, 
  Unit1 in 'Unit1.pas' {Form1}; 
 
const 
  atm = '{41F6DA10-2CA9-40B6-96D3-BE55F8798B04}'; 
 
{$R *.RES} 
 
begin 
  Application.Initialize; 
  if GlobalFindAtom(atm) = 0 then begin 
    GlobalAddAtom(atm); 
    Application.CreateForm(TForm1, Form1); 
    Application.Run; 
  end else 
    ShowMessage('This application can be started only once per Windows session,' 
      + ' you need to restart system to run program again.'); 
 
end. 
 



 

Zugriffe seit 6.9.2001 auf Delphi-Ecke