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

Озеров Валентин

 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;