Советы по Delphi. Версия 1.4.3 от 1.1.2001 - страница 9
Nomadic рекомендует следующий способ:
Используй GetMessage(), в качестве HWND окна пиши NULL (на Паскале — 0). Если в очереди сообщений следующее — WM_QUIT, то эта функция фозвращает FALSE. Если ты пишешь программу для Win32, то запихни это в отдельный поток, организующий выход из программы.
Постепенное умирание
The_Sprite пишет:
Вопрос: А как реализовать в одном компоненте такие функции как выключение компьютера, перезагрузка, завершение сеанса работы пользователя, Eject CD, выключение питания монитора и т.д.? Ответ: предлагаем посмотреть следующий пример…
Совместимость: все версии Delphi
Пример:
>procedure TForm1.Button1Click(Sender: TObject);
>begin
> PowerControl1.Action:=actCDEject;// Или...
> actLogOFF, actShutDown...
> PowerControl1.Execute;
>end
Component Code:
>unit
> PowerControl;
>interface
>uses WinTypes, WinProcs, Messages, SysUtils, Classes, Controls,Forms, Graphics,MMSystem;
>type
>TAction =(actLogOFF,actShutDown,actReBoot,actForce,actPowerOFF,
> actForceIfHung,actMonitorOFF,actMonitorON,actCDEject,actCDUnEject);
>type TPowerControl = class(TComponent)
>private
> FAction : TAction;
> procedure SetAction(Value : TAction); protected
>public
> function Execute :Boolean;
>published
> property Action :TAction read FAction write SetAction;
>end;
>procedure Register;
>implementation
>procedure Register;
>begin
> RegisterComponents('K2',[TPowerControl]);
>end;
>procedure TPowerControl.SetAction(Value : TAction);
>begin
> FAction := Value;
>end;
>function TPowerControl.Execute : Boolean;
>begin
> with (Owner as TForm) do case FAction of
> actLogOff: ExitWindowsEx(EWX_LOGOFF, 1);
> actShutDown: ExitWindowsEx(EWX_SHUTDOWN, 1);
> actReBoot:ExitWindowsEx(EWX_REBOOT, 1);
> actForce:ExitWindowsEx(EWX_FORCE, 1);
> actPowerOff:ExitWindowsEx(EWX_POWEROFF, 1);
> actForceIfHung:ExitWindowsEx(EWX_FORCEIFHUNG, 1);
> actMonitorOFF:SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, 0);
> actMonitorON: SendMessage(Application.Handle, WM_SYSCOMMAND, SC_MONITORPOWER, -1);
> actCDEject: mciSendstring('SET CDAUDIO DOOR OPEN WAIT', nil, 0, Handle);
> actCDUnEject: mciSendstring('SET CDAUDIO DOOR CLOSED WAIT', nil, 0, Handle);
> end; {Case}
> Result := True;
>end;
>end.
Разное
Как не допустить запуск второй копии программы VIII
Игорь Пролис рекомендует следующий код:
>{*******************************************************}
>{ }
>{ HTMLCoolEdit }
>{ }
>{ Copyright (c) 1999-2000 PROFOX }
>{ }
>{*******************************************************}
>unit multinst;
>interface
>uses Forms, Windows, Dialogs, SysUtils;
>const
> MI_NO_ERROR = 0;
> MI_FAIL_SUBCLASS = 1;
> MI_FAIL_CREATE_MUTEX = 2;
>function GetMIError: Integer;
>function InitInstance : Boolean;
>implementation
>uses RegWork, FileWork;
>var
> UniqueAppStr : PChar;
> 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
> Result := 1;
> if Msg = MessageID then begin
> if IsIconic(Application.Handle) then OpenIcon(Application.Handle)
> else SetForegroundWindow(Application.Handle);
> FileWork.LoadFileName(RegWork.RWGetParamStr1);
> end
> else Result := CallWindowProc(WProc, Handle, Msg, wParam, lParam);
>end;
>procedure SubClassApplication;
>begin
> 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;
>begin
> Application.ShowMainForm := False;
> PostMessage(HWND_BROADCAST, MessageId, 0, 0);
>end;
>function InitInstance : Boolean;
>begin
> MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, UniqueAppStr);
> if MutHandle = 0 then begin