mieki256's diary

去年、本局に行って年賀状を出そうとした時は、入り口が閉まっていたのでポストに入れるしかなかった。今年は入り口が開いていて、年賀状を入れる箱もまだ設置されていた。元日の昼間なら入り口が開いているのかもしれない。去年は夕方に行ったから…。

ただ、県内と県外で分けるようにはなってなくて、どちらも同じ穴(?)に入れる状態になっていた。年末と比べたら扱うハガキの枚数が少ないだろうから一つにまとめられたのかな。

世間様の風潮的に年賀状じまいがブーム(?)のようで、自分の手元に届いた年賀状も去年の時点で半分ぐらいになっていたので、この際自分もその波に乗って(?)、今回の年賀状で最後に ―― 年賀状じまいの挨拶を書いておいた。

ハガキ代も値上がりしちゃって厳しいし…。これが電子メールなら数秒で相手先に届く上にコストもハガキの数十分の一で済んでしまうのだから、そりゃ年賀状も廃れるよな…。おそらく昭和の一時期に流行った風習という扱いになっていくのだろう。

ただ、年賀状を送れるなら送ったほうがいいのだろうな、とは思っていて…。

• 年賀状のやり取りしかしてない方と、年賀状のやり取りすらしてない方では、改めて連絡する際の心理的ハードルが違う。
• 例えば当人が亡くなった際、御遺族が故人のPCやスマホにアクセスして友人知人の連絡先を把握するのは難しい。しかし年賀状という印刷物が残っていれば連絡先を容易に把握できるから、一報を貰える可能性が高まる。

もっとも、前者は日頃からSNSや電子メールでこまめに連絡を取っておくのが理想的だし、後者についても生前から連絡先リストをちゃんと作成して家族に渡しておくのが理想的ではある。しかし人間はとにかくズボラなので、それら理想的な状況を意識して作っておくのもなかなか難しく。ただ、年賀状さえ送っておけば、このあたりの問題は解決できてしまうので、実はズボラな人間にとってそこそこありがたい風習だった面もあったのだろうと思う。

とは言え、自分も含めて友人知人は皆歳を取って先が見えてきているから、改めて連絡しないといけない機会も今後おそらく無さそうだしで…。もうそろそろこういうのはいいよな、という気分になってきたところもあって…。

いや。単にハガキ代の値上がりが響いてるだけかも。物理的に印刷物を送るのだからコストがかかって当たり前だろうけど…。

年賀状じまいの挨拶文は、AIに叩き台を生成してもらって、ソレを修正して作りました。AIスゴイ。すらすらと文章を考えて…。いや、考えてると言えるのかどうか、そこは微妙なところか…。とにかくすらすらと文章を提示してくれる。

もっとも、AIが無い時代もえてして文例集を参考にしてその手の文章を作成していたわけだし、こちら側の作業内容は昔とさほど変わっていない気もする。文例集へのアクセス速度と保持している文例の物量が変わった、ぐらいの状況かもしれない。でもまあ、以前より便利になったのは間違いない…。

はがきのサイズは、100 x 148mm。

• 150 DPI : 591 x 874 pixel
• 300 DPI : 1181 x 1748 pixel

以前作った版は、プレビューモードにしろ、設定モードにしろ、フルスクリーン表示モードにしろ、立ち上がってくるまで数秒かかってしまってこれでは使えんわと思ったのだけど。今回、pywin32 を使ってプレビューモードの処理を行うことで、起動時間が短くなってくれないかなあと期待しながら作業してた。

全然ダメだった。相変わらず起動に数秒かかる。話にならない。

.scr はSSD上に置いてあるのにこれだけ時間がかかるのだから、これがもしHDD上に置いてあったら目も当てられない状態になるのではないか…。

起動が遅い原因は、おそらくだけどファイルの展開に時間がかかっているせいではなかろうか。

Nuitka というツールを使うと Pythonスクリプトをexeファイルにできるけれど、1ファイルのexeに変換してソレを実行した場合、一旦 テンポラリフォルダ %temp% 内にファイル群を展開して、そこから実際の処理が始まる。

今回作成した .scr を実行した際の %temp% 内を覗いてみたら、1010ファイル、40フォルダが展開されていた。「スクリーンセーバーの変更」ウインドウで何かしら操作をするたびに、1010ファイル、40フォルダも展開して、しかもプロセスが終了するたびにそれらのファイル群を毎回削除しているのだから、そりゃ起動時間が遅くて当然だろう…。

Pythonを使えば比較的誰でも簡単にスクリプトが書けるので、Pythonでスクリーンセーバを作れたら楽になるだろうなと思っていたけれど…。Pythonスクリプトをexe化する仕組み自体に問題(?)があるなと…。

Windows用のスクリーンセーバは、exeファイルを生成することが前提のプログラミング言語で作らないと使い物にならない気がしてきた。

もっとも、今時スクリーンセーバを使う機会自体がそもそも無いだろうし、自分は無駄な実験してるなあ、とも思ってるけど…。

• Windows10/11 は一定時間操作しないとディスプレイをサスペンド状態に移行する機能がついている。フツーはソレを使う。省エネを考えたらCPUをぶん回してアニメーションを表示し続けること自体がおかしい。まずはディスプレイを消しましょう、となるよな…。
• ディスプレイの焼き付き防止云々もブラウン管を使ってた時代の話だし…。そもそもディスプレイを消しちゃえば焼き付きもへったくれもない。

スクリーンセーバの必要性なんて現代では存在しない…。リアルタイム描画を行うCGアート作品としての価値しかない。

ただ、それはそれとして、今ならスクリーンセーバぐらい簡単に作れないのかな？ と疑問が湧いて、こうして実験してしまうという…。残念なことに今でも簡単には作れないっぽい。いや、一応簡単に作れるけれど、それはそれで何かしら制限というか、不便なところが出てきてしまう。どうしても作りたかったら、C/C++ で作るしかないのかなあ…。

Windowsに標準で入ってる機能で実現できるらしい。

_Windowsでtailコマンドを使う方法|リアルタイムでログを監視する方法|サイバーセキュリティ.com
_windowsで"tail -f "する Windows - Qiita

PowerShell を立ち上げて以下を打てばいいらしい。

Get-Content C:\hoge\fuga\log.txt -Wait
or
Get-Content -Path C:\test.log -Wait -Tail 0
or
Get-Content C:\hoge\fuga\log.txt -Wait -Tail 50

GUIアプリとして tail -f のようなことができるフリーソフトもあるらしい。


_Bare Metal Software > BareTail - Free tail for Windows

BareTail というソフトでできる。最終版は 2006/11/02 に更新されているのでかなり古いバイナリだけど、Windows11 x64 25H2 でも動作した。baretail.exe を入手して実行すれば起動してくれる。


_TextWatcher.exeの詳細情報 : Vector ソフトを探す！

Windows XP のみ対応と書かれているけれど、Windows11 x64 25H2 でも動作した。TextWatcher15.lzh を入手して解凍すると、TextWatcher.exe というファイルが入ってるので、実行すれば起動する。フォント変更や、最前面表示の有効無効も設定できる。


_リアルタイムテキストビューワーの詳細情報 : Vector ソフトを探す！

Windows2000 - Windows7 までの対応と書いてあるけれど、Windows11 x64 25H2でも動作した。RealtimeTextViewer_1_0_0.zip を入手して解凍すると、中に RealtimeTextViewer.exe が入ってるので、実行すれば起動する。変更行が上のほうに表示される。フォント変更や最前面表示は変更できない。


_glogg - glogg - the fast, smart log explorer

クロスプラットフォームアプリ。Windows、Mac、Linux で利用できる。glogg-latest-x86_64-setup.exe を入手して実行するとインストーラが起動する。Windows11 x64 25H2上で動作した。フォント変更可能。

Nuitka を使って1つのexeファイルにしているけれど、実行するたびにテンポラリフォルダ上に1000ファイル以上のファイル群を展開しているのが気になる。そこが遅いのではないか…？

ファイル群の中身を確認したら、tkinter を使うと大量のファイルが必要とされてしまうことが分かった。tclという名前のフォルダが展開されるけれど、そこだけで800ファイル以上ある。

ということは、tkinter を使わない作りにすれば展開ファイル数を激減できるのではないかな…？

試しに、tkinter で表示していた部分を、DearPyGui というライブラリ(モジュール)で置き換えてみた。以下でインストールできる。

python -m pip install dearpygui

tkinter を DearPyGui に置き換えたところ、展開ファイル数が、1010ファイル → 89ファイルと圧倒的に少なくなった。

しかし、喜んだのも束の間、奇妙な動作になった。Windowsの「スクリーンセーバーの変更」ウインドウ上で「設定」ボタンをクリックすれば、DearPyGuiによる設定ウインドウ相当が表示されるはずだけど、表示されない…。

不思議なことに、以下の操作をした場合は DearPyGui によるウインドウが表示される。

• 生成された .exe に「/c」をつけて実行。
• .exe をリネームコピーした .scr を右クリックして「構成」を選ぶ。

.scr を右クリックして操作した場合でも表示されるのだから、スクリーンセーバとして利用する場合も表示されそうな気がするのだけど…。どうしてこんな動作になるのか…。原因がさっぱり分からない…。

考えてみたら、現状では「設定」ボタンをクリックした際にアプリ名とバージョン名を表示しているだけなので、只のメッセージボックスでもいいのではないかと思えてきた。

もし、スクリーンセーバの設定項目をちゃんと用意して設定できるようにしたい場合は、フルスクリーン表示時に設定操作ができる仕様を追加する形でいいだろう…。そういう仕様のスクリーンセーバを今までもいくつか目にしているので、それで全然OKのはず。

さておき、Pythonでメッセージボックスを表示する方法は以前試してある。今回は ctypes を利用して表示する方法を選んでみた。

_mieki256's diary - Pythonスクリプトでメッセージボックスを表示したい


ついでに、Pillow を使ってpng画像を読み込んで縮小している処理も省いてみた。最初から 152 x 112 のbmp画像を用意しておけば、pywin32 だけで、というかWindowsのAPIで画像を読み込めるし、描画もできる。これで Pillow も組み込まずに済む。

ちなみに、「スクリーンセーバーの変更」ウインドウのプレビュー画面のサイズは 152 x 112。Windows95 のデスクトップ画面も調べてみたけれど、Windows11 に至るまでサイズは変わってないように見える。

そんな感じにしてみたけれど、展開ファイル数は82ファイルになった。1000ファイル以上展開していた状態と比べたら、展開時間は圧倒的に短くて済むはず…。

しかし、それでも起動に時間がかかる。

正確には、プレビュー画面を表示するときだけ異様に時間がかかる。5秒ぐらい経たないと画像が表示されない。

「設定」や「プレビュー」をクリックした時は、.exe に「/c」「/s」をつけて実行した時と同様、体感で1秒前後でメッセージボックスやフルスクリーン表示になってくれるのだけど…。

ウイルス対策ソフト Microsoft Defender が何かしていて遅くなっているのかなと、試しにリアルタイム保護を無効にして試してみた。変化無し。ということは、ウイルス対策ソフトが動作を遅くしているわけではないのだろうな…。そもそも、/c や /s をつけて実行する時はサクッと起動しているのだし…。

Pythonスクリプトをexeファイル化してくれる Nuitka について、色々なオプションがあることが分かってきたのでついでにメモ。

作者名等を付加したい時は以下を指定できる。exeファイルに指定内容が含まれて、プロパティ → 詳細、を選べばある程度反映された状態になっていることがわかる。

--copyright="YOUR NAME"

--windows-product-name="YOUR SOFT NAME"

--file-description="DESCRIPTION"
--windows-file-description="DESCRIPTION"

--windows-product-version=0.0.1.0
--windows-product-version=0.0.1.0

--windows-file-version=0.0.1.0

--windows-company-name="YOUR COMAPNY"

_We Love Python (7) Nuitkaさんはマルウェアじゃない!&来年に向けて|明日太
_Python Nuitkaでウイルス誤判定を回避しつつ実行ファイル「exe」をつくる方法
_nuitkaで作ったexeがウイルス扱いされないための方法 - shikaku's blog

起動が遅いのはウイルス対策ソフトが何かしているのではないかと予想して、このあたりを指定してみたけれど変化はなかった…。


その他のオプションもメモ。

• --remove-output : 作業用として作成されたファイル群を自動削除。
• --mingw64 : MinGW64でコンパイル。つけなければ Visual C++ (cl.exe) でコンパイル。cl.exe のほうが省メモリで動くが、コンパイル速度は MinGW64 のほうが速いらしい。
• --include-data-dir="./res=res" : 含めるデータディレクトリを指定
• --enable-plugin=tk-inter : tkinterを含める。
• --follow-imports --onefile : 1ファイルのexeを生成。
• --standalone : exe以外に必要なdll等をそのまま置く。--follow-imports は自動でしてくれるらしい。

ドキュメントを読んでいたら、Pythonスクリプトのソース内にコメントの形でこれらのオプションを書いておくことでも反映される、といった内容を目にしたような記憶もあるけれどちょっと自信なし。

以下、検証内容。

プレビュー画面モードしか動かない、最低限の処理しかしないスクリプトを作成して試してみた。処理内容は、与えられたウインドウハンドルを親とした子ウインドウを生成して、子ウインドウの全面を青一色で塗り潰すだけ。やってることがめちゃくちゃ少ないので、同梱されるファイル群も最小限になって、Nuitka で1ファイルにexe化した場合のファイル展開も軽くなるはず…。

環境は Windows10 x64 22H2 + Python 3.10.10 64bit。

動作には pywin32 が必要。以下でインストールできる。今回は pywin32 311 がインストールされた。

python -m pip install pywin32

_pywinsc0.py

"""
与えられたウインドウハンドル(HWND)を親として、
子ウインドウを作成して1色で塗り潰す。
スクリーンセーバのプレビューモードの反応を確認するために作成。

以下のオプションを受け付ける。

* /p <HWND> : プレビュー画面モード
* /c : 設定画面モード。今回はメッセージボックスのみを表示

Windows11 x64 25H2 + Python 3.10.10 64bit
"""

import sys
import ctypes
import win32gui
import win32api
import win32con

dbg = False
# dbg = True

# 描画処理をするかしないか
draw_enable = True
# draw_enable = False

WINDOW_CLASSNAME = "PythonFillOnlySimpleWindow"

# Windows11等の高解像度ディスプレイへの対応
try:
    ctypes.windll.shcore.SetProcessDpiAwareness(1)
except Exception:
    ctypes.windll.user32.SetProcessDPIAware()


def print_log(s: str):
    """コンソールにメッセージを出力"""
    if dbg:
        print(s)


class MyChildWindow:
    """子ウインドウ担当クラス"""

    def __init__(self, parent_hwnd):
        """初期化処理"""

        self.parent_hwnd = parent_hwnd  # 親のウインドウハンドル
        self.class_name = WINDOW_CLASSNAME
        self.paint_count = 0
        self.hwnd = self._create_window()

    def _create_window(self):
        """子ウインドウを作成"""

        wc = win32gui.WNDCLASS()
        wc.lpfnWndProc = self.wnd_proc
        wc.lpszClassName = self.class_name
        wc.hInstance = win32api.GetModuleHandle(None)
        wc.hCursor = win32gui.LoadCursor(0, win32con.IDC_ARROW)
        wc.hbrBackground = win32gui.CreateSolidBrush(win32api.RGB(0, 0, 0))

        # リサイズ時に再描画を要求
        # wc.style = win32con.CS_HREDRAW | win32con.CS_VREDRAW

        try:
            # 定義したクラスをOSに登録
            win32gui.RegisterClass(wc)
        except win32gui.error as e:
            # 登録済みなら Error code = 1410 が出るので、それ以外なら例外を出す
            if e.winerror != 1410:
                raise

        # 親のクライアント領域を取得
        rect = win32gui.GetClientRect(self.parent_hwnd)
        w = rect[2] - rect[0]
        h = rect[3] - rect[1]

        # ウインドウを作成。ウインドウハンドルを返す
        hwnd = win32gui.CreateWindowEx(
            0,  # 拡張スタイル(今回は無し)
            self.class_name,  # 登録クラス名
            "Child Window",  # ウインドウタイトル
            win32con.WS_CHILD | win32con.WS_VISIBLE,  # 子ウィンドウとして作成、即表示
            0,
            0,
            w,
            h,  # 親の左上(0,0)を起点に配置
            self.parent_hwnd,  # 親ウィンドウハンドル
            0,  # メニューなし
            win32api.GetModuleHandle(None),  # インスタンス
            None,  # 追加パラメータなし
        )

        if not hwnd:
            print_log("[Child] Error: ウインドウ生成に失敗")
            return None

        print_log(f"[Child] ウインドウ生成。HWND: {hwnd}")
        return hwnd

    def wnd_proc(self, hwnd, msg, wparam, lparam):
        """ウインドウプロシージャ"""

        if msg == win32con.WM_PAINT:
            # 描画を要求された
            if win32gui.IsWindow(self.hwnd):
                self.paint_count += 1
                print_log(f"[Child] WM_PAINT 受信。count={self.paint_count}")

                hdc = win32gui.GetDC(hwnd)  # 描画を準備。hdc(デバイスコンテキスト)取得
                rect = win32gui.GetClientRect(hwnd)  # クライアント領域のサイズを取得
                col = win32api.RGB(0, 0, 255)  # 色を設定
                brush = win32gui.CreateSolidBrush(col)  # ブラシを作成

                win32gui.FillRect(hdc, rect, brush)  # 塗り潰し

                # クリーンアップ。ブラシやhdcを削除や開放しないとメモリリークを起こす
                win32gui.DeleteObject(brush)
                win32gui.ReleaseDC(hwnd, hdc)

            return 0  # メッセージを処理した場合は0を返してやる

        if msg == win32con.WM_DESTROY:
            # ウインドウの破棄を要求された
            print_log("[Child] WM_DESTROY 受信。Quit を送信。")
            win32gui.PostQuitMessage(0)
            return 0

        # 自分で処理しないメッセージはOS既定の処理に渡す
        return win32gui.DefWindowProc(hwnd, msg, wparam, lparam)

    def run(self):
        if win32gui.IsWindow(self.hwnd):
            # 初回描画を強制的に促す(メッセージキューにWM_PAINTを入れる)
            win32gui.InvalidateRect(self.hwnd, None, True)

            # キューを待たずに、今すぐ描画を反映
            win32gui.UpdateWindow(self.hwnd)

        # メッセージループ開始。
        # OSからの信号(WM_PAINT等)を待ち受けて wnd_procへ流し続ける
        # これがないとスクリプトは終了してしまう。
        win32gui.PumpMessages()
        return


