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

Функция 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);

Разное

Как не допустить запуск второй копии программы?

Решение 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.

Решение 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);