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

Lazarus 4.4 で、クラス名をリネームしたい。環境は Windows11 x64 25H2。

ソースコード(.pas、.lpr)上では、リネームしたい場所にカーソルを置いてF2キーを押せばリネーム用のダイアログが表示されてリネームできるけど…。フォームデザイン用ファイルの .lfm 側は修正されないままなので、仕方なくテキストエディタで .lfm を開いて手作業で書き換えていた。

_Lazarusでクラス名変更ができなくてハマった - mieki256's diary

ただ、今回触っていたら、フォームのプロパティの Name を書き換えるだけで、クラス名をコード側の記述で置き換えてくれることに気づいた。

これなら簡単にリネーム作業ができそう…。

Windows11 x64 25H2 + Lazarus 4.4 でデバッガの使い方を少し調べた。

ソースコード中の一時停止したい場所にカーソルを合わせて、行番号の少し前のあたりをクリックすると、丸くて赤い「？」アイコンがついて、ブレークポイントを設定できる。

実行(F9)をすると、ブレークポイントの場所で一時停止できる。

• ステップオーバー(F8)で、1行ずつ先に進める。呼び出してるメソッド内には入らない。
• ステップイン(F7)で、呼び出してるメソッド内にまで入って処理を追っていける。
• ステップアウト(Shift+F8)で、今居るメソッドから抜けるまで処理を進める。

これだけでも、期待通りに処理が進んでいるか確認ぐらいはできる。

◎ 変数の値を確認 :

ダイソーリオンドール須賀川店で、ワイヤー(針金)その他を購入したことをメモ。

• アルミ自在ワイヤー。針金6651。色は赤。直径3.0mm。長さ1.5m。材質アルミニウム。大創産業株式会社。日本製。
• スチール製カラーワイヤー。針金6767。色は白。直径1.6mm。長さ10m。材質: スチール、塩化ビニール樹脂。大創産業株式会社。MADE IN CHINA。
• シリコーン製イス脚キャップ。キズ防止7925。1脚分。4個入り。対応脚サイズ: 丸脚直径20mm - 26mm。角脚一辺17mm - 24mm。大創産業株式会社。MADE IN CHINA。
• 犬用/間食 さつまいもスティック。ドッグフード2510。60g。賞味期限2027/02/01。開封後要冷蔵、と書いてあった。大創産業株式会社。原産国: 中国。

郵便受けを外壁に針金で引っ掛けているけれど、頻繁に外れてしまうらしいので、直径3mmの針金を買ってきた。これで置き換えてみて改善すればいいけれど…。

台所の椅子のキャップが外れてしまっていたので、代替品を購入。サイズはちょうどイイ感じだったけど、装着したら何故か椅子がグラグラする…。何度かつけたり外したりしたけど改善せず。底面に貼ってあるフェルトの厚みにばらつきがあるのだろうか…？

CanDoイオンタウン須賀川店でおにぎりケースを購入。

• おにぎり型ケース2P。2個入り。容量140ml。原料樹脂: ポリプロピレン。耐熱温度120度。耐冷温度-20度。発売元 株式会社ナカノ。MADE IN CHINA。ケースの上にラップを引いてごはんを入れてラップで包んで蓋をして振り回せば形が整う、と裏面に書いてある。

この手のおにぎりを作るグッズはケースに直接ごはんを入れる使い方を推奨していて洗うのが面倒で結局使わなくなってしまったのだけど、ラップを引いてから使えるよと謳ってたので気になって買ってしまった…。