procedure TMainForm.RestartWindowsBtnClick(Sender: TObject);
begin
if not ExitWindows(EW_RestartWindows, 0) then ShowMessage('Приложение не может завершить работу');
end;
procedure TMainForm.RebootSystemBtnClick(Sender: TObject);
begin
if not ExitWindows(EW_RebootSystem, 0) then ShowMessage('Приложение не может завершить работу');
end;
Функция ExitWindows не была правильно задокументирована Microsoft'ом и не содержит описания возвращаемого значения. Более того, информация о этой функции практически не встречается в других источниках. Вот правильное определение этой функции:
function ExitWindows(dwReturnCode: Longint; Reserved: Word): Bool;
Режим энергосбережения (Power saver)
Управление монитором
Выключить монитор:
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
Включить монитор:
SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, –1);
Разное
Как не допустить запуск второй копии программы?
Алгоритм, применяемый мною:
В блоке begin..end модуля .dpr:
begin
if HPrevInst <>0 then begin
ActivatePreviousInstance;
Halt;
end;
end;
Реализация в модуле:
unit PrevInst;
interface
uses WinProcs, WinTypes, SysUtils;
type
PHWnd = ^HWnd;
function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool; export;
procedure ActivatePreviousInstance;
implementation
function EnumApps(Wnd: HWnd; TargetWindow: PHWnd): bool;
var
ClassName : array[0..30] of char;
begin
Result := true;
if GetWindowWord(Wnd, GWW_HINSTANCE) = HPrevInst then begin
GetClassName(Wnd, ClassName, 30);
if STRIComp(ClassName,'TApplication')=0 then begin
TargetWindow^:= Wnd;
Result := false;
end;
end;
end;
procedure ActivatePreviousInstance;
var
PrevInstWnd: HWnd;
begin
PrevInstWnd:= 0;
EnumWindows(@EnumApps,LongInt(@PrevInstWnd));
if PrevInstWnd <> 0 then if IsIconic(PrevInstWnd) then
ShowWindow(PrevInstWnd,SW_Restore)
else
BringWindowToTop(PrevInstWnd);
end;
end.
Предоставленное разработчиками 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;