スクリーンセーバーとは
画面の焼き付きや画面の情報の漏洩を防ぐために表示されるアプリケーションです。
現代では、画面をスリープしてしまう事が多くスクリーンセーバー自体は役割を終えたかなと思っていますが、作りたいという方がいたときに中途半端な情報ばかりになっているため、この記事では必要な情報を全て記載します。
ただし、この記事では Windows 9x 系に必要な記述は省略しました。
具体的には SPI_SCREENSAVERRUNNING の処理や、IME ウィンドウの処理などです。
Windows NT 系のスクリーンセーバーは別のデスクトップオブジェクトで動作するため、このあたりの処理は必要ありません。
(Win32 API のドキュメントからも削除されています)
コマンドラインスイッチ(引数)
スクリーンセーバーは起動する時に以下のパラメーターが渡されます。
スクリーンセーバーはこのパラメーターに則った動きをさせます。
スイッチ | 実装する機能 | 備考 |
---|---|---|
A | パスワード変更ダイアログを表示する | Windows10 以降廃止 |
C | 設定ダイアログを表示する | |
P | プレビューを表示する | 第2パラメータにプレビューウィンドウのハンドル |
S | スクリーンセーバーとして実行する | |
なし | 無い場合は C として扱う | 基本的にはあり得ない |
スイッチ詳細
A
Windows10 以降では /A
が渡ってくることはありません。
パスワード関連は全て「ログオン画面に戻る」に集約されました。
MPR.DLL から PwdChangePasswordA/W も削除されています。
Windows10 より前の OS をサポートする場合、スクリーンセーバーのパスワードを変更するダイアログを表示します。
具体的には Win32 の MPR.DLL に隠し API として定義されている以下の API を使います。
TPwdChangePassword =
function(
// Windows が管理しているパスワードの種類、SCRSAVE を指定するとスクリーンセーバーのパスワードを示します
Name: PChar;
// 親ウィンドウのハンドル
ParentHandle: THandle;
// 特に使いません
Reserved1, Reserved2: Integer): Integer; stdcall;
以下は /A が渡された時の実装例です。
procedure TfrmMain.ChangePassword;
type
TPwdChangePassword = function(
Name: PChar;
ParentHandle: HWND;
Reserved1, Reserved2: Integer): Integer; stdcall;
procedure ShowError(const AMsg: String);
begin
MessageDlg(AMsg, mtError, [mbOK], 0)
end;
begin
// Windows 10 以降廃止
if TOSVersion.Check(10) then
Exit;
var Lib := LoadLibrary('MPR.DLL');
try
if Lib = 0 then
ShowError(ERR_PASSWORD_DIALOG_DISPLAY_FAILED)
else
begin
var PwdChangePassword: TPwdChangePassword :=
GetProcAddress(Lib, 'PwdChangePasswordW');
if Assigned(PwdChangePassword) then
begin
if PwdChangePassword('SCRSAVE', Handle, 0, 0) <> 0 then
ShowError(ERR_PASSWORD_CHANGE_FAILED)
end
else
ShowError(ERR_PASSWORD_DIALOG_DISPLAY_FAILED);
end;
finally
FreeLibrary(Lib);
end;
end;
C
設定ダイアログをモーダルとして表示します。
↓CustomizeForm が設定ダイアログだった場合の実装例です。
procedure TfrmMain.ShowCustmizeForm;
begin
CustomizeForm.ShowModal;
Application.Terminate;
end;
設定された情報はレジストリか、FOLDERID_RoamingAppData で示されるフォルダに、フォルダを掘って保存します。
これはスクリーンセーバーが C:\Windows\System32 にインストールされるためです。
システムのフォルダにはプログラムからファイルを生成できません。
ファイルで保存する場合の一般的な形式は↓のようになります。
C:\Users\ユーザー名\AppData\Roaming\会社名\アプリケーション名\
※会社名より前の部分は FOLDERID_RoamingAppData で取得します。
P
プレビューを表示します。
プレビューは設定に出てくるモニターを模した部分です。
この部分を表すウィンドウハンドルが第2パラメータで渡されますので、スクリーンセーバーのウィンドウの親をこのウィンドウハンドルにします。
procedure TfrmMain.ShowPreview;
begin
// 第2引数からプレビューウィンドウのハンドルを取る
var ParentWnd := HWND(ParamStr(2).ToInteger);
if ParentWnd = 0 then
begin
Application.Terminate;
Exit;
end;
ParentWindow := ParentWnd;
SetBounds(0, 0, 800, 600); // プレビューサイズの 190x140 以上であれば何でも良い
// Form のスケールを変更してプレビュー内で小さく表示されるようにする
var R: TRect;
GetWindowRect(ParentWnd, R);
ChangeScale(R.Width, 800);
end;
S
スクリーンセーバーとして実行します。
気をつけなければいけない点を以下に列挙します。
1. 複数起動の抑制
Windows は /S を付けた状態の exe を何度か呼び出す場合があるので複数起動の抑制は必須です。
// 一意な文字列は GUID を使うと楽です(下記 SCREENSAVEID 部分)
// Mutex による2重起動防止
var MutexHandle := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(SCREENSAVEID));
if (MutexHandle <> 0) then
begin
ReleaseMutex(MutexHandle);
Application.Terminate;
Exit;
end;
MutexHandle := CreateMutex(nil, False, PChar(SCREENSAVEID));
if MutexHandle = 0 then
begin
Application.Terminate;
Exit;
end
else
FMutex := MutexHandle;
複数起動を抑制するのは /S
スイッチがついている時だけです。
他のスイッチがついている場合は起動を抑制してはいけません。
プレビューや設定を表示していてもスクリーンセイバーは決まった時間に起動するため、他のスイッチの時も複数起動を抑制するとスクリーンセーバーが起動できなくなってしまいます。
2. ClassName
CreateWindow API に渡す lpszClassName
には WindowsScreenSaverClass
を指定します。
※指定しなくても動作はしますが…
procedure TfrmMain.CreateParams(var AParams: TCreateParams);
begin
inherited;
AParams.WinClassName := 'WindowsScreenSaverClass';
end;
3. スクリーンセーバーの名前
スクリーンセーバーを選択するドロップダウンに出てくる名前を指定します。
下記のリソースファイルをリソースコンパイラ等で .RES 形式にコンパイルして実行ファイルに組み込みます。
STRINGTABLE
{
1, "スクリーンセーバーの名前"
}
4. マウスカーソル
マウスを必要としなければカーソルを消します。
// Win32 API ShowCursor に False を渡し戻り値が 0 以下になるまで繰り返す
while (ShowCursor(False) > 0) do
;
5. モニター電源断・シャットダウン
スクリーンセーバーが起動していても時間によるモニター電源断とシャットダウンをサポートしなければなりません。
// 電源監視周り
FStartedTime := GetTickCount;
GetParameterToBoolean(SPI_GETLOWPOWERACTIVE, FUseMonitorPowerLow);
GetParameterToBoolean(SPI_GETPOWEROFFACTIVE, FUseMonitorPowerOff);
GetParameter(SPI_GETSCREENSAVETIMEOUT, @FScreenSaverTime);
GetParameter(SPI_GETLOWPOWERTIMEOUT, @FMonitorPowerLowTime);
GetParameter(SPI_GETPOWEROFFTIMEOUT, @FMonitorPowerOffTime);
FScreenSaverTime := FScreenSaverTime * 1000;
FMonitorPowerLowTime := FMonitorPowerLowTime * 1000;
FMonitorPowerOffTime := FMonitorPowerOffTime * 1000;
// OnIdle で監視する
Application.OnIdle := AppIdleEventHandler;
Application.OnIdle などで「モニター電源断時間」「シャットダウン時間」が過ぎているか確認し、過ぎていれば WM_SYSCOMMAND でモニターを切ったり、シャットダウンします。
procedure TfrmMain.AppIdleEventHandler(Sender: TObject; var ADone: Boolean);
procedure SetMonitorPower(const AFlag: LPARAM);
begin
PostMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, AFlag);
end;
begin
// 規定の時間が経過したらモニター電源断・シャットダウン
var ElapsedTime := GetTickCount - FStartedTime + FScreenSaverTime;
if
FUseMonitorPowerLow
and (FMonitorPowerLowTime > 0)
and (FMonitorPowerLowTime < ElapsedTime)
then
begin
SetMonitorPower(1); // モニター電源断
FUseMonitorPowerLow := False;
end;
if
FUseMonitorPowerOff
and (FMonitorPowerOffTime > 0)
and (FMonitorPowerOffTime < ElapsedTime) then
begin
SetMonitorPower(2); // シャットダウン
FUseMonitorPowerOff := False;
end;
end;
6. パスワードの有無
/A
同様、Windows10 以降で廃止されています。
レジストリ ScreenSaveUsePassword も削除されています。
Windows10 より前の OS をサポートする場合は、スクリーンセーバーパスワードが設定されているか確認します。
パスワードが設定されているかどうかは \HKEY_CURRENT_USER\Control Panel\Desktop\ScreenSaveUserPassword
キーに保存されています。
0 の場合、パスワードは設定されていません。
0 以外の値の場合、パスワードが設定されています。
// パスワードを使う場合は FUsePassword を True にする
FUsePassword := False;
var hReg := 0;
RegOpenKeyEx(
HKEY_CURRENT_USER,
'Control Panel\Desktop',
0,
KEY_QUERY_VALUE,
hReg);
try
var RegType: DWORD := REG_DWORD;
var RegSize: DWORD := SizeOf(tmpInt);
var UsePassword: DWORD := 0;
if
RegQueryValueEx(
hReg,
'ScreenSaveUsePassword',
nil,
@RegType,
@UsePassword,
@RegSize)
= ERROR_SUCCESS
then
FUsePassword := UsePassword <> 0;
finally
RegCloseKey(hReg);
end;
7. 終了時のパスワード確認
/A
同様、Windows10 以降で廃止されています。
VerifyScreenSavePwd も削除されています。
Windows10 より前の OS をサポートする場合は、Password.CPL に定義されている VerifyScreenSavePwd を使ってパスワード入力ダイアログを表示できます。
パスワードが設定されていて、かつ、この API が True を返した時、スクリーンセーバーを解除します。
type
TVerifyScreenSavePwd = function(ParentHandle: THandle): Boolean; stdcall;
var OK := True;
if FUsePassword then
begin
Lib := LoadLibrary('Password.CPL');
try
if Lib <> 0 then
begin
var VerifyScreenSavePwd :=
TVerifyScreenSavePwd(GetProcAddress(Lib, 'VerifyScreenSavePwd'));
if (Assigned(VerifyScreenSavePwd)) then
OK := VerifyScreenSavePwd(GetFocus);
end;
finally
FreeLibrary(Lib);
end;
end;
if OK then
Terminate;
8. 後始末
変更した設定を元に戻します。
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
// マウスカーソルの表示
// Win32 API ShowCursor に True を渡し戻り値が 0 以上になるまで繰り返す
while (ShowCursor(True) < 0) do
;
// Hook を使っていればフックを解除(次章参照)
if FMouseHook <> 0 then
UnhookWindowsHookEx(FMouseHook);
if FKeyHook <> 0 then
UnhookWindowsHookEx(FKeyHook);
// Mutext を解放
if FMutex <> 0 then
begin
ReleaseMutex(FMutex);
CloseHandle(FMutex);
end;
end;
パスワードについて
上記で解説しましたが、スクリーンセーバー用のパスワードは Windows10 で廃止されました。
その代わり「再開時にログオン画面に戻る」という機能があり、そちらに集約されました。
ですので、上記の /A とパスワード関連の部分を削除するともう少しシンプルな構造にできます。
マウスとキーボードについて
通常は、マウス・キーボードの操作でスクリーンセーバーを終了させます。
その際、マウスとキーボードの操作を検知する方法として以下の2つがあります。
- フレームワークが提供する OnMouseMove や OnKeyDown 等を使う
(→ WM_MOUSEMOVE や WM_KEYDOWN を使う) - Windows API の SetWindowsHookEx を使う
どちらを利用しても問題はないのですが、2番を使わなければいけない場合があります。
それは、ActiveX コンテナ等のマウスやキーボードの入力を受取ってしまうコントロールを乗せている場合です。
これは、例えばウェブブラウザだったり動画プレイヤーだったりします。
その場合、OnMouseMove や OnKeyDown はやってきませんので、2番の方法を用います。
FMouseHookHandle :=
SetWindowsHookEx(WH_MOUSE, MouseHookProc, 0, GetCurrentThreadID);
FKeyHookHandle :=
SetWindowsHookEx(WH_KEYBOARD, KeyHookProc, 0, GetCurrentThreadID);
class function TfrmMain.MouseHookProc(
nCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT;
begin
Result := CallNextHookEx(FMouseHook, nCode, wParam, lParam);
var Pt := PMouseHookStruct(lParam)^.pt;
if Pt <> frmMain.FOldMousePos then
begin
frmMain.FOldMousePos := Pt;
Dec(FMoveCount);
if FMoveCount < 0 then
frmMain.CloseCheckPass;
end;
end;
class function TfrmMain.KeyHookProc(
nCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT;
begin
Result := CallNextHookEx(FKeyHook, nCode, wParam, lParam);
frmMain.CloseCheckPass;
end;
Scrnsave.lib を使う方法
Windows SDK に含まれる Scrnsave.lib (Unicode 版:Scrnsavw.lib) を使うとこれまで解説した事の多くの事を自動的にやってくれます。
VisualStudio + C++ で製作する場合は非常に簡単になるのでオススメです。
しかし、VSC++ 以外ではリンクするのが逆に面倒なので上記の手順を踏む方が簡単です。
詳しくは、下記のドキュメントをご覧ください。
スクリーン セーバーの処理
インストール
スクリーンセーバーの実態は実行ファイル(.exe)です。
実行ファイルの拡張子を .scr に変更すると Windows にスクリーンセーバーとして認識されます。
そして scr ファイルを C:\Windows/System32\
にコピーします。
するとスクリーンセーバーのダイアログにスクリーンセーバーが表示されるようになります。
Windows/System32 以外の場所でも動くのですが(explorer から右クリック)おすすめしません。
サンプル
サンプルのスクリーンセーバーのソースを置いておきます。
このスクリーンセーバーは画面の中央に現在の日時を表示するだけのシンプルなものです。
設定もありません(/C
が来た場合は ShowMessage で名前だけ表示しています。
このサンプルは Delphi 11 Alexandria 以降でビルドできると思います。
無料の Delphi 11 コミュニティエディションはこちら
(ビルドターゲットは Win64 にしてください)
Delphi 使いであれば、このサンプルファイルをスケルトンにしてスクリーンセーバーを簡単に製作できます。
uMain.pas の timerTime の Interval や、timerTimeTimer という酷い名前のイベントハンドラの中身を書き換えれば、定期的に何かさせるスクリーンセーバーが製作できます。
是非試して見てください。
リソースファイル (ScreenSaverName.RC)
STRINGTABLE
{
1, "サンプルセーバー"
}
プロジェクトファイル (SampleSaver.dpr)
program SampleSaver;
// Delphi はビルド時に RC ファイルを RES に自動的にコンパイルして組み込んでくれる
{$R 'SampleSaverName.res' 'SampleSaverName.rc'}
uses
Vcl.Forms,
uMain in 'uMain.pas' {frmMain};
{$R *.res}
begin
Application.Initialize;
Application.MainFormOnTaskbar := False;
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.
スクリーンセーバー本体部分 (uMain.pas)
unit uMain;
interface
uses
Winapi.Windows, Winapi.Messages,
System.Classes, System.SysUtils,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;
type
TfrmMain = class(TForm)
lblTime: TLabel;
timerTime: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure timerTimeTimer(Sender: TObject);
private const
// このスクリーンセーバーを表す自由な文字列
SCREENSAVEID = 'ECF9EF84-46B8-480B-90D9-235FA70188C3';
// 起動して直ぐ終わらない様にするカウント
MOVE_COUNT = 10;
// レジストリ
REG_LANGBAR_SHOW_STATUS_KEY = 'Software\Microsoft\CTF\LangBar\ShowStatus';
// エラーメッセージ
ERR_PASSWORD_DIALOG_DISPLAY_FAILED =
'パスワードダイアログが表示できませんでした';
ERR_PASSWORD_CHANGE_FAILED = 'パスワードの変更に失敗しました';
private class var
FKeyHook: HHOOK;
FMouseHook: HHOOK;
FMoveCount: Integer;
private
class function MouseHookProc(
nCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; static;
class function KeyHookProc(
nCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; static;
private var
FUsePassword: Boolean;
FMutex: THandle;
FProcessingCloseCheckPass: Boolean;
FStartedTime: DWORD;
FScreenSaverTime: DWORD;
FUseMonitorPowerOff: Boolean;
FUseMonitorPowerLow: Boolean;
FMonitorPowerOffTime: DWORD;
FMonitorPowerLowTime: DWORD;
FOldMousePos: TPoint;
private
function ReadRegBool(const APath, AKey: String): Boolean;
procedure ChangePassword;
procedure ShowSettings;
procedure ShowPreview;
procedure ShowScreenSaver;
procedure SetShowMouseCursor(const AValue: Boolean);
procedure CloseCheckPass;
procedure Start;
procedure AppIdleEventHandler(Sender: TObject; var ADone: Boolean);
protected
procedure CreateParams(var AParams: TCreateParams); override;
public
end;
var
frmMain: TfrmMain;
implementation
{$R *.dfm}
uses
Winapi.Imm, System.UITypes;
{ TfrmMain }
procedure TfrmMain.AppIdleEventHandler(Sender: TObject; var ADone: Boolean);
procedure SetMonitorPower(const AFlag: LPARAM);
begin
PostMessage(HWND_BROADCAST, WM_SYSCOMMAND, SC_MONITORPOWER, AFlag);
end;
begin
// 規定の時間が経過したらモニター電源断・シャットダウン
var ElapsedTime := GetTickCount - FStartedTime + FScreenSaverTime;
if
FUseMonitorPowerLow
and (FMonitorPowerLowTime > 0)
and (FMonitorPowerLowTime < ElapsedTime)
then
begin
SetMonitorPower(1);
FUseMonitorPowerLow := False;
end;
if
FUseMonitorPowerOff
and (FMonitorPowerOffTime > 0)
and (FMonitorPowerOffTime < ElapsedTime) then
begin
SetMonitorPower(2);
FUseMonitorPowerOff := False;
end;
end;
procedure TfrmMain.ChangePassword;
type
TPwdChangePassword = function(
Name: PChar;
ParentHandle: HWND;
Reserved1, Reserved2: Integer): Integer; stdcall;
procedure ShowError(const AMsg: String);
begin
MessageDlg(AMsg, mtError, [mbOK], 0)
end;
begin
// Windows 10 以降パスワードは廃止されログイン画面が表示されるようになった
// そのため隠し API PwdChangePassword は提供されなくなった
if TOSVersion.Check(10) then
Exit;
var Lib := LoadLibrary('MPR.DLL');
try
if Lib = 0 then
ShowError(ERR_PASSWORD_DIALOG_DISPLAY_FAILED)
else
begin
var PwdChangePassword: TPwdChangePassword :=
GetProcAddress(Lib, 'PwdChangePasswordW');
if Assigned(PwdChangePassword) then
begin
if PwdChangePassword('SCRSAVE', Handle, 0, 0) <> 0 then
ShowError(ERR_PASSWORD_CHANGE_FAILED)
end
else
ShowError(ERR_PASSWORD_DIALOG_DISPLAY_FAILED);
end;
finally
FreeLibrary(Lib);
end;
end;
procedure TfrmMain.CloseCheckPass;
type
TVerifyScreenSavePwd = function(ParentHandle: HWND): Boolean; stdcall;
begin
if FProcessingCloseCheckPass then
Exit;
FProcessingCloseCheckPass := True;
try
var OK := True;
if FUsePassword then
begin
// Windows 10 以降廃止
var Lib := LoadLibrary('Password.CPL');
try
if Lib <> 0 then
begin
var VerifyScreenSavePwd: TVerifyScreenSavePwd :=
GetProcAddress(Lib, 'VerifyScreenSavePwd');
if Assigned(VerifyScreenSavePwd) then
begin
SetShowMouseCursor(True);
OK := VerifyScreenSavePwd(GetFocus);
SetShowMouseCursor(False);
end;
end;
finally
FreeLibrary(Lib);
end;
end;
if OK then
Application.Terminate;
finally
FProcessingCloseCheckPass := False;
end;
end;
procedure TfrmMain.CreateParams(var AParams: TCreateParams);
begin
inherited;
AParams.WinClassName := 'WindowsScreenSaverClass';
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
// Password を利用しているかを取得する, Windows 10 以降廃止
FUsePassword := ReadRegBool('Control Panel\Desktop', 'ScreenSaveUsePassword');
// Taskbar 上の表示を消す
ShowWindow(Application.Handle, SW_HIDE);
// Switch 毎に機能を変える
var Switch := 'C';
var Param := ParamStr(1);
if not Param.IsEmpty then
Switch := Param.TrimLeft(['-', '/']).ToUpper.Chars[0];
case Switch of
'A': // Windows10 以降廃止
begin
ChangePassword;
Application.Terminate;
end;
'C':
begin
ShowSettings;
Application.Terminate;
end;
'P':
begin
ShowPreview;
end;
'S':
begin
ShowScreenSaver;
end;
end;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
SetShowMouseCursor(True);
if FMouseHook <> 0 then
UnhookWindowsHookEx(FMouseHook);
if FKeyHook <> 0 then
UnhookWindowsHookEx(FKeyHook);
if FMutex <> 0 then
begin
ReleaseMutex(FMutex);
CloseHandle(FMutex);
end;
end;
class function TfrmMain.KeyHookProc(
nCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT;
begin
Result := CallNextHookEx(FKeyHook, nCode, wParam, lParam);
frmMain.CloseCheckPass;
end;
class function TfrmMain.MouseHookProc(
nCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LRESULT;
begin
Result := CallNextHookEx(FMouseHook, nCode, wParam, lParam);
var Pt := PMouseHookStruct(lParam)^.pt;
if Pt <> frmMain.FOldMousePos then
begin
frmMain.FOldMousePos := Pt;
Dec(FMoveCount);
if FMoveCount < 0 then
frmMain.CloseCheckPass;
end;
end;
function TfrmMain.ReadRegBool(const APath, AKey: String): Boolean;
begin
Result := False;
var Key: HKEY := 0;
if
RegOpenKeyEx(
HKEY_CURRENT_USER,
PChar(APath),
0,
KEY_QUERY_VALUE,
Key
)
= ERROR_SUCCESS
then
try
var RegValue: DWORD := 0;
var RegType := REG_DWORD;
var RegSize := SizeOf(RegValue);
if
RegQueryValueEx(
Key,
PChar(AKey),
nil,
@RegType,
@RegValue,
@RegSize)
= ERROR_SUCCESS
then
Result := RegValue <> 0;
finally
RegCloseKey(Key);
end;
end;
procedure TfrmMain.SetShowMouseCursor(const AValue: Boolean);
begin
if (AValue) then
begin
while (ShowCursor(True) < 0) do
;
end
else
begin
while (ShowCursor(False) > 0) do
;
end;
end;
procedure TfrmMain.ShowPreview;
begin
var ParentWnd := HWND(ParamStr(2).ToInteger);
if ParentWnd = 0 then
begin
CloseCheckPass;
Exit;
end;
ParentWindow := ParentWnd;
SetBounds(0, 0, 800, 600); // プレビューの 190x140 以上であれば何でも良い
var R: TRect;
GetWindowRect(ParentWnd, R);
ChangeScale(R.Width, 800);
// 動作開始
Start;
end;
procedure TfrmMain.ShowScreenSaver;
function GetParameter(const AParam: DWORD; const AValue: Pointer): Boolean;
begin
Result := SystemParametersInfo(AParam, 0, Pointer(AValue), 0);
end;
procedure GetParameterToBoolean(const AParam: DWORD; var AFlag: Boolean);
begin
AFlag := False;
if (not GetParameter(AParam, @AFlag)) then
AFlag := False;
end;
begin
// Mutex による2重起動防止
var MutexHandle := OpenMutex(MUTEX_ALL_ACCESS, False, PChar(SCREENSAVEID));
if (MutexHandle <> 0) then
begin
ReleaseMutex(MutexHandle);
Close;
Exit;
end;
MutexHandle := CreateMutex(nil, False, PChar(SCREENSAVEID));
if MutexHandle = 0 then
begin
Close;
Exit;
end
else
FMutex := MutexHandle;
// 電源監視周り
FStartedTime := GetTickCount;
GetParameterToBoolean(SPI_GETLOWPOWERACTIVE, FUseMonitorPowerLow);
GetParameterToBoolean(SPI_GETPOWEROFFACTIVE, FUseMonitorPowerOff);
GetParameter(SPI_GETSCREENSAVETIMEOUT, @FScreenSaverTime);
GetParameter(SPI_GETLOWPOWERTIMEOUT, @FMonitorPowerLowTime);
GetParameter(SPI_GETPOWEROFFTIMEOUT, @FMonitorPowerOffTime);
FScreenSaverTime := FScreenSaverTime * 1000;
FMonitorPowerLowTime := FMonitorPowerLowTime * 1000;
FMonitorPowerOffTime := FMonitorPowerOffTime * 1000;
Application.OnIdle := AppIdleEventHandler;
// Mouse, Keyboad Hook
FMoveCount := MOVE_COUNT;
FMouseHook :=
SetWindowsHookEx(WH_MOUSE, MouseHookProc, 0, GetCurrentThreadID);
FKeyHook :=
SetWindowsHookEx(WH_KEYBOARD, KeyHookProc, 0, GetCurrentThreadID);
// Mouse カーソル消去
SetShowMouseCursor(False);
// 画面サイズ一杯に
var R := Screen.DesktopRect;
SetBounds(R.Left, R.Top, R.Width, R.Height);
// 動作開始
Start;
end;
procedure TfrmMain.ShowSettings;
begin
ShowMessage('Sample Screen Saver');
end;
procedure TfrmMain.Start;
begin
timerTimeTimer(Self);
timerTime.Enabled := True;
end;
procedure TfrmMain.timerTimeTimer(Sender: TObject);
begin
// ここを書き換えると定期的に何かするタイプのスクリーンセーバーになります
// 今回はここで日時を表示しています
lblTime.Caption := FormatDateTime('yyyy/mm/dd hh:nn:ss', Now);
end;
end.
フォームファイル (uMain.dfm)
object frmMain: TfrmMain
Left = 0
Top = 0
BorderStyle = bsNone
Caption = 'Sample'
ClientHeight = 480
ClientWidth = 640
Color = clBlack
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
FormStyle = fsStayOnTop
OnCreate = FormCreate
OnDestroy = FormDestroy
TextHeight = 15
object lblTime: TLabel
AlignWithMargins = True
Left = 3
Top = 3
Width = 634
Height = 474
Align = alClient
Alignment = taCenter
Caption = 'lblTime'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = 80
Font.Name = 'Segoe UI'
Font.Style = []
ParentFont = False
Transparent = True
Layout = tlCenter
ExplicitWidth = 190
ExplicitHeight = 78
end
object timerTime: TTimer
Enabled = False
Interval = 500
OnTimer = timerTimeTimer
Left = 48
Top = 48
end
end
最後に
昔 (Flash が死に絶える前) fla:ver という Flash ムービーをスクリーンセーバーにするアプリを販売していて、Flash を使ったスクリーンセーバー界ではデファクトスタンダードになりました。
そのおかげで、ある機種で動作しないとか動作がおかしいなどの不具合報告を沢山頂き、上記の情報や技術が手に入りました。
Lite Edition の紹介記事
https://forest.watch.impress.co.jp/article/2005/08/08/flaverlite.html
ちなみに ActiveX コンテナを動かす場合、セキュリティレベルを同じにしないと動作しないなど、他にも必要なテクニックがあります。
まあ、必要ないだろうと思うので今回は割愛します。
令和の世にスクリーンセーバーを作る事なんてもう無いだろうけど、間違った記事や中途半端な記事、無料ホームページサービスの終了によって消滅した記事が多かったので技術継承目的でまとめて起きました。
良きスクリーンセーバーライフをおくってください!