こじんてきメモ

趣味とか...(╹◡╹)

VBA フォームの色を透明にする

WindowsAPIを使うことで、フォーム内の特定の色を透過させることができる。

①まずは
・FindWindowA
・GetWIndowLongA
・SetWindowLongA
を使って、透過するウィンドウのIDをLONG型で取得する。

②次に、取得したウィンドウにSetLayeredWindowAttributesを使って、アルファ値(透過度)を掛け合わせたウィンドウにする。

これだけで透過できる。

Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
 
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
'SetLayeredWindowAttributes用
Private Const LWA_ALPHA = &H2&
Private Const LWA_COLORKEY = &H1&

Public hWnd As Long
Private Sub CommandButton1_Click()
    hWnd = FindWindow("ThunderDFrame", Me.Caption)
    
    Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED)
    Call SetLayeredWindowAttributes(Me.hWnd, 0, 100, LWA_COLORKEY)

End Sub
SetLayeredWindowAttributes(hwnd, crKey, bAlpha, dwFlags)

SetLayeredWindowAttributesが、解説サイトをみてもいまいちわからなかったので仕様を見てみた。
docs.microsoft.com

dwFlagsの値で以下のように変わるようだ。

LWA_ALPHA ウィンドウ全体が透過する
LWA_COLORKEY crKeyで指定した色で透過する。

※crKeyはDWORD型らしい。


以下はフォームを黒くして、黒で透過した場合のもの。壁紙も黒なのでちょっとわかりにくいが、アイコンが透過して見えているのがわかると思う。「フォーム内の特定の色」なので、基本的にフォーム上にあるボタンやラベルも透過する。
f:id:hmmr:20200509104117p:plain
f:id:hmmr:20200509104202p:plain

しかし、WMPコントロールの中までは透過してくれなかった。

以下は自分用です。
docs.microsoft.com
docs.microsoft.com
docs.microsoft.com