def config_mode():
    """設定画面モード"""

    # メッセージボックスのみを表示
    message = "Config mode"
    title = "Information"
    ctypes.windll.user32.MessageBoxW(None, message, title, 0)


def main():
    # コマンドラインオプションを解析して処理を分ける
    args = sys.argv[1:]
    if len(args) >= 1:
        opt = args[0].lower()
        if opt == "/p" and len(args) == 2:
            hwnd = int(sys.argv[2])
            if draw_enable:
                # 子ウインドウを生成して描画する状態
                if win32gui.IsWindow(hwnd):
                    preview = MyChildWindow(hwnd)
                    preview.run()
            else:
                # 何もしないで抜ける状態
                return
        elif opt == "/c":
            config_mode()
        elif opt == "/s":
            print_log("Fullscreen mode")
        else:
            config_mode()
    else:
        config_mode()

    print_log("[Child] プロセス終了")


if __name__ == "__main__":
    main()

このスクリプトを、Nuitka を使ってexe化する。インストールは以下。今回は Nuitka 2.8.9 がインストールされた。

python -m pip install nuitka

Nutika を使って .py を .exe に変換。pywinsc0.exe が出来上がる。--onefile をつけているので、1ファイルだけになる。

python -m nuitka --remove-output --windows-console-mode=disable --follow-imports --onefile pywinsc0.py

exeファイルをリネームコピーして、.scr を作成。

copy pywinsc0.exe pywinsc0.scr

以下の場所に .scr をコピー。

C:\Windows\System32\

「スクリーンセーバーの変更」を起動して、リストの中から「pywinsc0」を選べば動作確認できる。

結果だけど、相変わらず5秒ぐらい待たされてしまう…。ダメだこりゃ。

「スクリーンセーバーの変更」上で「設定」ボタンを押した時、つまりは「/p HWND」ではなく、「/c:HWND」あるいは「/c」を与えて実行された時は、ほぼ瞬時にメッセージボックスが表示されている。

つまり、Nuitka で作った .exe (.scr) がテンポラリフォルダにファイル群を展開している時間はそこそこ短くて済んでいるはず。もし、展開時間が長ければ、メッセージボックスが表示される際も、もっと時間がかかるはずなので…。

Nuitka に、1ファイル化を指定する --onefile ではなく、ファイル群を展開したままの状態でexe化させる --standalone を指定して exe を作成してみた。

必要なファイル数はたかだか12ファイルだった。1ファイル化する場合、この12ファイルが内包されて、実行時には展開されるのだろう。

> dir
...
2026/01/05  19:38    <DIR>          .
2026/01/05  19:38    <DIR>          ..
2026/01/05  19:38            32,792 libffi-7.dll
2026/01/05  19:38         4,462,360 python310.dll
2026/01/05  19:38           679,936 pythoncom310.dll
2026/01/05  19:38         3,787,776 pywinsc0.exe
2026/01/05  19:38           135,168 pywintypes310.dll
2026/01/05  19:38            29,976 select.pyd
2026/01/05  19:38         1,123,608 unicodedata.pyd
2026/01/05  19:38            98,224 vcruntime140.dll
2026/01/05  19:38            37,256 vcruntime140_1.dll
2026/01/05  19:38           134,144 win32api.pyd
2026/01/05  19:38           219,648 win32gui.pyd
2026/01/05  19:38           123,672 _ctypes.pyd
              12 個のファイル          10,864,560 バイト

tkinter を使ったスクリプトを Nuitka でexe化した際は 1000ファイル以上のファイル群になっていたので、それと比べたら圧倒的に展開時間は短くなってくれたはず。

しかしそれでも、プレビュー画面モードは表示が遅い…。設定画面モードなら瞬時に表示されているのだから、プレビュー画面モードの動作だけがおかしい…。

Google Gemini や Microsoft Copilot にこのあたりを尋ねてみたけれど…。

AI君曰く。Windowsの「スクリーンセーバーの変更」ウインドウは、ウインドウハンドルを渡したら即座に描画が始まることを前提としていて、もしちょっとでも描画の開始が遅くなったら「ははあ。このプラグラム、さては固まってやがるな？」という扱いになって、タイムアウトするまで描画されない状態になる、という可能性を提示してきた。

いやまあ、AI君の言うことだから嘘八百かもしれないのだけど…。情報ソースを出してくれと言ってもさっぱり出してくれなかったし…。

でも、たしかにその可能性もあるかもなと…。Nuitka で1ファイル化したexeファイルはどうしてもファイル群の展開時間がかかってしまう。その間に、「固まってやがるな？ じゃあ、お前の描画は後回しな」という扱いになっていてもおかしくはない…。

AI君は「--onefile を使わずに --standalone で試せ。起動が速くなるから状況が変わるかもよ？」と言ってきたけど、その場合 .exe (.scr) と同階層に大量(?)の .dll や .pyd も配置しないといけない。C:\Windows\System32\ の中にそんなもん入れられんわい。

Nuitka に、.exe以外のファイル群を別フォルダにまとめるオプションがあればいいのだけど、そんなものは無さそうで…。

試しに、「/p HWND」が渡された時は何もせずに即座にプロセスを終了する処理にしてみた。以下のような結果になった。




「スクリーンセーバーの変更」にすぐさま主導権？が返ってきて、プレビュー画面は真っ黒になっている。この真っ黒は、おそらくプレビュー画面のウインドウの背景色だと思われる。呼ばれたスクリーンセーバがプレビュー画面モードで何もしない時は、プレビュー画面ウインドウを背景色で一応クリアしてくれるのだろう…。

これで、何の処理もしなければ、少なくとも数秒待たされる状態は回避できると分かった。つまり、PythonでWindows用スクリーンセーバを作る際は、以下のどちらかを選ぶことになるのかなと…。

• プレビュー画面モードは何もしないですぐに終了させる。真っ黒画面が表示されてしまうけど、その代わりすぐに操作できるようになるので…。まあ、勘弁してほしい。
• 一応プレビュー画面モードで何か描画する。数秒待たされてしまうけれど、その代わりそれっぽいプレビュー画面が表示されるので…。まあ、勘弁してほしい。

まあ、そんな感じっぽいということで…。勘弁してほしい。

プレビュー画面モードの動作だけが問題なのだから、そこだけラッパーを作って任せてしまう手もあるかもしれない。自分も以前そういうのを書いた。

_mieki256/scrsavwr: Screensaver wrapper on Windows

このラッパー、「フルスクリーン表示をするプログラムさえ作ればなんでもスクリーンセーバにできる」と書いてあるけど、ちょっと記述が抜けてるな…。正確には…。

• 多重起動を禁止する処理が入っていて、
• フルスクリーン表示をして、
• キーボードやマウスの操作で終了する、

そういうプログラムさえ作ればなんでもスクリーンセーバにできるはず。

それはそうと、このラッパーはHSP(というプログラミング言語)で作ったので、ウイルスとして誤判定されがちで…。誰かもっとちゃんとしたヤツを C/C++/C# あたりで書いてくれないものかなあ、と…。せっかくだから、一々 .iniファイルを編集したりせず、設定ダイアログ上で呼び出すプログラムや画像等を指定できたら楽になるかもしれない…。

前述のスクリプト、pywinsc0.py は、「python pywinsc0.py /p HWND」という形で呼ばないと動作確認できない。でも、ウインドウハンドル(HWND)なんてどうやって入手したらええんや…。

そこで、ウインドウを新規に作成して、そのウインドウハンドルを渡すテストスクリプトも書いて実験していた。一応載せておく。

_test_preview.py

"""
pywin32でウインドウを作成して、
ウインドウハンドル(HWND)を子スクリプトに渡す。

Windows11 x64 25H2 + Python 3.10.10 64bit
"""

import win32gui
import win32con
import win32api
import subprocess
import sys
import os

# 起動対象となる子プロセスのスクリプト名
CHILD_PY = "pywinsc0.py"
# CHILD_PY = "pywinsc0.exe"

WINDOW_CLASSNAME = "MyPythonWindowClassSample"


def wnd_proc(hwnd, msg, wparam, lparam):
    if msg == win32con.WM_DESTROY:
        print("[Parent] WM_DESTROY 受信。Quit を送信。")
        win32gui.PostQuitMessage(0)
        return 0

    return win32gui.DefWindowProc(hwnd, msg, wparam, lparam)


def create_window_and_launch_child():
    window_class_name = WINDOW_CLASSNAME

    wc = win32gui.WNDCLASS()
    wc.lpfnWndProc = wnd_proc
    wc.lpszClassName = window_class_name
    wc.hInstance = win32api.GetModuleHandle(None)

    # 背景色を設定
    bgcolor = win32gui.CreateSolidBrush(win32api.RGB(0, 128, 0))
    wc.hbrBackground = bgcolor

    try:
        win32gui.RegisterClass(wc)
    except win32gui.error as e:
        # 同じクラス名が登録済み(Error code = 1410)は無視
        if e.winerror != 1410:
            raise

    hwnd = win32gui.CreateWindowEx(
        0,
        window_class_name,
        "Parent Window",
        win32con.WS_OVERLAPPEDWINDOW,  # 一般的なウィンドウ形式（最小化・最大化・枠あり）
        win32con.CW_USEDEFAULT,  # 表示位置 X（OSにお任せ）
        win32con.CW_USEDEFAULT,  # 表示位置 Y（OSにお任せ）
        640,  # ウィンドウ幅
        480,  # ウィンドウ高さ
        0,  # 親ウィンドウのハンドル（今回は自身が親なので0）
        0,  # メニューハンドル
        wc.hInstance,  # インスタンスハンドル
        None,  # 追加の作成パラメータ
    )

    if not hwnd:
        print("[Parent] Error: ウィンドウ作成に失敗。")
        return

    # 作成したウィンドウを表示状態にする
    win32gui.ShowWindow(hwnd, win32con.SW_SHOW)

    print(f"[Parent] ウインドウ生成。HWND: {hwnd}")

    # 子プロセス起動
    try:
        # 引数として「/p HWND」を渡す
        print(f"[Parent] {CHILD_PY} を起動...")

        _, ext = os.path.splitext(CHILD_PY)
        if ext == ".py" or ext == ".pyw":
            # 起動中のPython実行環境 (sys.executable) を使って子スクリプトを実行
            subprocess.Popen([sys.executable, CHILD_PY, "/p", str(hwnd)])
        else:
            # .exe等を実行
            subprocess.Popen([CHILD_PY, "/p", str(hwnd)])

    except Exception as e:
        print(f"[Parent] 子プロセス起動に失敗: {e}")

    # 初回描画を強制的に促す(メッセージキューにWM_PAINTを入れる)
    win32gui.InvalidateRect(hwnd, None, True)

    # キューを待たずに、今すぐ描画を反映
    win32gui.UpdateWindow(hwnd)

    # メッセージループ開始
    # これを実行しないとウィンドウが「応答なし」になり、すぐにプログラムが終了してしまう。
    # Windowsから送られてくる「再描画」「移動」等のメッセージを常に待ち受け wnd_procに振り分ける。
    print("[Parent] メッセージループ開始。")
    win32gui.PumpMessages()

    print("[Parent] プロセス終了。")


def main():
    create_window_and_launch_child()


if __name__ == "__main__":
    main()

実行の仕方は以下。ウインドウを作成したら、そのウインドウハンドルを pywinsc0.py に渡して呼び出してくれる。

python test_preview.py

このスクリプトを使って動作確認する分には、期待通りに瞬時に青い塗り潰し画面が出てくるのだよなあ…。しかし、「スクリーンセーバーの変更」から起動させると期待した結果にならない…。どういう制限があるんだろう…。

本当にサポートされているのか動作確認してみた。

自分も昔、tkinter で作ったウインドウ内のフレームに pygameのウインドウを埋め込めるか試していたので、そのスクリプトをそのまま使って確認した。環境は、Windows10 x64 22H2 + Python 3.10.10 + tkinter + pygame-ce 2.5.6。

_mieki256's diary - tkinterの中にpygameを埋め込む

ググった感じでは、SDL_WINDOWID の動作確認用サンプルスクリプトとして、tkinter で作ったウインドウ内に pygame のウインドウを埋め込む形が多いっぽい。おそらく以下の理由があるのだろう。

• tkinter なら作成したフレームその他のウインドウハンドルを取得することが容易にできるので都合がいい。
• この機能の利用事例としては、複雑なUIをGUI用ライブラリで構築しておいて、動作結果を pygame で表示することが想定されているのだろう。

さておき。実行した結果は以下。


pygame-ce 2.5.6 でも、SDL_WINDOWID が機能している。tkinter で作成されたウインドウの位置を動かしても追従してくるので、tkinter のフレームの子ウインドウとして pygame ウインドウが作成されているのだろう。たぶん。

一見サポートしてるように見えるけれど、こうして埋め込んだ pygame のウインドウにはキーボードイベントを取得できない等の不具合も残っているらしい。

_Support `SDL_WINDOWID` by yunline - Pull Request #1953 - pygame-community/pygame-ce

マウスイベントやウインドウイベントは取得できるけど、キーボードイベントは取得できないと報告されているように見える。ただ、2行ほどスクリプトに追加したら問題解決したとも報告されているようで…。

でもまあ、これで pygame 1.9.6 の頃と同じように動かせるのはありがたい。例えば Windowsのスクリーンセーバのように、ウインドウハンドルを渡されてそこに描画しろと言われても pygame だけで対応できる。かなり助かる…はず。

これで、「SDL_WINDOWID は pygame 1.9.6 + Python 3.8 までしか使えない」なんて注意書きを一々残さなくても済むようになった。現行版の python + pygame でも SDL_WINDOWID は使える。ありがたや。

_Support `SDL_WINDOWID` by yunline - Pull Request #1953 - pygame-community/pygame-ce
_Support SDL_WINDOWID - Issue #1943 - pygame-community/pygame-ce
_Add "from_existing_window" function to the _sdl2.Window by yunline - Pull Request #1837 - pygame-community/pygame-ce
_Using 'SDL_WINDOWID' does not embed pygame display correctly into another application (1574) - Issue #887 - pygame-community/pygame-ce
_Issue with running pygame2.0 in Sugar desktop (3696) - Issue #1820 - pygame-community/pygame-ce
_Add `hwnd` parameter to display.set_mode() by yunline - Pull Request #1957 - pygame-community/pygame-ce
_Using 'SDL_WINDOWID' does not embed pygame display correctly into another application - Issue #1574 - pygame/pygame
_"SDL_CreateWindowFrom" in "display" module by Rabbid76 - Pull Request #2981 - pygame/pygame
_class method "from_foreign_window" added to class "Window" by Rabbid76 - Pull Request #2982 - pygame/pygame

_python - tkinter and pygame do not want to work in one window - Stack Overflow
_python - Embedding a Pygame window into a Tkinter or WxPython frame - Stack Overflow
_python - Draw a circle in Pygame using Tkinter - Stack Overflow
_python - interrupting embedded pygame in tkinter skips KEYUP events and thinks the key is still pressed - Stack Overflow
_python - I'm embedding a pygame window into Tkinter, how do I manipulate the pygame window? - Stack Overflow
_python - Tkinter embed Graphical subprocess - Stack Overflow
_Python 3 - Tkinter メインウィンドウを表示する

_「怒りのピークは6秒ルール」は本当なのか?|もとやま
_｢6秒間我慢しても逆効果｣自衛隊メンタル教官が教える怒りを一瞬で消す"最も効果的な方法" 修行を積んだ僧侶でも怒りをコントロールすることは難しい | PRESIDENT Online(プレジデントオンライン)

科学的根拠はないらしい…。もっと有効な手がある、という話もあるようで…。

VisualStudio 2022 でビルドをすると、Debug、Release、どちらでも、.pdbファイルが作られる。

pdbファイルって何なの？ どうやらデバッグ用の情報が入ってるファイルらしい…。それ、Release時は要らんのでは…？ Debug時はともかく、Release時は作らないようにしたい。

以下のページで設定の仕方が紹介されてた。ありがたや。

_VisualStudio2022でReleaseビルドするときにpdbファイルを出力しないようにする VisualStudio - Qiita

1. プロジェクト → xxxxのプロパティ、を選択。プロジェクトのプロパティタブ？が開く。
2. ビルド → 全般 → デバッグシンボル、が見えるようにする。
3. デバッグシンボル、と書かれてる左端のあたりにカーソルを合わせると歯車っぽいアイコンが表示される。そこにカーソルを合わせないと出てこないのでちょっと面倒。
4. 歯車アイコンをクリックするとメニューが出てくる。デフォルトでは「すべての構成で同じ値を使用する」が選ばれてしまっているので、「Configuration ずつ値を変化させる」を選ぶ。
5. DebugとReleaseで別々の設定ができるようになる。Debugは「プラットフォーム間で移植可能なPDBファイル」を選んで、Releaseは「生成済みのシンボルはありません」を選ぶ。

キャプチャ画像も撮ってみた。

VisualStudio 2022 上でC#を使って作ったアプリを他のPCに持っていける状態にしたい。「発行」という作業が必要らしい。

その際、.exeファイルとは別に .dll 等も作られてしまうのだけど、できれば .exeファイル1つにしたい。

以下のページで設定方法がなんとなく分かってきた。

_Visual Studioで単体で動作するexeファイルの作成方法 | teratail
_アプリケーション配置用に単一ファイルを作成する - .NET | Microsoft Learn

1. ソリューションエクスプローラで、アプリ名？のあたりを右クリック。
2. 右クリックメニュー内の「発行」を選択。
3. 発行作業用のタブが開く。
4. 「その他のアクション」をクリックして「編集」を選ぶ。
5. 「プロファイル設定」ウインドウが表示される。
6. 「ターゲットランタイム」を「win-x86」か「win-x64」にする。「ファイルの公開オプション」という項目が増える。
7. 「ファイルの公開オプション」をクリックして、項目を展開(?)する。
8. 「単一ファイルの作成」にチェックを入れて、「保存」をクリック。
9. 発行タブに戻ってくるので「発行」をクリック。

