ビルドンブング

自由でシンプルな生活を求めて試行錯誤する記録を毎日更新中

【VBA】ユーザーフォームのタイトルバーにアイコンを付ける

当ブログではアフィリエイト広告を利用しています

チャレンジしようとした人は多いのではないだろうか。
そして次のサイトに辿り着く。

liclog.net

 

確かに、このサイトに書いてある通りにすれば、ユーザーフォームにアイコンを設定することは可能だ。
けれど、サイト内でも触れられている通り、すべてのユーザーフォームに同じアイコンが設定されてしまう。
一度設定すると、解除するまではどのユーザーフォームを起動しても同じアイコンになってしまうのだ。

やはり、ツールによって、ユーザーフォームによって、異なるアイコンを設定したいところだろう。
SetParentで親ウインドウをデスクトップ(0)に設定して最小化ボタンや最大化ボタンをつければ、それはもう単体のアプリケーションウインドウと同じだ。
となれば、やはりアイコンもオリジナルにして個性を出したいところではないだろうか?
そうでもない?
私は趣味で作っているから、そういう欲求がある。

他の人がどうかは知らないけれど、とりあえずフォームごとに別々のアイコンを設定する方法はあるので、紹介する。

WM_SETICONを使えばいい。
WindowsAPIはいろいろと関数があるけれど、メインどころはほとんどSendMessageで代用できる。
(ウインドウではなくコントロールに対して行う場合は少し違うけれど)

例えば「SetWindowText」という関数があるけれど、WM_SETTEXTをSendMessageしてやるのと同じである。
特にVBAみたいにAPIを事前に宣言して使わないといけないような場合は、管理が煩雑になるので可能なものはSendMessageを使うように私はしている。
そうしておくとC言語でメッセージループを使う際に有利な気もする。

というわけで、アイコンをパラメータにしてWM_SETICONメッセージをSendしてやればいい。
※各種WindowsAPIの宣言は省略している

Sub SetIcon(fm As Object, Optional sPathIcon As String = "")
    Dim hWnd As LongPtr
    hWnd = FindWindow("ThunderDFrame", fm.Caption)
    If Dir(sPathIcon) = "" Or sPathIcon = "" Then
        SendMessage hWnd, WM_SETICON, 1, 0
    Else
        Dim hIcon As LongPtr
        hIcon = LoadImage(0, sPathIcon, IMAGE_ICON, 32, 32, LR_LOADFROMFILE)
        SendMessage hWnd, WM_SETICON, 1, hIcon
        If hIcon <> 0 Then DestroyIcon (hIcon)
    End If
End Sub

パスが存在しないか、空文字ならアイコンを解除するようにしておいた。
ユーザーフォームのQueryCloseイベントの最後に「SetIcon(Me)」と書いてやるだけで解除できる。
解除が必要なのかどうかはよくわからない。
DestroyIconは設定後すぐにしているから、別に解除しなくてもいいのかもしれない。
その辺りは謎だ。
これを読んだ有識者から意見をもらえると嬉しいけれど、期待はできない。

とりあえず、これでユーザーフォームに個別にアイコンを設定することは可能だ。
Inisiarizeイベント内に「SetIcon(Me,アイコンのアドレス)」を書くだけである。

やはりSendMessage。
SendMessageは全てを解決する。
ただしPostMessageとの使い分けはしっかりと理解して意識すること。