LoginSignup
32
15

[Windows] 令和のスクリーンセーバーの作り方

Last updated at Posted at 2024-05-21

スクリーンセーバーとは

画面の焼き付きや画面の情報の漏洩を防ぐために表示されるアプリケーションです。

現代では、画面をスリープしてしまう事が多くスクリーンセーバー自体は役割を終えたかなと思っていますが、作りたいという方がいたときに中途半端な情報ばかりになっているため、この記事では必要な情報を全て記載します。

ただし、この記事では 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 を使います。

パスワード変更ダイアログ表示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 形式にコンパイルして実行ファイルに組み込みます。

ScreenSaverName.RC
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つがあります。

  1. フレームワークが提供する OnMouseMove や OnKeyDown 等を使う
    (→ WM_MOUSEMOVE や WM_KEYDOWN を使う)
  2. Windows API の SetWindowsHookEx を使う

どちらを利用しても問題はないのですが、2番を使わなければいけない場合があります。
それは、ActiveX コンテナ等のマウスやキーボードの入力を受取ってしまうコントロールを乗せている場合です。
これは、例えばウェブブラウザだったり動画プレイヤーだったりします。
その場合、OnMouseMove や OnKeyDown はやってきませんので、2番の方法を用います。

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)
ScreenSaverName.RC
STRINGTABLE
{
  1, "サンプルセーバー"
}
プロジェクトファイル (SampleSaver.dpr)
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)
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)
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

Professional の画面
image.png

ちなみに ActiveX コンテナを動かす場合、セキュリティレベルを同じにしないと動作しないなど、他にも必要なテクニックがあります。
まあ、必要ないだろうと思うので今回は割愛します。

令和の世にスクリーンセーバーを作る事なんてもう無いだろうけど、間違った記事や中途半端な記事、無料ホームページサービスの終了によって消滅した記事が多かったので技術継承目的でまとめて起きました。
良きスクリーンセーバーライフをおくってください!

32
15
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
32
15