これで、Releaseフォルダの下のほうの階層に publish というフォルダが作成されて、その中に生成物が入った。

また、プロファイル設定ウインドウの「配置モード」で以下を設定。

• 「フレームワーク依存」にすると、ファイルサイズが小さい .exeファイルが生成された。
• 「自己完結」にしたら、ファイルサイズが結構大きい.exeファイルが生成された。

どのPCに持っていっても動きそうなのは後者なのではないかなあ…。たぶん。

キャプチャ画像も撮ってみた。

Windows上で C# を使ってアプリを作成する際には、.NET Framework か .NET (旧 .NET Core) を使わないといけないっぽいのだけど、どちらでアプリを作ったらいいのかで悩んでしまった。

以下、ググったり、AIに尋ねたりして把握した内容なので間違ってるかもしれんけど…。

• Windows11 には、デフォルトで .NET Framework 4.8.1 がインストール済。
• Windows10 は、別途 .NET Framework 4.8 のインストールが必要。
• Windows10/11 は、別途 .NET 8/9 のインストールが必要。

ただ、Windows10 はもうサポートが終了しているので、これからアプリを作成するなら Windows10 は無視して、Windwos11 だけを対象にしてしまってもいいのかなと…。そうなると、Windows11 に最初からプリインストールされている .NET Framework 4.8/4.8.1 を使えばすんなり動いてくれるのだろうか…？

ところが…。

• .NET Framework は、もうメンテナンスしかしない、これからは .NET を使ってくれと Microsoft はアピールしている。
• 更に .NET 8/9 は「自己完結」なる指定をしてビルドすると、ランタイムが同梱された .exe を生成できるっぽい。おそらく .NET 8/9 がインストールされていない環境でも動くのではないか。

ということで…。

• サポートが終了している Windows10 は無視して、Windows11 だけを対象にする。Windows11 にプリインストールされている .NET Framework 4.8 を利用することを前提にしてC#アプリを作成する。
• Micosoft のオススメに従って .NET 8/9 を使いつつ、自己完結型の指定をしてランタイムを同梱した .exe を生成して配布する。

一体どれを使えばいいのか…。

考えてみたら、250枚も使い切るには何年かかることやら…。自分や妹は文書の類をPCかスマホで見るのが当たり前で、両親に何かを見せたい時だけ印刷しているから、稀に紙を消費する感じで…。もしかすると、もっと枚数が少ない商品を選んだほうが良かったのかもしれない。

店頭にこの手の商品種類がほとんどないのもそういうことかな…。若い人達はその手の情報をスマホもしくはタブレットで閲覧して済ませるから滅多に印刷しないだろうし。家庭内で印刷する機会って、昔に比べたらかなり減ったよな…。いや、そもそも昔は印刷機自体が無かったわ…。年賀状のためにプリントゴッコを買って使ってた記憶が…。

フルスクリーン表示をするプログラム(.exe や .pyw等)は以下の条件を満たしていないといけない。

• 多重起動禁止処理が入っていること。
• フルスクリーン表示をすること。
• キーボードやマウスに反応して終了すること。

Python + pygame でWindows用のスクリーンセーバを作成してみたものの、Nuitkaでexe化する際の仕組みの関係か、プレビュー画面モード時の表示が遅過ぎて、これはラッパーの類を通したほうがいいのかな、せっかくだから昔作ったラッパーをパワーアップしつつ、C#の勉強も兼ねて作ってみようかと思った次第。

ただ、出来上がったファイルのサイズが大き過ぎる…。100MBを越えてる…。.NET9のランタイムが同梱されているからだけど…。大き過ぎて、github にアップロード(プッシュ)しようとしたら「ファイルサイズが100MBを越えてるからプッシュに失敗した」と表示されて…。

もっと小さいサイズで作れないものか。そのためには別の言語を使うしかないのだろうけど。

スクリーンセーバのラッパーと分かりそうなアイコン画像ってどういうものを作ったらいいのか…。

Google Gemini に、どういうモチーフで作ったらええんやろと相談してみたら、「モニターを箱で囲んでみるとか、ギフトボックスにモニター入れてみるとかどうよ？ 要は包む何かなわけだから」と言ってきた。なるほど…。ついでに画像生成もお願いしてみたら、アイコン画像とは程遠いリッチな画像ばかり出てきた。違うんだよなあ…。

結局 Inkscape でテキトーに作ってみたけど、なんというか、ショボい…。しかもラッパーの類とは分からない気がする…。

コントロールの Anchor プロパティを指定すればできる。

デフォルトでは、top, left が指定されているけれど、top, left, right を指定すれば、親のフォームの幅が変わった時に追従してコントロールの横幅が伸びてくれる。

top, left, bottom を指定すれば縦幅が追従してくれる。

また、left, bottom を指定すれば、フォームの左下のほうを基準にして位置決めができる。

right, bottom を指定すれば、フォームの右下のほうを基準にして位置決めができる。

表を使ったようなレイアウトをしたい。TableLayoutPanel を使えばできる。

