mieki256's diary

Lazarus 4.4 でWindows用のスクリーンセーバを作りたい。環境は Windows11 x64 25H2。

「スクリーンセーバーの変更」ウインドウ上で、リストからLazarus製スクリーンセーバを選択すると、WindowsのタスクバーにLazarus製アプリのアイコンが表示されてしまう状況が気になってきた。ちゃんとしたスクリーンセーバならタスクバーにアイコンが表示されたりしないわけで…。

Delphi なら、フォームの ParentWindowプロパティに親ウインドウのHWND(ウインドウハンドル)を代入するだけで色々とイイ感じに処理してくれるっぽいのだけど、Lazarus はクロスプラットフォーム対応を重視しているせいか、Delphi ほどイイ感じにはしてくれないらしい。

それでも、AI(Google Gemini)と何度かやり取りして実験しているうちに、アイコンが表示されない状態になる記述の仕方に辿り着いた。

以下はプレビュー画面モードだけを ―― コマンドラインオプションで「/p HWND」が指定された時の処理だけを行ってるサンプル。「/s」「/c:HWND」等は何もしないで終了する。

_SSPreviewTest1.lpr (メインプログラム)

program SSPreviewTest1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  {$IFDEF HASAMIGA}
  athreads,
  {$ENDIF}
  Interfaces, // this includes the LCL widgetset
  SysUtils,
  Windows,
  Controls,
  Forms,
  Unit1 { you can add units after this };

  {$R *.res}

var
  ParentHWND: HWND = 0;
begin
  RequireDerivedFormResource := True;
  Application.Scaled := True;
  Application.Initialize;

  if (ParamCount >= 2) and (SameText(ParamStr(1), '/p')) then
  begin
    ParentHWND := StrToIntDef(ParamStr(2), 0);
  end;

  // プレビューモード以外（/s や /c）は何もしないで終了
  if ParentHWND = 0 then Exit;

  Application.CreateForm(TForm1, Form1);

  {$PUSH}
  {$WARN 5044 OFF}
  // タスクバー完全抑制処理
  // メインフォームをタスクバーと連動させない
  Application.MainFormOnTaskbar := False;
  {$POP}

  {$PUSH}
  {$WARN SYMBOL_PLATFORM OFF}
  // Application(隠し窓)にツールウィンドウ属性を与えてタスクバーから隠す
  SetWindowLong(Application.Handle, GWL_EXSTYLE,
    GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
  {$POP}

  // プレビューの実行
  Form1.PreparePreview(ParentHWND);

  Application.Run;
end.

フォーム側のコードは以下。TFormの上に、TTimer (TimerMonitor) を置いてある。

_Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
  Windows, Variants;

type

  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    StaticText1: TStaticText;
    TimerMonitor: TTimer;
    procedure TimerMonitorTimer(Sender: TObject);
  private
    FParentHWND: HWND;
  public
    procedure PreparePreview(AParent: HWND);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.PreparePreview(AParent: HWND);
var
  R: TRect;
begin
  FParentHWND := AParent;

  // フォームの拡張スタイルから「タスクバー表示フラグ」を除去して
  // 「ツールウィンドウ」属性を付与
  SetWindowLong(Handle, GWL_EXSTYLE,
    (GetWindowLong(Handle, GWL_EXSTYLE) and not WS_EX_APPWINDOW) or WS_EX_TOOLWINDOW);

  // フォームのスタイルを「子ウィンドウ」化してタイトルバーなどを除去
  SetWindowLong(Handle, GWL_STYLE,
    (GetWindowLong(Handle, GWL_STYLE) or WS_CHILD) and not
    (WS_POPUP or WS_CAPTION or WS_THICKFRAME));

  // 親ウィンドウをプレビュー枠に設定
  Windows.SetParent(Handle, FParentHWND);

  // サイズ合わせ
  Windows.GetClientRect(FParentHWND, @R);
  SetBounds(0, 0, R.Right, R.Bottom);

  // 表示。これでLCLの描画サイクルが正常に回る
  Self.Visible := True;

  TimerMonitor.Enabled := True;
end;

procedure TForm1.TimerMonitorTimer(Sender: TObject);
begin
  // 親ウィンドウが消滅（設定画面が閉じられた）したらアプリ終了
  if (FParentHWND <> 0) and (not IsWindow(FParentHWND)) then
    Application.Terminate;
end;

end.

_Unit1.lfm (フォームデザイン用ファイル)

もしかすると予想を外しているかもしれないけれど…。Lazarus の場合、ParentWindow にHWNDを代入してしまうとよろしくない状態になるような気がしている。何か色々と処理をしてくれるのだろうけど、それが今回は裏目に出ていたのかもしれないなと…。

ParentWindow を使った場合も、親ウインドウと子ウインドウの関係は一応実現できているようではある。親ウインドウの位置を移動すれば子ウインドウ扱いになっているはずのフォームも一緒になって動くので…。ただ、今回のような場面では、ParentWindow を使わずに、WindowsのAPIを逐一呼んで処理したほうが間違いないのかもしれない。

悩ましいのは、どうやってフォームを閉じる/終了させるタイミングを知ればいいのか…。今回は TTimerを使って、一定時間毎に親ウインドウが消滅しているかチェックして、親が居なくなっていたら自身も終了する処理を入れてある。コレが無いと「スクリーンセーバーの変更」ウインドウ上でリスト選択を切り替えた時にプロセスが残り続けてしまう。

ただ、以前試した際は、自身が非表示にされたかどうかまでチェックして終了させていた。今回はそのチェックをしなくても終了できているので、親子の繋がり方が以前とは何か違っているのかもしれない。

余談。AIに尋ねていたら、フォーム上のパネルを切り離して、そのパネルを親ウインドウの子ウインドウにする方法まで提示してきた。試してみても、フォームまで表示されたり、パネル上のラベルが表示されなかったり、背景色変更すらできなかったりしたので諦めてしまったけれど、そういう発想もあるんだなあ、と…。