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

 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;