_TableLayoutPanelコントロールを使って、コントロールを表形式で整列させる - .NET Tips (VB.NET,C#...)

Delphi は本来有償製品だけど、昔と違って今現在は無償で利用できる版(Delphi Community Edition)があるらしい。個人利用ならOKらしいので、利用させてもらおう…。

公式サイトからインストーラを入手。入手するにはユーザ登録が必要。自分は昔登録してたのでメールアドレスとパスワードの入力だけで済んだ。

_Delphi Community Edition - エンバカデロ・テクノロジーズ

「Community Editionを無料ダウンロード」と書いてあるリンクをクリックすると入手できる。今回は RADStudio_12_1_esd_61_7529b.exe を入手できた。

実行するとインストーラが起動する。「オプション」を選べばインストール場所を変更できる。デフォルトでは C:\Program Files (x86)\Embarcadero\ にインストールされる。今回は D:\Program Files (x86)\Embarcadero\ にしてみた。

以下で流れが説明されてる。

_『Delphi』をインストールする - 『Delphi』入門 - アトリエ・トリガ 新館
_Delphi 10.4.2 Community Editionをインストール #インストール - Qiita
_[Delphi] - Windows Software Development Kitのインストール|code-224

何をインストールするか選択する画面では、Samples と Help にチェックを入れておいたほうがいいらしい…？

途中でシリアルナンバーの入力を求められる。インストーラをダウンロードする際に登録したメールアドレス宛てに、メール経由でシリアルナンバーが送られてきているのでそれを入力。

また、Windows Software Development Kit なるもののインストールも要求される。

途中でインストーラがフリーズしたかのような状態になったけど、数分待っていたら先に進んでくれた。

インストール後の使用容量は 7.39GBほど。

「Delphiへようこそ」という画面が表示されたけれど、「パッチが利用可能です」と表示されていた。

クリックしたらコマンドプロンプトが開いて、パッチのダウンロードとインストールが始まった。

しかし…。このパッチ、問答無用で C:\Users\(USERNAME)\Documents\Embarcadero\ 以下に 454MB ほどのファイルをダウンロードしてからインストールされた。そこには入れるなや…。ドキュメントフォルダは OneDrive関係で面倒臭いから今後極力使わない/何も入れないつもりで考えてたのに…。これって消しちゃってもいいのだろうか。消したらマズいのだろうか。困るなあ…。

ちなみに、C:\Users\Public\Documents\Embarcadero\ 以下にも色々入っていて、980MBほど入ってた。そっちは OneDrive が握ろうとしないからどうでもいい。

とりあえず、「Windows VCL アプリケーション - Delphi」とやらを選んでプロジェクトを新規作成して、フォームの上にラベル(TLabel)やボタン(TButton)を配置して、実行(F9キー、もしくは再生ボタンっぽいアイコンをクリック)してみた。すんなりウインドウが表示された。

生成された .exe は 4MBほどだった。圧倒的に小さい…！ C# で作ると 100MB を超えるのに…！ このファイルサイズは魅力的…。

色々試してたら、エディタの動作が妙なことに気づいた。いわゆるフリーカーソルが有効になった状態で…。行末で右キーを押したら次の行の行頭にくるものじゃないのか…。なんでどこまでもカーソルが右に行くのか…。

ググってみたら、これが Delphi だか RAD Studio の売りらしい…。いや、これは不便やろ…。なんでも仮想空間がどうとからしいけど…。

個人的に、この動作は拷問レベル。どうにかできんのか…。

オプションで動作を変えられないかと Google Gemini に尋ねてみたけれど、何度やり取りしても存在しないオプション項目を提示してくる。お前一体何のツールと勘違いしてるんや…。

結局、以下を参考にして、CnPack なるプラグインを入れて対処してみた。

_Delphi 10.2 Community Edition で コードエディタの仮想空間キャレットを無効にする - フリーカーソルの無効化 - Delphi プログラミング | iPentec
_Delphi 10.2 Community Edition に CnPackをインストールする - Delphi プログラミング | iPentec
_CnPack Open Source Projects - Home Page
_CnPack の紹介 | PDF

CnWizards_1.7.1.1311_Nightly.exe を入手して実行。今回は D:\Program Files (x86)\CnPack\ にインストールした。

インストール後に Delphi (RAD Studio) を起動すると、メニューに CnPack という項目が増えていた。

CnPack → Options を選んで、一旦全部の項目を無効にした。項目を選んで、右側の「Enabled」のチェックを外す。

その後、検索欄で「editor」と打って「Editor Enhancements」がリストアップされたら、その項目だけを有効化。

Settingsボタンをクリック → Others、と辿って、以下のチェックを入れた。

• Keep Cursor Before End of Line.
• Wrap Cursor when Press Left at Line Head.
• Wrap Cursor when Press Right at Line End.

以下のような意味だろう…。

• カーソルを行末前に保持。
• 行頭で左を押すとカーソルを折り返す。
• 行末で右を押すとカーソルを折り返す。

これでたしかにフリーカーソルが無効化できた。

と思ったけど、自動インデントがおかしくなる…。もしかすると Delphi (RAD Studio) はフリーカーソルが有効な状態であることを前提にして自動インデントをしているのでは…？

フリーカーソル無効を取るか、自動インデントを取るか。どうしたものか。

Delphi もC#と同様に、サイズが可変する配列っぽい TList<T> なるものがあるようで助かった。

さておき、TList<T> を含んだクラスをJSONにして保存して、そのJSONを読み込んでクラスにしようとしたのだけど…。

AIに尋ねたら REST.Json だの TJson.JsonToObject<T> だのを薦められて、それを使って処理できないかと数時間ほど試してたのだけど…。構造体に相当するのであろう record だの、可変配列っぽい TList<T> だのを復元できなくてエラーが発生してしまって解決できなくて…。

TJsonSerializer を使ったらあっさり復元できた…。System.JSON.Serializers が必要。System.JSON.Types もあるといい。読みやすいJSONに変換してくれる。uses のあたりに、以下のように書いた。

uses
  System.SysUtils,
  System.IOUtils,
  System.Generics.Collections,
  System.JSON.Serializers,
  System.JSON.Types;

TContainer というクラスの内容をJSON化してファイルに保存する例。

procedure SaveContainerToFile(const FileName: string; Container: TContainer);
var
  SL: TJsonSerializer;
  json: string;

begin
  SL := TJsonSerializer.Create;
  SL.Formatting := TJsonFormatting.Indented;

  try
    json := SL.Serialize(Container);
    TFile.WriteAllText(FileName, json, TEncoding.UTF8);
  finally
    SL.Free;
  end;
end;

SL.Formatting := TJsonFormatting.Indented; を指定すると人間でも読みやすいJSONにしてくれる。


JSONファイルを読み込んで TContainer というクラスに内容を反映する例。

function LoadContainerFromFile(const FileName: string): TContainer;
var
  SL: TJsonSerializer;
  json: string;

begin
  json := TFile.ReadAllText(FileName, TEncoding.UTF8);
  SL := TJsonSerializer.Create;
  try
    Result := SL.Deserialize<TContainer>(json);
  finally
    SL.Free;
  end;
end;

Delphiを使って、まずはスクリーンセーバを作れないものかと試している。

フルスクリーン表示用フォーム、設定画面モード用フォーム、プレビュー画面モード用フォームの3つのフォームを作って、与えられたコマンドライン引数に応じてどれかしらのフォームを表示するようにしてみたい。

フォームの追加は、ファイル → 新規作成 → VCLフォーム - Delphi、を選べばできる模様。たぶん。

ただ、プロジェクトを新規作成した際に用意されているフォームを表示してしまうその前に、コマンドライン引数を解析しないといけない。どうすれば…。

プロジェクト → ソースの表示、を選ぶか、もしくは右側のプロジェクト名が表示されてるところを右クリックしてソースの表示を選べば、一番最初に呼ばれる処理が書かれてるソースが表示できると分かった。拡張子は .dpr。.pasじゃないんだ…。このファイルが、C# で言うところの Program.cs に相当するのではないか。たぶん。

中身は以下のような感じだった。

program HelloWorldDelphi;

uses
  Vcl.Forms,
  HelloWorldVCL1 in 'HelloWorldVCL1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Application.CreateForm(TForm1, Form1); でフォームを生成して、Application.Run; でイベント待ちのループになるのかな…。たぶん。

ということは、Application.CreateForm(TForm1, Form1); を呼ぶ前に引数の解析処理をして、そこからどのフォームを生成するか決めればいいのではないか…。

試してみたら期待した動作になった。引数の与え方で、3つのフォームを呼び分けることができた。

コマンドライン引数の数や文字列は、ParamCount、ParamStr(n) で取得できる。ParamStr(0) に .exe名が入っていて、引数は ParamStr(1)、ParamStr(2)、ParamStr(3) 等に入ってる。

Delphi はDelphi言語なるプログラミング言語らしいけど、元々はPascalという言語らしくて…。初めて触ってるけれど、今まで触ってきた言語とはなんだかちょっと違うなと…。

細かいことだけど、変数への代入が「=」じゃなくて「:=」なので地味にツラい。ついつい「=」と打ってしまう。数学的には「:=」と記述するほうが正しいのかもしれないけれど…。

_変数を使う
_代入あれこれ

たしかに、比較演算子で「==」と書くべきところを「=」と書いてしまってバグを入れてしまうミスは避けられるか…。その代わり、フツーの言語なら「=」の1文字で済むのに、わざわざ「:=」の2文字を打たないといけない。打鍵数が増える…。

変数を確保、というか宣言する際に、最初のあたりに書かないといけないのも面倒。欲しくなったらその場で確保させてくれよ…。ループを回すだけの変数すらあらかじめ用意しないといけないのはシンドイ…。

begin と end が多過ぎてゲンナリする…。お前は Ruby か！ この begin-end 野郎！(意味不明)。いや、Ruby で多過ぎと言われてるのは end だけだったような…？ 始まりと終わりを示すだけなら () でも {} でも [] でもええやん…。でも記号を多用するとそれが何を意味してるのか分かりづらくなるデメリットもあるのかな。Perlになっちゃう…。

文字列は '' で記述しないとダメっぽい。"" に慣れてるので、つい "" を打って怒られる…。

そんな感じであちこちしっくりこないけど、その代わり(?)、コンパイルは爆速。サクサクと動作確認できる。この速さは素晴らしい。

これは Pascal云々ではなくて Delphi の長所だろうけど、生成される .exe も数MBと小さい。C# で作ったアプリは100MB以上になるので、ファイルサイズの桁が違う…。

アイコン画像は、Inkscape で作成して png としてエクスポートして、Greenfish Icon Editor Pro Portable で開いてアイコン化した。

_Greenfish Icon Editor Pro 4.5 - Official Website
_Greenfish Icon Editor Pro Portable | PortableApps.com
_「Greenfish Icon Editor Pro」多機能なアイコン・カーソル作成ソフト - 窓の杜

自分、PortableApps版を使っていたものと思い込んでいたけれど、公式の Portable版(.zip版)を使ってたっぽい。zipを解凍して gfie.exe を実行すれば起動する。

Settings → Language...、を選べば日本語化できる。

ウインドウに png画像をドラッグアンドドロップすれば画像を開ける。アイコン → イメージからWindows用のアイコンを作成、を選べばアイコンが生成できる。

{$R 'myresources.res' 'myresources.rc'}

STRINGTABLE PRELOAD DISCARDABLE
BEGIN
 1 "スクリーンセーバ名"
END

.rc に書いたテキストはどういう意味を持つのか少し調べた。

STRINGTABLE は文字列テーブルがここから書かれているよ、という記述だろうし、BEGIN - END は、ここからここまでが文字列テーブルだよ、という記述だろう。しかし、1 は何…？

_第128章 スクリーンセーバー その2
_winsdk-10/Include/10.0.16299.0/um/ScrnSave.h at master - tpn/winsdk-10
_リソースの作成 (mixi 日記アーカイブ)
_mieki256's diary - Windows用スクリーンセーバの作り方をまだもうちょっと調べてる

C/C++でスクリーンセーバを書く場合も .rcファイルにスクリーンセーバ名を書いておくのだけど、scrnsave.h の中で定義されている IDS_DESCRIPTION で指定された文字列がスクリーンセーバ名を示す、ということになっているらしい。ScrnSave.h のコメントで以下が書かれてる。

This string should contain a less than 25 char name/description of the screen saver.
This string is what will be seen by the user in the Control Panel's Desktop applet screen saver listbox.

この文字列には、スクリーンセーバーの名前/説明（25文字未満）を含める必要があります。
この文字列は、コントロールパネルのデスクトップアプレットのスクリーンセーバーリストボックスに表示されます。

そして、IDS_DESCRIPTION は以下の数値が定義されている。

#define IDS_DESCRIPTION      1

つまり、Delphi でスクリーンセーバを作る時も、.rc の中でIDが1になってる文字列を指定しておけば、それがスクリーンセーバ名として反映される、ということだろう…。

ただ、idsAppName という定義もあるようで…。そちらを指定するとスクリーンセーバ名になると解説してるページも見かけた…。

AIに尋ねてみたら以下の返答を出してきた。

`scrnsave.h` を使用してスクリーンセーバーを開発する場合、
`IDS_DESCRIPTION` と `idsAppName` はどちらも文字列リソースですが、
その役割と「誰が参照するか」が明確に異なります。

結論から言うと、`IDS_DESCRIPTION` は「外向き（設定画面用）」、
`idsAppName` は「内向き（プログラムの管理用）」の名前です。

レジストリキー名、ウインドウクラス名、エラーメッセージタイトル等で使われるのが idsAppName。とAIが言っている。

よく分からんけどスクリーンセーバ名を指定したいだけなら、IDS_DESCRIPTION (=1) だけを指定しておけばいいのかもしれない。

Fotografixという画像編集ソフトがあるっぽい。レイヤー機能付き。現行版は写真加工に特化して色んな機能が削除されてしまったらしいけど、1.x は画像編集機能があったそうで、Portable版は 1.5 Rev2 だから該当機能を持っている模様。

_Fotografix Portable | PortableApps.com

試用してみた。FotografixPortable_1.5_Rev_2.paf.exe を入手して実行して任意のフォルダにインストール。FotografixPortable.exe を実行すれば起動する。

圧倒的に起動が速い…。File → Choose Language で、lang_ja.ini を選べば日本語化もできる。

ただ、描画機能がほとんど無い…。マウスカーソルを素早く動かすとブラシが途切れ途切れになってしまうのもちょっと…。もっとも、昔のMicorosoftペイントにレイヤー機能がついた感じではあるので、状況によっては使えそうな気もする。

Windows版は開発中止になって、Linux上でのみ開発が続いている画像編集ソフト。開発停止になった AzPainter 1.36、AzPainter2 2.12 を試用してみた。

_Windows Software

これまた起動が圧倒的に速い…。描画機能も比較的充実してる。これでいいのではないかな…。

AzPainter2 は AzPainter 1.x より機能が増えているのかと思ったけど、そういうわけでもないっぽい。テキスト描画時に中央揃えをする機能が 2.x には無いことに気づいた。

Microsoftペイントも試用してみた。デスクトップの検索バーで mspaint と打てば「ペイント」が出てくる。バージョンは 11.2511.291.0 となっていた。

これも起動が速い。昔の版と違って色んな図形も描けるようになってる。これで済む場合も多そう。ただ、レイヤー機能は無い…と思ったけどちゃんとあるじゃん！ 知らなかった…。何時頃追加されたんだろう…。

描画される図形はアンチエリアスがかかってないのだな…。

_「ペイント」アプリになんとレイヤー機能、画像の透過にも対応へ - 窓の杜

2023年頃にはレイヤー機能が追加されてたのか…。

lazarus-4.4-fpc-3.2.2-win64.exe を入手して実行。今回は D:/Dev/Lazarus/ にインストールしてみた。1.74GBほどが入った。

デスクトップにショートカットファイルが作成されたので、ダブルクリックしたら起動した。

起動してみたけれど、たしかに Delphi っぽい…。

コントロール(ウィジェットと呼ばれたりもする)の名前は、Delphi と同じっぽい？ TLabel や TButton も用意されていた。

DelphiでVCLと呼ばれていたものは、LazarusではLCLと呼んでいるらしい。

Hello Worldと表示されるだけのGUIアプリを作成してみたら、出来上がった .exe は 24.3MBだった。Delphi で似たようなものを作ると 3.7MB。一桁違う…。さすが Delphi。Windowsに特化して作られてきたのは伊達じゃない、ということだろうか。

とは言え、Lazarus も Delphi と同様に、フォームにコントロールをペタペタ貼っていくだけでGUIアプリがサクサク作れてしまうあたり、実にイイ感じの開発環境に思える…。

何より、オープンソースなので安心。Delphi は本来有償製品だから、企業側の思惑次第で無償利用できる版が無くなって、利用者にとっては梯子を外されてしまう不安がずっとつきまとうけれど、Lazarusは最初から無償利用が可能なので、そういう面では安心して使えそう。

生成されたバイナリのサイズが大きいなと思っていたけれど、デバッグ用の情報(シンボル情報等)を含めているから大きくなっているだけと知った。以下の設定をすれば改善(?)できる。

プロジェクト → プロジェクトオプション → コンパイラオプション → デバッグ。上のほうにある「Build mode」の右端に「Edit build modes」というアイコンがあるのでクリックして、「Debug と Release のモードを作るか？」的な問いに答えれば、Debug と Release の2つのモードが作成される。

Release を利用してビルドしたら、生成されたバイナリのサイズが 2.6MB になった。これならDelphiとさほど違いはない…。素晴らしい。

Form resource TWindowForm not found.
For resourceless forms CreateNew constructor must be used.
See the global variable RequireDerivedFormResource.

フォームリソース TWindowForm が見つかりません。
リソースを持たないフォームでは、CreateNew コンストラクタを使用する必要があります。
グローバル変数 RequireDerivedFormResource を参照してください。

object Form1: TForm1
↓
object Form1: TWindowForm

end.

↓

initialization
  RegisterClass(TWindowForm);
end.

  RequireDerivedFormResource:=True;
  Application.Scaled:=True;

一々テキストエディタで編集しなくてもリネームできる方法が分かったのでメモしておく。

ソースコード上でリネーム作業をした後、リネームしたいコンポーネントのプロパティで Name を変更してやるだけで、自動で使用クラス名も変わってくれる模様。

Ubuntu Linux 22.04 LTS に Lazarus をインストールできないものか調べてた。

sudo apt install lazarus でインストールできそうなのだけど…。バージョンが 2.2 と古い感じで…。できれば現行版の 4.4 をインストールしたい。

_Lazarus - Browse /Lazarus Linux amd64 DEB/Lazarus 4.4 at SourceForge.net

上記ページから、公式版のセットアップファイルを入手できる。

Debian系Linux (Ubuntu LinuxもDebian系) 64bit版の場合、以下の3つのファイルをインストールする。かつ、インストールする順番もあるらしい。

fpc-laz_3.2.2-210709_amd64.deb
fpc-src_3.2.2-210709_amd64.deb
lazarus-project_4.4.0-0_amd64.deb

fpc-laz → fpc-src → lazarus-project の順番でインストールせよと書いてある。

何故か lazarus-project_4.4.0-0_amd64.deb のダウンロードで時間がかかったけれど、どうにか落ちてきた。apt を使ってインストール。

sudo apt install ./fpc-laz_3.2.2-210709_amd64.deb
sudo apt install ./fpc-src_3.2.2-210709_amd64.deb
sudo apt install ./lazarus-project_4.4.0-0_amd64.deb

自分は Xubuntu のデスクトップを使っているけれど、スタートメニュー(Applications Menu。xfce4-whiskermenu-plugin)の「開発」の中に Lazarus というショートカット？が入ってたので、無事インストールできたっぽい。クリックしてみたら起動してくれた。

使い勝手は Windows版と似たような感じ。Hello World と表示されているだけのアプリを試しに作成してみたけれど、フツーに Linux上で実行できるバイナリが作成された。ファイルサイズは 27MB ほど。

Lazarus 4.4 の初回起動時に、IDEのレイアウトについて classic を選んでしまった。classic だと、ツールバー(ツールボックス？)、コードエディタ、フォームデザイナー等がバラバラに表示されてしまう。昔の Delphi はそういうレイアウトだったらしいので、それを踏襲しているのだろうけど…。Delphi 12 のようにシングルウインドウにしたいなと…。

試していたら、以下の設定でそれっぽくなった。これで正しいのか分からんけど…。

• ツール → オプション → 環境。
• 「Docking / Anchordocking」で、「Enable docking of IDE Windows (Requires IDE restart)」 にチェックを入れる。
• 「Docked Form Editor」で、「Show the form-editor as (docked) tab in the editor window (Requires IDE restart)」にチェックを入れる。

これで Delphi 12 (RAD Studio) の見た目に近づいてくれた。

Lazarus はパッケージをインストールすることで機能追加できるらしい。

_Pascal 日和 ホームページ - Lazarus パッケージインストール1

以下のパッケージをインストールしてみた。パッケージ → パッケージをインストールもしくはアンインストール、を選択。

Cody 1.1
lazthread 0.0
messagecomposerpkg 0.0
multithreadprocslaz 1.2.1
lazdaemon 0.9.9
weblaz 1.0.1
LazActiveX 0.1

入れておいてなんだけど、何がどうなるパッケージなのか分かってない…。

Lazarus関係の情報をググって眺めていたら、CodeTyphon というものもあると知った。

_CodeTyphon Studio

Lazarusからforkした版で、昔のLazarusに足りてなかったアレコレを追加した状態で配布しているもの、らしい。

解説ページを眺めたら、Lazarus のディストリビューション、という呼び方をしていた。ディストリビューションとな…。おそらく Debian Linux に対する Ubuntu Linux とか、そういう感じの関係なのかなと…。

ただ、ライセンス面でどうも怪しいところがあって、オリジナル版のソース内の著作権表記やライセンスを勝手に書き換えて配布していたりもするそうで…。そういう理由から、「自分は絶対に使わない」と宣言？ 断言？ してる人も見かけた。

もっとも、Lazarus のバージョンが上がって色々機能が追加されたことで、CodeTyphon が持っていた利便性が Lazarus にも実装されたりして、どっちを使ってもいいよ、どっちでもやりたいことはできるよ、と発言してる人も見かけた。まあ、Linuxもそうだけど、ディストリビューションってそういうものだよな…。

Lazarus というワードでググっていたら、北朝鮮のハッカーグループも Lazarus と呼ばれていると知った。

_社用PCで転職用の課題に取り組んだら実は北朝鮮ハッカー集団「Lazarus」による攻撃で会社全体が被害に遭う事態に - GIGAZINE


他に、日本のアニメでも同名の作品があるらしい。

_LAZARUS ラザロ - Wikipedia

これはググって情報に辿り着くのがちょっと難しくなってきた…。名前衝突は困る…。

犬の散歩中、車が来てないか後ろを振り返ったりするのがツラい。右足を痛めているので…。袖口につけてバックミラーとして利用できないかと購入。アメリカの宇宙飛行士は手首のあたりに鏡をつけて周囲を確認しているらしいので、真似できないものかと…。

小さ過ぎたかもしれない。もっと大きいほうが良かったか。でも重くなりそうだし…。本当はスマホの裏側に貼れるミラーが欲しかったのだけど。それなら工作も楽にできるだろうし。

犬の散歩中に使ってみたけれど、全然ダメだった。

歩くと体が揺れる。腕の先も揺れる。腕の先についてるミラーも揺れる。揺れているミラーでは何が映ってるのかさっぱり分からない…。ならばと足を一旦止めてみたけれど、ミラーが細過ぎて角度を調整するのに時間がかかる。これならその場でゆっくりと旋回して後ろを振り向いたほうが確実…。

宇宙飛行士がこういうやり方で上手く行ってるのは無重力空間で作業してるから、なのかもしれないなあ…。宇宙空間なら体は揺れないもんな…。

Delphi 12 IDE (RAD Studio) を起動して、ツール → GetItパッケージマネージャを起動。「mmx」で検索するとリストアップされる。インストールボタンをクリックしたらインストールされた。16.0.10.107 が入った。

公式サイトからセットアップファイルを入手できるようでもある。バージョンは、Delphi 12 CE の GetIt から入手できる版と同じに見える。

ソースエディタ上で右クリックするとメニューの中に MMX云々という項目があるので、それを選べば色々な機能が利用できるっぽい。

とりあえず、変数名等をRenameする機能は動いてくれた。これだけでもかなりありがたい…。

以下のソースを扱うと、Delphi 12 のリファクタリングでクラッシュするのだけど…。

_DrawCubeBoxUnit.pas
_DrawCubeBoxUnit.dfm
_DrawCanvasTest1.dpr

どうしてコレでクラッシュするのか…。分からん…。

ちなみに、以下のような画面が出てくるプログラム。

• フォームの Canvas に線を引くことができるかどうか。
• TTimer を使って約60FPS前後でアニメーションさせられるかどうか。

この2点について実験していた。

Lazarus 4.4 で作業中に、record の中にプロシージャ(procedure、手続き処理)だかメソッドだかを含めることができなくて悩んだ。

  TObj = record
    x, y: double;
    dx, dy: double;
    procedure Move(const AreaW, AreaH: integer; const dt: double);  // ここがエラーになる
  end;

こういうことをしたい場合、Lazarus ではオプション指定が必要らしい。ソースの最初のあたりに以下を記述しないと、record の中にプロシージャ(メソッド)を含めることはできないっぽい。

{$ModeSwitch advancedrecords}

他にも色んなオプションがある模様。

_modeswitch - Free Pascal wiki

Windowsのタイマー精度は、そのままだと 15.6 msec。結構荒い。マルチメディア用としてタイマー精度を1msにする、timeBeginPeriod()、timeEndPeriod() を使いたい。

uses のところに、MMSystem を追加する。

精度を上げたら、アプリの終了時には元の精度に戻さないといけないらしいが…。以前のWindowsでは、timeBeginPeriod() を使うとOS全体のタイマー精度が上がってしまうので後片付け？をしないとよろしくなかったらしいのだけど。今現在のWindowsはアプリ毎にタイマー精度を変更できるように改善されているという話をどこかで見かけた。それが本当なら後片付けをし忘れても問題無いのだろうか…？

でもまあ、とりあえず、フォームの Create で timeBeginPeriod(1); を呼んで、フォームの Destroy で timeEndPeriod(1); を呼ぶようにしている。これでいいのだろうか…？

HLS(色相、輝度、彩度)をRGBに変換する ColorHLSToRGB() を使いたい。

uses のところに、GraphUtil を追加する。

ColorHLSToRGB(色相, 輝度, 彩度) を指定する。TColor が返ってくる。各値は、0 - 240 か 0 - 255 を受け付けるっぽい？

ドキュメントには、引数が Word と書いてあって、Word は 0 - 65535 を取るらしいのだけど、実際に 0 - 65535 を指定してみると期待した結果にならなかった。

以下がソースっぽいけど…。これは 0 - 255 を与えるのだろうか…？

_Lazarus/lcl/graphutil.pp at master - ultibohub/Lazarus

以下のやり取りでは、0 - 255 を与えると書いてあるな…。

_HSL color

気になったものだけメモ。環境は Windows11 x64 25H2 + Lazarus 4.4。

• Ctrl + Alt + Shift + ↑ : 1行分を上に移動
• Ctrl + Alt + Shift + ↓ : 1行分を下に移動
• Ctrl + Alt + Num8 : 選択中の行を上に移動
• Ctrl + Alt + Num2 : 選択中の行を下に移動
• Alt + D : 現在行をカット
• Alt + Y : 現在行をコピー。直後に Ctrl + V を叩けば行複製っぽくなる。
• Ctrl + Alt + Shift + Ins : 現在行を複製
• Clrl + Alt + Num0 : 選択中の行を複製
• Ctrl + Shit + ↑、Ctrl + Shift + ↓ : 宣言部と実装部を行き来する
• Ctrl + D : ソースコード整形
• Ctrl + Space : 各種補完
• Ctrl + W : 単語補完
• Ctrl + Shift + C : 変数への代入文だけを書いて、その行でこれを叩くと、変数の宣言が自動で追加される。

補完関係は以下で紹介されている。

_Lazarus For Delphi Users - Lazarus wiki

1行分を上下に移動するキー割り当てと、選択中の行を上下に移動するキー割り当ては、同じものを使えるように実装できそうな気もするのだけどな…。行を選択中か否かで処理を分ければ済みそうな…。

フォームの上で線を引いたりして何かしらの図形を描画したい。

フォームは Canvas (TCanvas？) を持っているので、その Canvas を使えば図形が描けるのだとか。

• Canvas.MoveTo()、Canvas.LineTo() で線を引くことができる。
• Canvas.Polygon() で多角形を描画できる。
• Canvas.GradientFill() でグラデーション塗り潰しもできる。
• Canvas.Brush.Color で塗り潰し色を指定。
• Canvas.Pen.Color、Canvas.Pen.Width で、線の色や線幅を指定。

手元で実験してる感じでは、以下のような記述ができた。

  // 背景を黒で消去
  //Canvas.Brush.Color := clBlack;
  //Canvas.FillRect(ClientRect);

  // 背景をグラデーションで塗り潰し
  bgcol0 := ColorHLSToRGB(Round(FMod((FHue + 64), 255)), 32, 255);
  Canvas.GradientFill(ClientRect, bgcol0, clBlack, gdVertical);

  // 線を描画
  Canvas.Pen.Color := ColorHLSToRGB(Round(FHue), 128, 255);
  Canvas.Pen.Width := 1;
  for i := Low(FMyObj) to High(FMyObj) do
  begin
    if i = 0 then
      Canvas.MoveTo(Round(FMyObj[i].x), Round(FMyObj[i].y))
    else
      Canvas.LineTo(Round(FMyObj[i].x), Round(FMyObj[i].y));
  end;
  Canvas.LineTo(Round(FMyObj[0].x), Round(FMyObj[0].y));

フォームをフルスクリーン表示(全画面表示)にしたい。今のところ以下のように書いてるけれど、これでいいのかな…。

    BorderStyle := bsNone; // タイトルバー消去
    Left := 0; // 表示位置 x
    Top := 0; // 表示位置 y
    Width := Screen.Width; // フォーム横幅を画面解像度に合わせる
    Height := Screen.Height; // フォーム縦幅を画面解像度に合わせる
    FormStyle := fsStayOnTop; // 最前面表示
    Cursor := crNone; // フォーム上でマウスカーソル非表示

この場合、タイトルバーが無くなるから、閉じるボタンを押すことができなくなる。キーを押したり、マウスクリックをしたら、アプリを終了するように処理を入れておかないといけない。フォームのイベントで、OnClick や OnKeyDown が来たら、Application.Terminate; を呼ぶようにしておいた。

フォームの OnKeyDownイベント等で、キーの判定をしたい。VK_xxx という指定をするらしいけど…。VK_F11 とか VK_ESCAPE とかそんな感じ。

uses に LCLType を追加すれば使えるようになる。

_LCL Key Handling - Lazarus wiki
_virtual keyboard strokes/de - Free Pascal wiki

ただ、フォームの上にボタン等を置いてしまうと、フォーム側の OnKeyDownイベントでキーの押し下げを取得できなくなる…。プロパティの KeyPreview を True にしてやれば取得できるようになる。

F11キーを押したらフルスクリーン表示と通常表示が切り替わる処理を入れたい。

Lazarus 4.4 で作ったアプリなら、フォームの OnKeyDownイベント発生時に Key = VK_F11 の判定をすれば済んだのだけど、Delphi 12 で同じことをしてみたら、フォーム上のボタンをクリックした後は F11キーが効かなくなった。

この場合は ActionList(TActionList)を使ったほうが簡単で確実かもしれない…。ActionListを使うようにしてみたら、ボタンを押した後もF11キーが効いてくれた。

Delphi での ActionList の使い方は以下。

1. フォーム上に TActionList を貼り付け。
2. TActionList をダブルクリック。
3. ActionList の設定ダイアログが表示されるので、新規で Action を作成。
4. 作成した Action の、プロパティの ShortCut に使いたいキーを割り当て。
5. イベントの OnExecute をダブルクリックしてプロシージャを作成して、処理を記述する。

Lazarus でも Delphi と同様に ActionList を使ってみたら、F11キーが効いてくれた。

LazarusでOpenGLが使えるらしい。

_OpenGL Tutorial - Free Pascal wiki

とりあえず、上記ページの最初のサンプルだけでも動かしてみた。

1. 新規プロジェクト → アプリケーション、で作成。
2. プロジェクト → プロジェクトインスペクタ。
3. 追加ボタンをクリックして、「新規の要求」を選ぶ。
4. lazopenglcontext を選んで追加する。

これで、uses に、OpenGLContext と gl を記述できるようになった。また、サンプルでは、uses に FileUtil も記述されているので一応記述。

サンプルをコピペしてビルドしてみた。フツーに動いた。ウインドウ内にグラデーションがかかった三角形が描画されている。

以下のような記述でも、フルスクリーン表示と通常表示の切り替えができることを確認できた。

{ フルスクリーン表示と通常表示の切り替え }
procedure TForm1.SwitchFullscreen;
begin
  if BorderStyle <> bsNone then
  begin
    // フルスクリーン表示にする
    FOrigBounds := BoundsRect;
    BorderStyle := bsNone;
    WindowState := wsFullScreen;
    FormStyle := fsStayOnTop;
  end
  else
  begin
    // 通常表示にする
    BorderStyle := bsSizeable;
    WindowState := wsNormal;
    BoundsRect := FOrigBounds;
  end;

  if BorderStyle = bsNone then
    ButtonChgFullScr.Caption := 'Normal'
  else
    ButtonChgFullScr.Caption := 'Fullscreen';
end;

以下のページで色々な方法が紹介されてる。今回試したのは一番最初に紹介されてるやり方。

_Application full screen mode - Free Pascal wiki

• BorderStyle に bsNone を指定しないと、タスクバーまで隠した状態のフルスクリーン表示にならない。
• Delphi は WindowState に TWindowState.wsMaximized を指定するけれど、Lazarus の場合は wsFullScreen を指定できる。

まずはプロジェクトを新規作成。Windows VCL アプリケーション、を選んで新規作成する。

作成されたら、早々にプロジェクトを保存しておく。ファイル → プロジェクトに名前をつけて保存、を選ぶ。

• プロジェクト名は…「SSDelphiTest1」とでもしておこう…。「SS」は ScreenSaver の略。
• 最初に .pas を保存して、次に .dproj を保存するけれど、ここで SSDelphiTest1.dproj としておけばプロジェクト名にも反映される。

ちなみに、Delphi IDE には以下のショートカットキーが割り当てられている。

• Ctrl + S : 現在開いているソースコードを保存。
• Ctrl + Shift + S : プロジェクト全体を保存。

プロジェクトを新規作成した直後はフォームが1つ置かれてる状態になっている。このフォームを、フルスクリーン表示(全画面表示)用のフォームとして利用してしまおう…。

以下のような見た目のフォームを作っていく。



フルスクリーン表示をしてしまうとタイトルバーも消えるので、閉じるボタンが押せなくなる…。だから真っ先に、終了させるための処理を書いておく。

フォームを選択した状態で、オブジェクトインスペクタの「イベント」をクリックすると、利用できるイベントが一覧で表示されているので…。以下のイベント名の右側の入力欄(?)を順次ダブルクリックしていく。

• OnClick (マウスクリック)
• OnKeyDown (キーの押し下げ)
• OnMouseDown (マウスボタンクリック)

それぞれをダブルクリックすると、イベントが発生した時に呼ばれるプロシージャ(メソッドだのサブルーチンに相当)がソースコード内に自動で作成されるので、その中にアプリを終了させるための1行 ―― Application.Terminate; を記述する。

procedure TForm1.FormClick(Sender: TObject);
begin
  Application.Terminate;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift:
    TShiftState);
