// Der folgende
Code verhindert mehrere Instanzen eines Programms. 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 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'; // z.B. begin mh := CreateMutex(nil, false, PChar(UniqueStr)); if GetLastError = ERROR_ALREADY_EXISTS then begin nf := findwindow(nil, MyCaption); {nf := getparent(nf);} // kommt auf das Programm an 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 program Project1; uses Forms, Windows, Dialogs, Unit1 in 'Unit1.pas' {Form1}; const atm = '{41F6DA10-2CA9-40B6-96D3-BE55F8798B04}'; // z.B. {$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