begin
  Application.Terminate;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState; X, Y: Integer);
begin
  Application.Terminate;
end;

この状態で F9キーを叩いて、ビルドと実行をしてみる。ウインドウ(フォーム)が1つ表示される。ウインドウをマウスクリックするか、何かのキーを押せば、終了できることが分かる。

実はこの終了のさせ方はよろしくないという話もあって…。動画再生ソフトの類が動いてたりすると、この方法では終了できなくなるとかなんとか…。

_Windows 令和のスクリーンセーバーの作り方 - Qiita

でもまあ、今回はとりあえずそれっぽく動けば、という方針で進めてしまおう…。


フォームのタイトルバーを消去する。プロパティの BorderStyle が bsSizeable になっているので、bsNone に変更。タイトルバーが消えてくれる。


フォームがデスクトップに表示された際、最前面表示になってほしい。FormStyle が fsNormal になっているので、fsStayOnTop に変更。


フォームの背景色を変えたい。Color を clBlack にすれば、真っ黒なフォームになる。


フォーム上に文字を表示したい。パレットから TLabel を選んでフォームに配置。パレットの検索欄で「label」と打ち込めば TLabel がリストアップされるので、フォーム上にドラッグアンドドロップしてやれば配置できる。好きな位置に配置。

この状態では TLabel の文字色が黒なので、背景色の黒と同じだから何が描かれてるのかわからない。TLable のプロパティの Font を変更して、文字色を白にする。ついでに、文字の種類や文字サイズも変更しておこう…。

表示する文字列は、TLabel のプロパティの Caption で指定できる。なんでもいいけど、「ScreenSaver by Delphi」とでも入力しておこう…。


この状態でF9キーを叩いて実行。タイトルバーの無いウインドウが表示された。クリックするかキーを押せば終了できる。


フルスクリーン表示にしたい。フォームが作成された直後に OnCreate イベントが発生するらしいので、そこでフルスクリーン表示になるように設定してしまおう。フォームを選択して、イベントで OnCreate をダブルクリック。以下のような1行を書く。

procedure TForm1.FormCreate(Sender: TObject);
begin
  WindowState := TWindowState.wsMaximized;
end;

Delphi でGUIアプリを作る際は、「BorderStyle が bsNone」の状態で、「WindowState に wsMaximized (最大化)」を指定すれば、Windowsのタスクバー部分も覆い隠す感じの全画面表示になってくれるらしい。

あるいは、以下のような記述もできる。

procedure TForm1.FormCreate(Sender: TObject);
begin
  Left := 0;
  Top := 0;
  Width := Screen.Width;
  Height := Screen.Height;
end;

• Left と Top がフォームの表示位置 x,y なので、(0, 0) にすれば表示位置をデスクトップ画面の左上にできる。
• Width と Height がフォームの横幅と縦幅なので、デスクトップ画面の横幅と縦幅 ―― Screen.Width と Screen.Height を指定すれば、デスクトップ画面と同じサイズのフォームになる。

ちなみに、この指定では、マルチディスプレイ環境上ではよろしくないらしい…。メインディスプレイ上だけでフルスクリーン表示になってしまうそうで…。自分はマルチディスプレイ環境を持ってないから確認のしようがないけれど。


一定時間毎に見た目がちょっと変化するようにしたい。とりあえず、ラベルの表示位置でも変えてみよう…。

TTimer を使えば、一定時間毎に何かしらの処理をさせられる。パレットから TTimer を選んで、フォーム上にドラッグアンドドロップして貼り付ける。貼り付ける位置はどこでもいい。

TTimer のプロパティの Interval で、呼び出す時間間隔を指定できる。単位はミリ秒。デフォルトでは 1000 が入っているので、1000ミリ秒 = 1秒毎に処理が呼ばれる。

TTimer のイベントで、OnTimer をダブルクリック。ここで自動作成されるプロシージャが、一定時間毎に呼び出される処理になる。今回は、ラベルの表示位置をランダムに変更する処理を入れてみる。

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Label1.Left := Random(ClientWidth - Label1.Width);
  Label1.Top := Random(ClientHeight - Label1.Height);
end;

• Random(N) で、0 - (N-1) までの乱数が生成される。
• ClientWidth, ClientHeight で、フォームのクライアント領域の横幅・縦幅が取得できる。
• Label1.Width, Label1.Height で、ラベルの横幅・縦幅を取得できる。

Random() を使うためにはランダムシードを設定しないといけない。フォームが Create された時に Randomize を呼んでおく。

procedure TForm1.FormCreate(Sender: TObject);
begin
  WindowState := TWindowState.wsMaximized;
  Randomize;
end;

F9キーを押して実行。1秒毎にラベルの位置が変わる状態になった。


忘れてた。マウスカーソルを消さないといかんよな…。FormCreate にマウスカーソルを非表示にする一行を追加。

procedure TForm1.FormCreate(Sender: TObject);
begin
  WindowState := TWindowState.wsMaximized;
  ShowCursor(False);  // マウスカーソル非表示
  Randomize;
end;

これでかなり出来上がってきたけど、せっかくだからマウスカーソルを動かしたら終了するようにしておこう…。

• マウスカーソルが動くと OnMouseMove イベントが発生するので、プロシージャを作成。
• 前回のマウスカーソル位置を覚えておかないとどのくらいマウスカーソルが動いたか計算できないので、TForm1クラス内に private変数も用意しておく。
• その private変数は、FormCreate の中で初期化しておく。
• インライン関数 Point を使うので、uses のあたりに、System.Types を追加しておく。

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Types,  // これを追加
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    ...
  private
    { Private 宣言 }
    FOldMousePos: TPoint;  // マウスの旧座標を記録する変数
  public
    { Public 宣言 }
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WindowState := TWindowState.wsMaximized;
  Randomize;
  ShowCursor(False);

  FOldMousePos := Point(-1, -1);  // マウス旧座標記録用変数を初期化
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  dx, dy: Integer;
const
  DIST: Integer = 32;
begin
  if FOldMousePos.X <> -1 then
  begin
    dx := FOldMousePos.X - X;
    dy := FOldMousePos.Y - Y;
    if ((dx * dx) + (dy * dy)) > (DIST * DIST) then
      Application.Terminate;
  end;

  FOldMousePos := Point(X, Y);
end;

((dx * dx) + (dy * dy)) > (DIST * DIST) のあたりは三平方の定理(ピタゴラスの定理) を使ってる。

_ピタゴラスの定理 - Wikipedia

三平方の定理を使うと、値がプラスかマイナスかを気にせずに掛け算だけで判定ができるから楽なのです…。

これで、マウスを動かしても終了できるようになった。スクリーンセーバのフルスクリーン表示モードは大体出来たかなと…。

次に、スクリーンセーバの設定画面を作る。

今回はスクリーンセーバ名を表示して、OKボタンをクリックしたら終了するだけの処理にする。



ファイル → 新規作成 → VCLフォーム。Unit2.pas が新規作成されて、フォームが一つ表示された。

• TLabel を貼り付けて、Caption にスクリーンセーバ名を入力。Font を設定して好みの見え方を指定。
• TButton も貼り付けて、Caption は「OK」にする。

TButton をダブルクリックすれば、ボタンをクリックした時に呼ばれるプロシージャが自動作成される。アプリを終了するための一行を追加。

procedure TForm2.Button1Click(Sender: TObject);
begin
  Application.Terminate;
end;

しかし、この状態でF9キーを押して動作確認しようとしても、先ほど作成したフルスクリーン表示用のフォームまで表示されてしまう。今回作成したフォームだけを表示するようにしたい。

プロジェクト → ソースを表示。もしくは、プロジェクトのファイル群がツリー表示されてるウインドウで、プロジェクト名を右クリック → ソースの表示。.dpr ファイル (SSDelphiTest1.dpr) が表示される。

本来なら、このソースコード内でコマンドラインオプションの解析をして、フルスクリーン表示、設定画面、プレビュー画面の処理に振り分けないといかんのだけど…。とりあえず、まずは各フォームの表示確認だけをしておく。

Application.CreateForm() で TForm1 と TForm2 の2種類が生成されているので、TForm1 の行はコメントアウトしておく。該当行で Ctrl + / を叩けばコメントアウトができる。もう一度 Ctrl + / を叩けばコメント解除になる。

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
//  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm2, Form2);
  Application.Run;
end.

F9キーを叩けば、設定画面用フォームだけが表示される状態になる。OKボタンをクリックして終了するか確認。

これで設定画面用フォームも作成できた。

Windowsの「スクリーンセーバーの変更」ウインドウでは、スクリーンセーバのプレビュー画面が小さく表示される。本来ならスクリーンセーバの実処理をそこに表示しないといかんのだろうけど…。今回はスクリーンセーバ名を表示するだけにしておく。



設定画面用フォームの時と同様に、フォームをもう1つ追加する。ファイル → 新規作成 → VCLフォーム。Unit3.pas が追加されて、フォームも追加される。

• BorderStyle を bsNone にして、タイトルバーを消去。
• Width と Height を、152 x 112 にする。「スクリーンセーバーの変更」ウインドウ内のプレビュー画面表示枠はそのサイズなので…。
• TLabel を配置して、Caption をスクリーンセーバ名にする。
• フォームの色(Color) や、TLabel の Font を変更して、背景色や文字色を指定する。

このままだと、Delphi IDE上で動作確認した際、終了させる方法が無い。一応仮で、OnKeyDown イベントにプロシージャを割り当てて、ESCキーが押されていたら終了するようにしておく。本番では削除してしまっていいけれど…。フツーはESCキーを押す人も居ないだろうからそのまま放置でもいいのかも…。

procedure TForm3.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_ESCAPE then
    Application.Terminate;
end;

プロジェクトのソースを表示して、プレビュー画面用フォームだけが生成されるようにしておく。

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
//  Application.CreateForm(TForm1, Form1);
//  Application.CreateForm(TForm2, Form2);
  Application.CreateForm(TForm3, Form3);
  Application.Run;
end.

F9キーを押して実行。それらしく表示されるか確認。ESCキーを押せば終了する。

これでプレビュー画面用フォームも作成できた。

ここまでの作業で、フルスクリーン表示用、設定画面用、プレビュー画面用 ―― 必要なフォームは全部作成した。

後は、コマンドラインオプション(コマンドライン引数)に基づいて処理を振り分ければスクリーンセーバになるはず。


Windows用のスクリーンセーバは、以下のコマンドライン引数が渡される可能性がある。

• /s ... フルスクリーン表示。
• /c:HWND ... 設定画面表示。HWNDはウインドウハンドル。「スクリーンセーバーの変更」で「設定」を押された時はこの指定になる。らしい。
• /c ... 設定画面表示。
• /p HWND ... プレビュー画面表示。HWNDはウインドウハンドル。与えられたウインドウハンドルを親としたウインドウを作って、そこにプレビュー画面を表示しないといけない。
• コマンドラインオプション無し ... 設定画面表示。.scr を右クリックして「構成」を選ぶとこの指定になる。らしい。

コマンドライン引数を取得する方法だけど、Delphi の場合、ParamCount と ParamStr にコマンドライン引数の情報が入っている。

• ParamCount : コマンドライン引数の数。コマンドライン引数が何も指定されてなかったら 0 になる。
• 配列 ParamStr : コマンドライン引数の文字列。ParamStr(0) は実行ファイル名。ParamStr(1) 以降はコマンドライン引数の文字列。空白文字で区切られて配列に入ってる。

更に、Delphi の .dpr の中では、以下のような処理をしているので…。

• Application.CreateForm() で何かしらのフォームを作成して、
• Application.Run で各フォームのメインループが回り始めて、
• フォーム側の処理で Application.Terminate が呼ばれたら、メインループ相当の Application.Run を抜けて、次の処理に進んでいく。

そんなわけで、コマンドライン引数に応じて、Application.CreateForm() で発生させるフォームの種類を、フルスクリーン表示用、設定画面用、プレビュー画面用のどれかしらにしてやればスクリーンセーバになってくれるはず。

そんな感じで、.dpr はこうなった。

program SSDelphiTest1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1} ,
  Unit2 in 'Unit2.pas' {Form2} ,
  Unit3 in 'Unit3.pas' {Form3} ,
  System.SysUtils,
  System.StrUtils;

{$R *.res}

var
  arg: string;
  hwnd: Int64;

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  // コマンドライン第1引数を '/s', '/c', '/p' の状態にする
  if ParamCount > 0 then
    arg := ParamStr(1).Substring(0, 2).ToLower
  else
    arg := '';

  if arg = '/s' then
  begin
    // フルスクリーン表示
    Application.CreateForm(TForm1, Form1);
    Application.Run;
    Exit; // Exit は他言語での Return みたいなもの
  end;

  if arg = '/c' then
  begin
    // 設定画面表示
    Application.CreateForm(TForm2, Form2);
    Application.Run;
    Exit;
  end;

  if arg = '/p' then
  begin
    // プレビュー画面表示
    if ParamCount >= 2 then
      hwnd := StrToInt64Def(ParamStr(2), 0)
    else
      hwnd := 0;

    Application.CreateForm(TForm3, Form3);

    if hwnd <> 0 then
      Form3.ParentWindow := hwnd;

    Application.Run;
    Exit;
  end;

  // 設定画面表示
  Application.CreateForm(TForm2, Form2);
  Application.Run;

end.

• 文字列の一部を切り出す Substring() や 小文字化する ToLower を使うために、uses に System.SysUtils, System.StrUtils を追加している。
• StrToInt64Def(ParamStr(2), 0) は、文字列型から Int64型(数値)への変換をする。Def がついていると、変換に失敗した時は第2引数の値を返してくれるらしい。
• フォームの親ウインドウを変更する時は、.ParentWindow に親ウインドウのウインドウハンドルを指定してやればいいらしい…？ ちょっと自信が無い。

ビルドして出来上がった .exe の動作確認をするために、コマンドライン引数を指定した状態で実行したい。プロジェクトのオプション設定で指定できる。

1. Ctrl + Shift + F11キーを押すか、もしくは、プロジェクト → オプション、でプロジェクトのオプション設定ウインドウが開く。
2. デバッガ → パラメータ、でコマンドライン引数を指定する。

パラメータに、「/s」「/c」「/c:123456」「/p」「/p 0」を指定してプロジェクトオプションを保存してから、F9キーを叩いて実行したら、コマンドライン引数に対応したフォームが表示された。


これで完成！ ではない…。

フルスクリーン表示モードは、スクリーンセーバの起動設定時間が来るたびに何度も起動されてしまう可能性があるらしいので、既に起動していたらまた起動されないように ―― いわゆる多重起動禁止処理を入れないといけない。

Delphi で多重起動禁止をしたいなら、Windowsの Mutex (CreateMutex()) を使うのが簡単らしい。uses に Winapi.Windows を追加すれば使えるようになる。

そんな感じで、こうなった。フルスクリーン表示モードのところに多重起動禁止処理を入れている。

program SSDelphiTest1;

uses
  Vcl.Forms,
  Unit1 in 'Unit1.pas' {Form1} ,
  Unit2 in 'Unit2.pas' {Form2} ,
  Unit3 in 'Unit3.pas' {Form3} ,
  System.SysUtils,
  System.StrUtils,
  Winapi.Windows;

{$R *.res}

var
  arg: string;
  hwnd: Int64;
  hMutex: THandle;

const
  MUTEXNAME: string = 'SSDelphiTest1Mutex5963'; // 他と被らない文字列にする

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;

  // コマンドライン第1引数を '/s', '/c', '/p' の状態にする
  if ParamCount > 0 then
    arg := ParamStr(1).Substring(0, 2).ToLower
  else
    arg := '';

  if arg = '/s' then
  begin
    // フルスクリーン表示

    // 多重起動禁止処理
    hMutex := CreateMutex(nil, False, PChar(MUTEXNAME));
    if (hMutex = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then
    begin
      // 既に起動している
      if hMutex <> 0 then
        CloseHandle(hMutex);

      Exit; // Exit は他言語での Return みたいなもの
    end;

    try
      begin
        Application.CreateForm(TForm1, Form1);
        Application.Run;

      end;
    finally
      if hMutex <> 0 then
        CloseHandle(hMutex);
    end;

    Exit;
  end;

  if arg = '/c' then
  begin
    // 設定画面表示
    Application.CreateForm(TForm2, Form2);
    Application.Run;
    Exit;
  end;

  if arg = '/p' then
  begin
    // プレビュー画面表示
    if ParamCount >= 2 then
      hwnd := StrToInt64Def(ParamStr(2), 0)
    else
      hwnd := 0;

    Application.CreateForm(TForm3, Form3);

    if hwnd <> 0 then
      Form3.ParentWindow := hwnd;

    Application.Run;
    Exit;
  end;

  // 設定画面表示
  Application.CreateForm(TForm2, Form2);
  Application.Run;

end.

他のモードは多重起動禁止処理を入れなくていいのだろうか？

入れないほうがいいらしい。というのも、設定画面やプレビュー画面を表示している状態でも、時間が来たらスクリーンセーバを起動させないといけないので…。

これで処理は実装できた。後は、生成された .exe を .scr にリネームコピーしてやれば Windowsのスクリーンセーバになるはず…。

でも、ビルドするたびに一々 .exe を .scr に手作業でリネームコピーするのは面倒臭い。

しかし Delphi なら、ビルドが終わった直後に任意のコマンドを実行できるので、自動でリネームコピーをするように指定できる。

_Delphiでexeを生成したらscrも作りたい - mieki256's diary

プロジェクト → オプション → ビルド → ビルドイベント → ビルド後イベント → コマンド。以下を入力して「保存」をクリック。

copy /Y "$(OUTPUTPATH)" "$(OUTPUTDIR)$(OUTPUTNAME).scr"

この設定をしてからビルド(Shift + F9 や F9)をすると、以下のメッセージが表示される。Delphi が把握してない謎のコマンドが実行されようとしているけれどコレ本当に大丈夫？ 危なくないか？ と尋ねてきているのだろう。

SSDelphiTest1 を信頼しますか?

このプロジェクトは1つまたは複数のビルドイベントを含んでおり、
これらはシステム上で任意のコマンドを実行する可能性があります。
このプロジェクトを信頼し、ビルドを続行しますか?

「このプロジェクトを常に信頼する」にチェックを入れて「はい」をクリック。これで毎回ビルド後に、自動で .scr を作ってくれるようになった。

できあがったスクリーンセーバ(.scr)は、以下の場所にコピーすることでインストールできる。

• OSが64bit。スクリーンセーバが64bit版プログラム → C:\Windows\System32\
• OSが64bit。スクリーンセーバが32bit版プログラム → C:\Windows\SysWOW64\
• OSが32bit。スクリーンセーバが32bit版プログラム → C:\Windows\System32\

今回は、ビルド構成を Release、ターゲットプラットフォームを Windows 64ビットにしてビルドしたので、64bit版のプログラム(.exe, .scr) が生成された。

自分は Windows11 x64 25H2 を使っているので、C:\Windows\System32\ に SSDelphiTest1.scr をコピーした。

「スクリーンセーバーの変更」ウインドウを表示して、リスト一覧の中に表示されるか確認。ファイル名の最初に 'SS' が付いているとそこは省略された状態で表示されるので、SSDelphiTest1 は DelphiTest1 として表示された。

期待した通りに動いてくれた…。Delphi でWindows用のスクリーンセーバを作ることができた。

出来上がった .scr のファイルサイズは 3.7MB。C#で作成すると100MBを超えてしまうので、このファイルサイズの小ささは魅力的。

この状態だと、「スクリーンセーバーの変更」ウインドウにはファイル名が表示されてしまう。

プログラムにリソースファイルを含ませることで、「スクリーンセーバーの変更」ウインドウ内で表示されるスクリーンセーバ名を指定することができる。

_Delphiでリソースファイルの追加 - mieki256's diary
_スクリーンセーバーを作ったが、名前を設定できずにファイル名になってしまう

プロジェクトフォルダ内に myresource.rc というテキストファイル(リソーススクリプトファイル)を作成して以下を記述した。"Delphi SSaver Test 1" が、今回表示したいスクリーンセーバ名。

STRINGTABLE PRELOAD DISCARDABLE
BEGIN
 1 "Delphi SSaver Test 1"
END

プロジェクト → プロジェクトに追加、を選択。ファイル種類を「リソースファイル (.rc)」にして、myresources.rc を開く。

これでビルド(Shift + F9) をすれば、.rc が .res に変換されて、プログラム内に含まれた状態になる。「スクリーンセーバーの変更」のリスト上でも反映された。

ここまで作業したソースを一応置いておく。

_SSDelphiTest1.dpr
_Unit1.pas
_Unit1.dfm
_Unit2.pas
_Unit2.dfm
_Unit3.pas
_Unit3.dfm
_myresource.rc

いくつか課題は残ってる。

この状態ではマルチディスプレイ環境に対応していない。どうすれば対応できるのか…？

また、デスクトップ上で動いているアプリの種類によっては、この作りではキーの押し下げやマウス操作で終了できないという話もあるので、対応させられるなら対応させたい…。

_Windows 令和のスクリーンセーバーの作り方 - Qiita

設定を、ファイルもしくはレジストリに保存する処理も入ってない。どうすれば設定を保存・反映できるのか…？ 仮に、ファイルとして設定を保存する際、適切なファイルフォーマットはどれだろう？ .ini？ .json？ Delphi的には一体何がオススメなのだろう？

ウチはこの手の電気ストーブで洗面所のドアを焦がしてしまった前科があるので、このタイプの電気ストーブを購入するのはずっと避けていたのだけど…。親父さんが家族に相談もせずに勝手に買ってしまって、扱いに困ってる。何か対策してから使わせないと火事になる…。

電気ストーブの取扱説明書には、「前方1m、上方1m、左右各30cm、後方45cmに可燃物を置くな！」と書いてあった。

可燃物を置いてはいけない範囲さえ視覚的に分かれば事故を避けられるんじゃないか？ 範囲が分かれば何でもいいんじゃね？ だったらアルミシート(アルミ蒸着シート)でも電気ストーブの前に置いてみようか。

そう安易に考えたのだけど、AIに尋ねてみたら「あの手のアルミシートって耐熱温度が60-80度だから電気ストーブの前に置いたら溶けて事故が起きるよ」と言ってきた…。調べてみたら、アルミ蒸着部分はともかく、下地になってるポリエチレン等の耐熱温度がかなり低い。メーカーサイトでも「100度は無理やで」みたいな記述が…。後にダイソーの店頭でパッケージを確認したら「50度以下で使え」との記述もあって…。危ないところだった。この案は却下。

AI君が「難燃シートという選択肢もあるで」と言ってきたので調べてみたら、キャンプ用品の焚き火シートならガラス繊維が編み込んであって耐熱温度が230度ぐらいあるとのこと。ちゃんとした商品なら値段が数千円するけれど、ダイソーでは300円や500円で売ってる時も過去にはあったと知り、店頭で探してみたのだけど…。たしかに置いてあった。あったけど、「絶対に手袋をつけて扱え」とパッケージに書いてあって…。おそらくだけど、素手で触るとガラス繊維が手に刺さるのではなかろうか。そんな怖いものを親父さんに扱わせるわけにはいかない。この案も却下。

結局、ワイヤーネットで柵を作ることしか思いつかなかった…。

こういった、ストーブの周りに置かれる柵は「ストーブガード」と呼ばれているけれど、数万円ぐらいするのがフツーなので、1,000円未満で作れるなら全然マシなほうだろう…。

しかし、帰宅してから組み立ててみたけれど、めちゃくちゃ大きい。邪魔。完全に邪魔。しかも中途半端に高さがあるので、これはこれで足が不自由になってしまった親父さんが足を引っかけて転んでしまうだろう…。絶対に転ぶ。100%転ぶ。あの人は間違いなく転ぶ。

それでも一応設置してみたけれど、親父さんからは「邪魔だ！」と言われる始末。自分もそう思う。どう考えても邪魔。

要するに、「畳一畳分のスペースを確保して、長辺の1/3ほど引っ込めた位置に電気ストーブを置いて使え」という話なわけで…。

親父さんに何度も何度も「畳一畳分を確保して使ってくださいね」と念押しして、柵は撤去してしまうことにした。まあ、ボケてきた親父さんのことだから、明日になったら忘れてそうだけど…。一応 Google SketchUp 8 で範囲が分かる図を作成して印刷して親父さんのPCデスクの前に貼っておいた。明日にはその紙の存在すら忘れてるだろうけど。

「範囲内に物を置いたり、電気ストーブの電源を切り忘れたりしたら、その時はもう電気ストーブを使える状態ではないと判断して電気ストーブを回収しますからね」と3回ぐらい言っておいたけど…。そういう話を言われたことすら明日には忘れてるかもしれない。そして何かを焦がす羽目になっても全然危機感を持たないかもしれないし、家が火事になって無くなっても一切反省しないかもしれない…。

連結ジョイントの説明書には、ワイヤーネットで箱を作る方法が紹介されていた。金属で箱を作りたいなら、この選択肢はかなり便利そう…。ワイヤーネットのサイズ次第で箱の大きさもいくつか選択できるし…。これはアイデア賞な気もするなあ…。

コマンドを記述する際に使えるマクロ(?)名が分からない…。一応、以下のマクロは使えそうだと分かったけれど…。

• $(TargetFile) : 生成される .exe のフルパス。
• $(ProjPath) : プロジェクトフォルダのフルパス。最後に区切り文字 "\" が含まれている。

しかし、拡張子を除いた生成ファイル名のマクロがあるんだか、ないんだか…。

AIに尋ねたら、「いっそファイル名を直接書いちまえよ。それなら間違いないぞ」と言ってきた。それはまあ、たしかに…。以下にしてみたら一応目的は果たせた。

cmd /C copy /Y "$(TargetFile)" "$(ProjPath)sslazarus1.scr"

_IDE Macros in paths and filenames - Free Pascal wiki

む？ もしかして、$NameOnly() を使えば拡張子を除いたファイル名だけ取り出せないか…？

cmd /C copy /Y "$(TargetFile)" "$(ProjPath)$NameOnly($(TargetFile)).scr"

これで実現できたかも。

IDEの下のほうにメッセージが表示されているけれど、右クリックして「プロジェクト次の後にコマンドを実行：について」を選ぶと、実際にどんなコマンドが実行されたのか確認できる。もし、「(不明なマクロ)」という記述が見えた場合はマクロ名の指定で失敗してる。

文字化けしてる感じのメッセージも表示されているけれど…。たぶん copyコマンドが出力しているメッセージと、出力ウインドウの文字コードが違うのだろう…。

AIに尋ねてみたら「PowerShellを使えばメッセージは出ないで」と言ってきた。DOS窓で以下を打ってみたら、たしかに処理はされつつメッセージも出ないように見える。

powershell -command "Copy-Item 'sslazarus1.exe' 'sslazarus1.scr' -Force"

Lazarus上で指定するなら以下になるのかな…。

powershell -command "Copy-Item '$(TargetFile)' '$(ProjPath)$NameOnly($(TargetFile)).scr' -Force"

これでも一応動作しているように見える。

一応、プレビュー画面モード部分のソースを貼っておく。

_previewformunit.pas

unit PreviewFormUnit;

{$mode ObjFPC}{$H+}

interface

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

type

  { TPreviewForm }

  TPreviewForm = class(TForm)
    Label1: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
  private
    FParentHWND: HWND;
  protected
    procedure WndProc(var Message: TMessage); override;
  public
    procedure EmbedIntoParent(pHWND: HWND);

  end;

var
  PreviewForm: TPreviewForm;

implementation

{$R *.lfm}

{ TPreviewForm }

procedure TPreviewForm.FormCreate(Sender: TObject);
begin
  //FParentHWND := 0;
  BorderStyle := bsNone;
  Left := 0;
  Top := 0;
  Width := 152;
  Height := 112;

  Label1.Left := (ClientWidth - Label1.Width) div 2;
  Label1.Top := (ClientHeight - Label1.Height) div 2;
  Label1.Font.Color := clBlue;
end;

// 親ウインドウを指定
procedure TPreviewForm.EmbedIntoParent(pHWND: HWND);
var
  r: TRect;
begin
  FParentHWND := pHWND;

  if pHWND <> 0 then
  begin
    ParentWindow := pHWND;
    Windows.SetParent(self.Handle, pHWND);

    SetWindowLong(Self.Handle, GWL_STYLE, GetWindowLong(self.Handle, GWL_STYLE) or
      WS_CHILD);

    Windows.GetClientRect(pHWND, r);
    MoveWindow(Self.Handle, 0, 0, r.Right - r.Left, r.Bottom - r.Top, True);
    Visible := True;
  end;
end;

procedure TPreviewForm.Timer1Timer(Sender: TObject);
begin
  // 一定時間毎に自身が消えるべきかチェックする
  //Windows.Beep(440, 100);
  if (FParentHWND <> 0) and (not Windows.IsWindow(FParentHWND)) then
  begin
    // 親ウインドウが存在していないので終了
    //Windows.Beep(1000, 100);
    Application.Terminate;
  end
  else if not Windows.IsWindowVisible(self.Handle) then
  begin
    // 自分が非表示にされているなら終了
    //Windows.Beep(1000, 1000);
    Application.Terminate;
  end;
end;

procedure TPreviewForm.WndProc(var Message: TMessage);
begin
  //Windowsから閉じろとメッセージが来ているなら終了
  case Message.Msg of
    WM_CLOSE, WM_DESTROY, WM_NCDESTROY:
    begin
      //Windows.Beep(2000, 300);
      Application.Terminate;
    end;
  end;

  inherited WndProc(Message);
end;

procedure TPreviewForm.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
begin
  if FParentHWND = 0 then
  begin
    // 開発時用。ESCキーで終了
    if Key = VK_ESCAPE then
      Application.Terminate;
  end;
end;

//initialization
//  RegisterClass(TPreviewForm);

end.

_sslazarus1.lpr

program sslazarus1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  {$IFDEF HASAMIGA}
  athreads,
  {$ENDIF}
  Interfaces, // this includes the LCL widgetset
  Forms,
  LCLIntf,
  LCLType,
  Windows,
  SysUtils,
  FullScrFormUnit,
  ConfigFormUnit,
  PreviewFormUnit { you can add units after this };

  {$R *.res}

var
  arg: string;
  phwnd: HWND;
  hMutex: THandle;

const
  MUTEX_NAME: string = 'ScreenSaverLazarus1Mutex8686';

begin
  RequireDerivedFormResource := True;
  Application.Scaled := True;
  {$PUSH}
  {$WARN 5044 OFF}
  //Application.MainFormOnTaskbar := True;
  Application.MainFormOnTaskbar := False;
  {$POP}
  Application.Initialize;

  if ParamCount >= 1 then
    arg := LowerCase(Copy(ParamStr(1), 1, 2))
  else
    arg := '';

  if arg = '/s' then
  begin
    // Fullscreen mode
    hMutex := CreateMutex(nil, False, PChar(MUTEX_NAME));
    if (hMutex = 0) or (GetLastError = ERROR_ALREADY_EXISTS) then
    begin
      if hMutex <> 0 then
        CloseHandle(hMutex);

      Exit;
    end;

    try
      Application.CreateForm(TFullScreenForm, FullScreenForm);
      Application.Run;
    finally
      if hMutex <> 0 then
        CloseHandle(hMutex);
    end;
  end
  else if arg = '/c' then
  begin
    // Config mode
    Application.CreateForm(TConfigForm, ConfigForm);
    Application.Run;
    Exit;
  end
  else if arg = '/p' then
  begin
    // Preview mode
    if ParamCount >= 2 then
      phwnd := HWND(StrToInt64Def(ParamStr(2), 0))
    else
      phwnd := 0;

    Application.CreateForm(TPreviewForm, PreviewForm);
    if phwnd <> 0 then
      PreviewForm.EmbedIntoParent(phwnd);

    Application.Run;
  end
  else
  begin
    // Config mode
    Application.CreateForm(TConfigForm, ConfigForm);
    Application.Run;
  end;

end.

プロセスが残り続けているかどうかは、System Explorer 7.1.0.5359 を使ってチェックした。

_System Explorer Portable | PortableApps.com

右上のフィルタ入力欄(?)に文字列を打ち込めば、その文字列を含んだ名前のプロセスがリストアップされる。

フロートの調整作業がとにかく大変そうだった。手洗い用の水が出るところが邪魔になって蓋を外せず、斜めにして仮置きして作業するから重い蓋が落ちそうで危険極まりない。

水が出るところをシャワーヘッドのように回して外せたら蓋をスポンと抜いて作業できそうなのに…。INAXの設計はダメ過ぎないか…。いや、コストダウンでこうしたのかな…。あるいは水が流れる部分だから部品点数を少なめにしないと危険なのだろうか。だとしても、あの設計はどうかと思う。現場の苦労を無駄に増やす設計というか…。もうちょっとどうにかならなかったのか…。

AI(Google Gemini)に尋ねてみたら、windres を使って .rc を .res に変換しろと言ってきた。

windres はFPC (Free Pascal)に同梱されている。自分の環境では、D:\Dev\lazarus\ に Lazarus をインストールしてあるので、以下にFPC(とwindres)が入ってる。

D:\Dev\lazarus\fpc\3.2.2\bin\x86_64-win64

DOS窓上で FPC が使えるようにするためのbatファイル、D:\home2\bin\fpcenable.bat を作成しておいた。とメモ。実行すると環境変数PATHの先頭にFPCのパスが追加されて、FPCに同梱されたアレコレが利用できるようになる。

@echo off
@rem FPC (Free Pascal) enable
set FPCPATH=D:\Dev\lazarus\fpc\3.2.2\bin\x86_64-win64
set PATH=%FPCPATH%;%PATH%
echo Enable FPC (Free Pascal). Add path : %FPCPATH%

リソースファイル(リソーススクリプトファイル) strings.rc を作成。中身は以下。スクリーンセーバ名を記述してる。

STRINGTABLE
BEGIN
  1, "Lazarus SSaver 1"
END

windres で .rc を .res に変換。

windres strings.rc strings.res

.lpr にリソースファイル strings.res を読み込むように記述を追加。

  {$R *.res}

↓

  {$R *.res}
  {$R strings.res}

この状態でビルドして、出来上がった .scr を所定の場所にコピーして確認。「スクリーンセーバーの変更」ウインドウのリスト上に、今回指定した名前が表示された。

しかし、ソース内では *.res が記述されているから、プロジェクトフォルダ内に .res があるだけで読み込んでくれそうな気もするのだけど…。わざわざ別途指定しなくてもいいのかな…？

頻繁に .rc を修正するなら、自動で .res に変換するように指定することもできそう。

• プロジェクト → プロジェクトオプション → コンパイラオプション → コンパイラコマンド。
• 次の前に実行、の「コンパイル」「構築」にチェックを入れて、「実行」のチェックを外す。
• コマンド入力欄に windres strings.rc strings.res と打ち込んでおく。

これで、ビルドする前に strings.rc を strings.res に変換してからビルドしてくれる。

ただ、これだと毎回変換されそうな…。そう頻繁に変換するものでもないよな…。手作業で .res に変換してもさほど困らない気もする。

以下を眺めていたら…。

_Lazarus Resources - Free Pascal wiki

FPC 2.4 以降、かつ、windres にパスが通っていれば、ソース中に直接 .rc を記述してもいける、と書いてあるように見える…。


また、FPC 3.3.1 以降なら、コンパイラに -FF を指定することで、windres ではなく fpcres を使うように指示できる、とも書いてあるような…。でも、その -FF ってどこで指定すればいいのやら…。


_lazres - Free Pascal wiki

lazres なるツールもあるっぽい。tools/ の中にあると書いてある。

試しに .res を削除してから、ソースコード内に .res ではなく .rc と書いてみた。

  {$R *.res}
  {$R strings.rc}

ビルドが通ってしまった。もしかして、これだけで良かったのか…。

余談。自分の環境の場合、環境変数 PATH の中に Perlのインストール場所も入っているけれど、その Perl も windres を持っているので、Perl と FPC のどっちの windres が使われてしまうのかちょっと分からないなと…。手作業で .res に変換したほうが確実だろうか？

確認してみたら、Perl のほうが windres 2.32 で、FPC のほうが windres 2.28 だった。FPC側よりPerl側の windres のほうが新しいから、仮にそちらが使われても問題は無いのかもしれない。とメモしておく。

> which windres
"D:\Perls\strawberry\5.32.1.1-x64\c\bin\windres.exe"

> windres -V
GNU windres (GNU Binutils) 2.32
Copyright (C) 2019 Free Software Foundation, Inc.
...

> fpcenable
Enable FPC (Free Pascal). Add path : D:\Dev\lazarus\fpc\3.2.2\bin\x86_64-win64

> which windres
"D:\Dev\lazarus\fpc\3.2.2\bin\x86_64-win64\windres.exe"

> windres -V
GNU windres (GNU Binutils) 2.28
Copyright (C) 2017 Free Software Foundation, Inc.
...

トイレに設置した手すりだけど、床に接地(?)してる部分が絨毯っぽい材質で…。これは絶対に親父さんが汚すだろう…。小便や大便がくっつくけれど、いいのかな。いいわけないよな…。

こういった製品は表面を拭き取れる材質にしておかないと掃除できないと思うのだけど、設計者はこの手の製品が使われる現場の現状を今一つ分かってないのではないか。いや、滑らないことを優先してこの材質を選んだ可能性もあるか…。考えてみたら排便障害云々よりそっちを優先するよな…。手すりなんだし…。でも、こういう物が必要になると言うことは、利用者の年齢からして周囲を汚しまくる状況にもなるわけで…。もうちょっとどうにかならなかったのか…。

Lazarus で OpenGL を使いたい場合、lazopenglcontext というパッケージをインストールすると TOpenGLControl というコントロール(GUI部品)が使えるようになって、比較的楽に OpenGL を利用できるようになるらしい。インストールの仕方をメモしておく。

プロジェクトに lazopenglcontext を追加したい場合は、プロジェクト → プロジェクトインスペクタ。



追加 → 新規の要求。



パッケージ名に「opengl」と打ち込むとリストアップされるので、lazopenglcontext を選択して「OK」。



あるいは Lazarus IDE に lazopenglcontext をインストールしてしまう手もありそう。パッケージ → パッケージをインストールもしくはアンインストール。



インストール可能、の側で「opengl」と打ち込めばリストアップされるので、lazopenglcontext を選択して、「選択対象をインストール」をクリック。その後、Rebuild IDE をクリック。ビルドが始まって、数分して終了したらIDEが自動で再起動する。

_OpenGL Tutorial - Free Pascal wiki

上記ページの一番最初のサンプルを動かしてみた。

_unit1.pas
_unit1.lfm
_OpenGLTest1.lpr

_unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,
  FileUtil,
  Forms, Controls, Graphics, Dialogs,
  OpenGLContext, gl;  // OpenGLを使う時はコレを追加

type

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure GLboxPaint(Sender: TObject);
  private
    GLBox: TOpenGLControl;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  // フォーム生成時

  // TOpenGLControl を新規作成してフォームの子にする
  GLbox := TOpenGLControl.Create(Self);
  GLbox.AutoResizeViewport := True;
  GLBox.Parent := Self;
  GLBox.MultiSampling := 4;
  GLBox.Align := alClient;  // フォームのクライアント領域全体に広げる

  // 描画処理をするプロシージャを割り当て
  // "mode delphi" の場合は "GLBox.OnPaint := GLboxPaint" にする
  GLBox.OnPaint := @GLboxPaint;

  GLBox.invalidate;
end;

procedure TForm1.GLboxPaint(Sender: TObject);
begin
  // GLBox (TOpenGLControl) 描画処理

  // 背景を消去
  glClearColor(0.27, 0.53, 0.71, 1.0); // Set blue background
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glLoadIdentity;

  // 三角形を描画
  glBegin(GL_TRIANGLES);
  glColor3f(1, 0, 0);
  glVertex3f(0.0, 1.0, 0.0);
  glColor3f(0, 1, 0);
  glVertex3f(-1.0, -1.0, 0.0);
  glColor3f(0, 0, 1);
  glVertex3f(1.0, -1.0, 0.0);
  glEnd;

  // ダブルバッファ切り替え
  GLbox.SwapBuffers;
end;

end.

実行すると以下の見た目になる。OpenGL で三角形を描画できている。



Lazarus は TOpenGLControl というコントロールを使うと OpenGL を扱うのが簡単になるわけだけど、このソース内でも TOpenGLControl を新規作成してフォームに貼り付けて利用してる。また、GLBox.Align := alClient; でフォームのクライアント領域全体に TOpenGLControl が表示されるようにしている。

後は、TOpenGLControl の OnPaint で呼ばれるプロシージャ内に、OpenGLを使った描画処理を書いておけばいい。

Google Gemini に尋ねながら別のサンプルを書いてみた。

_Unit1.pas
_Unit1.lfm
_OpenGLTest2.lpr

_Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
  LCLType, ExtCtrls,
  Windows, MMSystem,        // timeBeginPeriod を使うために追加
  OpenGLContext, GL, glu;   // OpenGLを使うために追加

type

  { TForm1 }

  TForm1 = class(TForm)
    OpenGLControl1: TOpenGLControl;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure OpenGLControl1Paint(Sender: TObject);
    procedure OpenGLControl1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    fAngle: double;
    fLastTime: DWORD;
    procedure DrawCube;
    procedure ResizeGL;
    procedure SetFullscreen;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

{ フォームが生成された時の処理 }
procedure TForm1.FormCreate(Sender: TObject);
begin
  // タイマー精度を1msにする。(Windows Only)
  timeBeginPeriod(1);
  fLastTime := timeGetTime;

  fAngle := 0.0;

  // タイマーの時間間隔を設定
  Timer1.Interval := 15;
  Timer1.Enabled := True;

  KeyPreview := True;
end;

{ フォームが破棄された時の処理 }
procedure TForm1.FormDestroy(Sender: TObject);
begin
  // タイマー精度を元に戻す。(Windows Only)
  timeEndPeriod(1);

  OpenGLControl1.Cursor := crDefault;
end;

{ フォームが表示された時の処理}
procedure TForm1.FormShow(Sender: TObject);
begin
  // フルスクリーン表示を指定
  //SetFullscreen;
  //OpenGLControl1.Cursor := crNone;

  ResizeGL;
end;

{ フルスクリーン表示を設定 }
procedure TForm1.SetFullscreen;
begin
  BorderStyle := bsNone;
  WindowState := wsFullScreen;
  //WindowState := wsMaximized;
  //BoundsRect := Screen.Monitors[0].BoundsRect;
  OpenGLControl1.Align := alClient;
end;

{ キーが押された時の処理 }
procedure TForm1.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
begin
  // ESCキーで終了
  //if Key = VK_ESCAPE then
  //  Application.Terminate;

  Application.Terminate;
end;

{ 一定時間毎に呼ばれる処理。Timer1のOnTimerに割り当て }
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // TOpenGLControlの再描画を要求
  OpenGLControl1.Invalidate;
end;

{ 箱を描画 }
procedure TForm1.DrawCube;
const
  D: double = 0.5;
begin
  glBegin(GL_QUADS);

  glColor3f(1.0, 0.0, 0.0);
  glVertex3f(-D, -D, D);
  glVertex3f(D, -D, D);
  glVertex3f(D, D, D);
  glVertex3f(-D, D, D);

  glColor3f(0.0, 1.0, 0.0);
  glVertex3f(-D, -D, -D);
  glVertex3f(-D, D, -D);
  glVertex3f(D, D, -D);
  glVertex3f(D, -D, -D);

  glColor3f(0.0, 0.0, 1.0);
  glVertex3f(-D, D, -D);
  glVertex3f(-D, D, D);
  glVertex3f(D, D, D);
  glVertex3f(D, D, -D);

  glColor3f(1.0, 1.0, 0.0);
  glVertex3f(-D, -D, -D);
  glVertex3f(D, -D, -D);
  glVertex3f(D, -D, D);
  glVertex3f(-D, -D, D);

  glColor3f(1.0, 0.0, 1.0);
  glVertex3f(D, -D, -D);
  glVertex3f(D, D, -D);
  glVertex3f(D, D, D);
  glVertex3f(D, -D, D);

  glColor3f(0.0, 1.0, 1.0);
  glVertex3f(-D, -D, -D);
  glVertex3f(-D, -D, D);
  glVertex3f(-D, D, D);
  glVertex3f(-D, D, -D);
  glEnd();
end;

{ TOpenGLControlの描画処理 }
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
var
  ct: DWORD;
  dt: double;
begin
  // 前回からの時間差を取得
  ct := timeGetTime;
  dt := (ct - fLastTime) / 1000.0;  // 秒単位にする
  fLastTime := ct;

  // 角度を変更
  fAngle := fAngle + (90.0 * dt);
  //if fAngle >= 360.0 then
  //  fAngle := fAngle - 360.0;

  glEnable(GL_DEPTH_TEST);
  glShadeModel(GL_SMOOTH);

  // 背景を消去
  glClearColor(0.0, 0.0, 0.0, 1.0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glLoadIdentity();

  // カメラを少し後ろに下げる
  glTranslatef(0.0, 0.0, -2.5);

  // 回転させる
  glRotatef(fAngle * 0.3, 1, 0, 0);
  glRotatef(fAngle, 0, 1, 0);

  // 立方体を描画
  DrawCube;

  // ダブルバッファ切り替え
  OpenGLControl1.SwapBuffers;
end;

procedure TForm1.OpenGLControl1Resize(Sender: TObject);
begin
  ResizeGL;
end;

{ ウインドウリサイズ時に行うべき処理 }
procedure TForm1.ResizeGL;
var
  Aspect: double;
begin
  if OpenGLControl1.Height <= 0 then
    Exit;

  // 透視変換をするように設定
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  Aspect := OpenGLControl1.Width / OpenGLControl1.Height;
  gluPerspective(45.0, Aspect, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
end;

end.

実行すると以下のような見た目になる。

• フォームには、TOpenGLControl と TTimer を貼り付けてある。
• TTimer を使って、一定の時間間隔で TOpenGLControl の再描画を要求してる。これでアニメーションをさせることができる。
• TOpenGLControl の再描画時、前回からの時間差を取得して、回転角度の変化量に加味している。

テクスチャ画像を貼ってみた。

_Unit1.pas
_Unit1.lfm
_OpenGLTest3.lpr
_texture.png
_texture2.png
_texture3.png

_Unit1.pas

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Dialogs,
  LCLType, ExtCtrls,
  Windows, MMSystem,        // timeBeginPeriod を使うために必要
  Graphics, GraphType,
  FPImage, FPReadPNG, IntfGraphics,   // 画像読み込みに必要
  OpenGLContext, GL, glu,   // OpenGLを使うために必要
  GLext;                    // GL_BGRA を記述するために必要

type

  { TForm1 }

  TForm1 = class(TForm)
    OpenGLControl1: TOpenGLControl;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure OpenGLControl1Paint(Sender: TObject);
    procedure OpenGLControl1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    fAngle: double;
    fLastTime: DWORD;
    fTexID: GLuint;
    procedure DrawCube;
    procedure DrawPlane;
    function LoadTexture(const FileName: string): GLuint;
    function LoadTexturePx(const FileName: string): GLuint;
    procedure ResizeGL;
    procedure SetFullscreen;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

const
  //TEXTURE_NAME: string = 'texture2.png';
  //TEXTURE_NAME: string = 'TEXTURE';
  TEXTURE_NAME: string = 'TEXTURE2';
  //TEXTURE_NAME: string = 'TEXTURE3';

{ フォームが生成される時の処理 }
procedure TForm1.FormCreate(Sender: TObject);
begin
  // タイマー精度を1msにする。(Windows Only)
  timeBeginPeriod(1);
  fLastTime := timeGetTime;

  fAngle := 0.0;

  // タイマーの時間間隔を設定
  Timer1.Interval := 15;
  Timer1.Enabled := True;

  KeyPreview := True;
end;

{ フォームが表示される時の処理 }
procedure TForm1.FormShow(Sender: TObject);
begin
  // フルスクリーン表示
  //SetFullscreen;
  //OpenGLControl1.Cursor := crNone;

  ResizeGL;

  // これを呼んでおかないとテクスチャが反映されない。ハマった…
  OpenGLControl1.MakeCurrent();

  // テクスチャを読み込み
  fTexID := LoadTexture(TEXTURE_NAME);
  //fTexID := LoadTexturePx(TEXTURE_NAME);
  if fTexID = 0 then
  begin
    ShowMessage('Error: Texture image loading failure.');
    Application.Terminate;
  end;
end;

{ フルスクリーン表示を設定 }
procedure TForm1.SetFullscreen;
begin
  BorderStyle := bsNone;
  WindowState := wsFullScreen;

  //WindowState := wsMaximized;
  //BoundsRect := Screen.Monitors[0].BoundsRect;

  OpenGLControl1.Align := alClient;
end;

{ キーが押された時の処理 }
procedure TForm1.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE: Application.Terminate;
    VK_R: fAngle := 0.0;
    else
      Application.Terminate;
  end;
end;

{ フォームが破棄される際の処理 }
procedure TForm1.FormDestroy(Sender: TObject);
begin
  // テクスチャを解放
  if fTexID <> 0 then
    glDeleteTextures(1, @fTexID);

  // タイマー精度を元に戻す。(Windows Only)
  timeEndPeriod(1);

  OpenGLControl1.Cursor := crDefault;
end;

{ 一定時間毎に呼ばれる処理。Timer1のOnTimerイベントに割り当て }
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // TOpenGLControlの再描画を要求
  OpenGLControl1.Invalidate;
end;

{ 板を描画 }
procedure TForm1.DrawPlane;
begin
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, fTexID);

  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

  //glEnable(GL_ALPHA_TEST);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_BLEND);
  glColor3f(1.0, 1.0, 1.0);

  glBegin(GL_QUADS);
  glTexCoord2f(0, 0);
  glVertex2f(0, 1);
  glTexCoord2f(1, 0);
  glVertex2f(1, 1);
  glTexCoord2f(1, 1);
  glVertex2f(1, 0);
  glTexCoord2f(0, 1);
  glVertex2f(0, 0);
  glEnd;

  glDisable(GL_TEXTURE_2D);
end;

{ 箱を描画 }
procedure TForm1.DrawCube;
const
  D: double = 0.5;
begin
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, fTexID);

  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

  //glEnable(GL_ALPHA_TEST);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_BLEND);
  glColor3f(1.0, 1.0, 1.0);

  glBegin(GL_QUADS);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(-0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(0.5, 0.5, 0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(-0.5, 0.5, 0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(-0.5, -0.5, -0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(-0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(0.5, -0.5, -0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(-0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(-0.5, 0.5, 0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(0.5, 0.5, 0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(0.5, 0.5, -0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(-0.5, -0.5, -0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(0.5, -0.5, -0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(-0.5, -0.5, 0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(0.5, -0.5, -0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(0.5, 0.5, 0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(0.5, -0.5, 0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(-0.5, -0.5, -0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(-0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(-0.5, 0.5, 0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(-0.5, 0.5, -0.5);
  glEnd();

  glDisable(GL_TEXTURE_2D);
end;

{ TOpenGLControlの描画処理 }
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
const
  InitGL: boolean = False;
var
  ct: DWORD;
  dt: double;
begin
  OpenGLControl1.MakeCurrent();

  if not InitGL then
  begin
    // OpenGL関係の初期化
    glDepthFunc(GL_LESS);
    glEnable(GL_DEPTH_TEST);
    //glShadeModel(GL_SMOOTH);
    glShadeModel(GL_FLAT);
    InitGL := True;
  end;

  // 前回からの時間差を取得
  ct := timeGetTime;
  dt := (ct - fLastTime) / 1000.0;  // 秒単位にする
  fLastTime := ct;

  // 角度を変更
  fAngle := fAngle + (90.0 * dt);
  //if fAngle >= 360.0 then
  //  fAngle := fAngle - 360.0;

  // 背景を消去
  glClearColor(0.0, 0.4, 0.2, 1.0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glLoadIdentity();

  // カメラを少し下げる
  glTranslatef(0.0, 0.0, -2.5);

  // 回転させる
  glRotatef(fAngle * 0.3, 1, 0, 0);
  glRotatef(fAngle, 0, 1, 0);

  // 表裏チェックをしない
  glDisable(GL_CULL_FACE);

  // 透過部分のテスト種類を指定
  glAlphaFunc(GL_GREATER, 0.5);
  glEnable(GL_ALPHA_TEST);

  // 板を描画
  DrawPlane;

  // 立方体を描画
  DrawCube;

  // ダブルバッファ切り替え
  OpenGLControl1.SwapBuffers;
end;

procedure TForm1.OpenGLControl1Resize(Sender: TObject);
begin
  ResizeGL;
end;

procedure TForm1.ResizeGL;
var
  Aspect: double;
begin
  OpenGLControl1.MakeCurrent();

  if OpenGLControl1.Height <= 0 then
    Exit;

  // 透視変換をするように設定
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  Aspect := OpenGLControl1.Width / OpenGLControl1.Height;
  gluPerspective(45.0, Aspect, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
end;

{ テクスチャ画像を読み込み。RGBA32bitにのみ対応 }
function TForm1.LoadTexture(const FileName: string): GLuint;
var
  srcimg: TPortableNetworkGraphic;
  dstimg: TLazIntfImage;
  texid: GLuint;
  rs: TResourceStream;
begin
  texid := 0;
  srcimg := TPortableNetworkGraphic.Create;
  dstimg := TLazIntfImage.Create(0, 0);
  rs := TResourceStream.Create(HINSTANCE, FileName, RT_RCDATA);

  try
    // ファイルから読み込み
    //srcimg.LoadFromFile(FileName);

    // リソースから読み込み
    srcimg.LoadFromStream(rs);

    dstimg.LoadFromBitmap(srcimg.Handle, srcimg.MaskHandle);

    glGenTextures(1, @texid);
    glBindTexture(GL_TEXTURE_2D, texid);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

    if dstimg.DataDescription.Depth = 32 then
    begin
      // RGBA 32bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, dstimg.Width, dstimg.Height,
        0, GL_BGRA, GL_UNSIGNED_BYTE, dstimg.PixelData);
    end
    else if dstimg.DataDescription.Depth = 24 then
    begin
      // RGB 24bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, dstimg.Width, dstimg.Height,
        0, GL_BGR, GL_UNSIGNED_BYTE, dstimg.PixelData);
    end;

    Result := texid;
  finally
    rs.Free;
    dstimg.Free;
    srcimg.Free;
  end;
end;

{ テクスチャ画像を読み込み。RGBA32bitにのみ対応。TPicture を使う版 }
function TForm1.LoadTexturePx(const FileName: string): GLuint;
var
  px: TPicture;
  texid: GLuint;
  rs: TResourceStream;
begin
  texid := 0;
  px := TPicture.Create;
  rs := TResourceStream.Create(HINSTANCE, FileName, RT_RCDATA);

  try
    // ファイルから読み込み
    //px.LoadFromFile(FileName);

    // リソースから読み込み
    px.LoadFromStream(rs);

    glGenTextures(1, @texid);
    glBindTexture(GL_TEXTURE_2D, texid);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

    if px.Bitmap.RawImage.Description.Depth = 32 then
    begin
      // RGBA 32bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, px.Width, px.Height,
        0, GL_BGRA, GL_UNSIGNED_BYTE, px.Bitmap.RawImage.Data);
    end
    else if px.Bitmap.RawImage.Description.Depth = 24 then
    begin
      // RGB 24bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, px.Width, px.Height,
        0, GL_BGRA, GL_UNSIGNED_BYTE, px.Bitmap.RawImage.Data);
    end;

    Result := texid;
  finally
    rs.Free;
    px.Free;
  end;
end;

end.

実行すると以下の見た目になる。




プロジェクトのオプションで、リソースに .png を追加した。リソース種類は RCDATA、識別名は TEXTURE、TEXTURE2、TEXTURE3 で追加された。

テクスチャが反映されなくて何時間もハマった…。原因は MakeCurrent を呼んでなかったことだった。こういう罠があったとは…。

_Qt の QOpenGLWidget::makeCurrent() を徹底解説! AI時代のエンジニアがハマる罠と解決策


Lazarus でpng画像を読み込むには、TPortableNetworkGraphic を使う方法や、TPicture を使う方法があるらしい。前者は png 画像の読み込みしかできない。後者は色々な画像フォーマットに対応している。もっとも、後者も内部的には TPortableNetworkGraphic を使ってるらしいけど…。ちなみに、どちらも使い終わったら .Free を呼んでメモリを解放しないといけない。

TPortableNetworkGraphic と TPicture で、RGB24bit のpngを読み込んだ際、glTexImage2D() に渡す値が違ってくるのがよく分からんけれど…。GL_BGRA と GL_BGR、どちらを渡せばいいのか…。

以下のソースが参考になった。

_OpenGLCoreTutorials/gltex.pas at master - neurolabusc/OpenGLCoreTutorials

また、以下のドキュメントも参考になった。

_Developing with Graphics - Free Pascal wiki


チュートリアル記事の _OpenGL Tutorial - Free Pascal wiki の中では LoadGLTextureFromFile というメソッドを使ってテクスチャ画像を読み込んでいるけれど、そのメソッドを利用するには Vampyre Imaging Library とやらが必要らしい。しかし、どうやってインストールすればいいのか分からない…。

_Vampyre Imaging Library Homepage
_Vampyre Imaging Library
_galfar/imaginglib: Object Pascal image loading, saving and manipulation library.

Lazarus IDE上でOpenGL関係のメソッドを記述していく際、一旦「 := 」が記述されるのがちょっと気になる…。

例えば glEnable() と書きたくて途中まで打って補完(Ctrl + Space)を使うと、一旦「glEnable := ;」と補完されてしまう。「 := 」の部分を削除してから続きを打ち込まないといけない。微妙に面倒臭い。

program JsonReadWrite2;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes { you can add units after this },
  SysUtils,
  fpjson,
  jsonparser;

type
  { 各アイテムのデータを保持するレコード型 }
  TMyRecord = record
    Name: string;
    Path: string;
    Args: string;
  end;

  { 配列アクセス用の型定義 }
  TMyRecordArray = array of TMyRecord;

  { 設定管理クラス }
  TMyConfig = class(TPersistent)
  private
    FItems: TMyRecordArray;
    FIndexed: integer;
    function GetItem(Index: integer): TMyRecord;
    procedure SetItem(Index: integer; const AValue: TMyRecord);
  public
    constructor Create;
    destructor Destroy; override;

    { --- JSON & ファイル操作 --- }
    function ToJsonString: string;
    procedure FromJsonString(const AJsonStr: string);
    procedure SaveToFile(const AFileName: string);
    procedure LoadFromFile(const AFileName: string);

    { --- データ操作メソッド (CRUD) --- }
    procedure AddItem(const AName, APath, AArgs: string);
    procedure UpdateItem(Index: integer; const AName, APath, AArgs: string);
    procedure RemoveItem(Index: integer);
    procedure ClearItems;
    function Count: integer;

    { --- 表示用プロシージャ --- }
    procedure PrintAll(const Msg: string);

    { --- プロパティ --- }
    property Items[Index: integer]: TMyRecord read GetItem write SetItem; default;
    property Indexed: integer read FIndexed write FIndexed;
  end;

  { --- TMyConfig クラスの実装 --- }

constructor TMyConfig.Create;
begin
  inherited Create;
  FIndexed := 0;
  SetLength(FItems, 0);
end;

destructor TMyConfig.Destroy;
begin
  SetLength(FItems, 0);
  inherited Destroy;
end;

function TMyConfig.GetItem(Index: integer): TMyRecord;
begin
  if (Index >= 0) and (Index < Length(FItems)) then
    Result := FItems[Index]
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds.', [Index]);
end;

procedure TMyConfig.SetItem(Index: integer; const AValue: TMyRecord);
begin
  if (Index >= 0) and (Index < Length(FItems)) then
    FItems[Index] := AValue
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds.', [Index]);
end;

procedure TMyConfig.AddItem(const AName, APath, AArgs: string);
var
  NewIdx: integer;
begin
  NewIdx := Length(FItems);
  SetLength(FItems, NewIdx + 1);
  FItems[NewIdx].Name := AName;
  FItems[NewIdx].Path := APath;
  FItems[NewIdx].Args := AArgs;
end;

procedure TMyConfig.UpdateItem(Index: integer; const AName, APath, AArgs: string);
begin
  if (Index >= 0) and (Index < Length(FItems)) then
  begin
    FItems[Index].Name := AName;
    FItems[Index].Path := APath;
    FItems[Index].Args := AArgs;
  end
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds for UpdateItem.',
      [Index]);
end;

procedure TMyConfig.RemoveItem(Index: integer);
begin
  if (Index >= 0) and (Index < Length(FItems)) then
  begin
    Delete(FItems, Index, 1);
  end
  else
    raise Exception.CreateFmt('Error: Index %d is out of bounds for RemoveItem.',
      [Index]);
end;

procedure TMyConfig.ClearItems;
begin
  SetLength(FItems, 0);
end;

function TMyConfig.Count: integer;
begin
  Result := Length(FItems);
end;

{ 一覧を出力するプロシージャ }
procedure TMyConfig.PrintAll(const Msg: string);
var
  i: integer;
begin
  WriteLn('--- ', Msg, ' ---');
  WriteLn(Format('Indexed: %d, Total Items: %d', [FIndexed, Count]));

  if Count = 0 then
    WriteLn('(No items)')
  else
  begin
    for i := 0 to Count - 1 do
    begin
      { Format関数を使って綺麗に整列させて出力 }
      WriteLn(Format('[%d] Name: %-15s | Path: %-20s | Args: %s',
        [i, FItems[i].Name, FItems[i].Path, FItems[i].Args]));
    end;
  end;
  WriteLn('----------------------------');
  WriteLn;
end;

function TMyConfig.ToJsonString: string;
var
  Root, ItemObj: TJSONObject;
  ItemsArr: TJSONArray;
  i: integer;
begin
  Root := TJSONObject.Create;
  try
    Root.Add('Indexed', FIndexed);
    ItemsArr := TJSONArray.Create;
    for i := 0 to High(FItems) do
    begin
      ItemObj := TJSONObject.Create;
      ItemObj.Add('Name', FItems[i].Name);
      ItemObj.Add('Path', FItems[i].Path);
      ItemObj.Add('Args', FItems[i].Args);
      ItemsArr.Add(ItemObj);
    end;
    Root.Add('Items', ItemsArr);
    Result := Root.FormatJSON;
  finally
    Root.Free;
  end;
end;

procedure TMyConfig.FromJsonString(const AJsonStr: string);
var
  JSONData: TJSONData;
  Root: TJSONObject;
  ItemsArr: TJSONArray;
  i: integer;
begin
  JSONData := GetJSON(AJsonStr);
  try
    if JSONData is TJSONObject then
    begin
      Root := TJSONObject(JSONData);
      FIndexed := Root.Get('Indexed', 0);

      if Root.Find('Items', JSONData) and (JSONData is TJSONArray) then
      begin
        ItemsArr := TJSONArray(JSONData);
        SetLength(FItems, ItemsArr.Count);
        for i := 0 to ItemsArr.Count - 1 do
        begin
          FItems[i].Name := ItemsArr.Objects[i].Get('Name', '');
          FItems[i].Path := ItemsArr.Objects[i].Get('Path', '');
          FItems[i].Args := ItemsArr.Objects[i].Get('Args', '');
        end;
      end;
    end;
  finally
    JSONData.Free;
  end;
end;

procedure TMyConfig.SaveToFile(const AFileName: string);
var
  L: TStringList;
begin
  L := TStringList.Create;
  try
    L.Text := ToJsonString;
    L.SaveToFile(AFileName);
  finally
    L.Free;
  end;
end;

procedure TMyConfig.LoadFromFile(const AFileName: string);
var
  L: TStringList;
begin
  if not FileExists(AFileName) then exit;
  L := TStringList.Create;
  try
    L.LoadFromFile(AFileName);
    FromJsonString(L.Text);
  finally
    L.Free;
  end;
end;

{ --- メインプログラム --- }

var
  Config: TMyConfig;
  FileName: string = 'settings.json';
begin
  Config := TMyConfig.Create;
  try
    { 1. 初期データの追加テスト }
    Config.AddItem('Lazarus', '/usr/bin/lazarus', '--version');
    Config.AddItem('Calculator', 'calc.exe', '');
    Config.AddItem('Notepad', 'notepad.exe', 'readme.txt');
    Config.Indexed := 100;
    Config.PrintAll('After Adding Items');

    { 2. 更新テスト }
    Config.UpdateItem(0, 'Lazarus IDE', '/opt/lazarus', '--debug');
    Config.PrintAll('After Updating Item[0]');

    { 3. 削除テスト }
    Config.RemoveItem(1); // Calculator を削除
    Config.PrintAll('After Removing Item[1]');

    { 4. ファイル保存と読み込みテスト }
    WriteLn('Saving to file: ', FileName);
    Config.SaveToFile(FileName);

    Config.ClearItems;
    Config.PrintAll('After Clear (Memory Empty)');

    WriteLn('Loading from file...');
    Config.LoadFromFile(FileName);
    Config.PrintAll('After Loading from File');

  except
    on E: Exception do
      WriteLn('Error: ', E.Message);
  end;

  Config.Free;
  WriteLn('Press Enter to quit.');
  ReadLn;
end.

--- After Adding Items ---
Indexed: 100, Total Items: 3
[0] Name: Lazarus         | Path: /usr/bin/lazarus     | Args: --version
[1] Name: Calculator      | Path: calc.exe             | Args:
[2] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

--- After Updating Item[0] ---
Indexed: 100, Total Items: 3
[0] Name: Lazarus IDE     | Path: /opt/lazarus         | Args: --debug
[1] Name: Calculator      | Path: calc.exe             | Args:
[2] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

--- After Removing Item[1] ---
Indexed: 100, Total Items: 2
[0] Name: Lazarus IDE     | Path: /opt/lazarus         | Args: --debug
[1] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

Saving to file: settings.json
--- After Clear (Memory Empty) ---
Indexed: 100, Total Items: 0
(No items)
----------------------------

Loading from file...
--- After Loading from File ---
Indexed: 100, Total Items: 2
[0] Name: Lazarus IDE     | Path: /opt/lazarus         | Args: --debug
[1] Name: Notepad         | Path: notepad.exe          | Args: readme.txt
----------------------------

Press Enter to quit.

{
  "Indexed" : 100,
  "Items" : [
    {
      "Name" : "Lazarus IDE",
      "Path" : "/opt/lazarus",
      "Args" : "--debug"
    },
    {
      "Name" : "Notepad",
      "Path" : "notepad.exe",
      "Args" : "readme.txt"
    }
  ]
}

コンソールアプリを作りたいのだから Lazarus の新規プロジェクト作成時に「コンソールアプリケーション」を選べばいいのだろうと安易に選んでみたら、オプション関係の処理まで行ってる、ちょっと難しそうな(?)プロジェクトが用意されてしまった…。そのほうがありがたい場面もあるだろうけど、今回は動作確認さえできればいいのであって…。

こういう場合は、「コンソールアプリケーション」ではなくて「プログラム」を選んだほうがいいかもしれない。「プログラム」なら、Delphi の「コンソールアプリケーション」と同程度の記述しかされてないプロジェクトを作れる。

「単純なプログラム」という種類もあるけれど、これは uses すら書かれていないソースが用意される模様。Pascal の文法等を勉強するだけなら都合がいいかもしれないけれど…。

fpjsonrtti というものもあって、これを使ってもクラスの内容をJSON化したりできるらしいけど…。動的配列の解析は苦手だからクラス内に record を含めてはいけない、とAIが言っている…。

TJsonConfig というものもあるらしい。これは JSONファイル内の一部に対していきなり読み書きができるっぽい？

_fcl-json - Free Pascal wiki