透明化処理について (ID：83124)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

普段はソース載せないんだけど。。。

'*****Form1*****
Private Sub Form_Load()
    Dim nIndex As Long
    Me.BackColor = vbRed
    '赤色のみ透明
    nIndex = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
    dmy = SetWindowLong(Me.hwnd, GWL_EXSTYLE, nIndex Or WS_EX_LAYERED)
    dmy = SetLayeredWindowAttributes(Me.hwnd, ByVal vbRed, ByVal 0&, LWA_COLORKEY)
    'フォームの移動イベントを取得
    oad = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    Form2.Show
    Form2.Caption = Me.Caption
End Sub
'サブクラス化解除
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    dmy = SetWindowLong(Me.hwnd, GWL_WNDPROC, oad)
End Sub
'リサイズ対応
Private Sub Form_Resize()
    Form2.Move Left, Top, Width, Height
End Sub
'アンロード対応
Private Sub Form_Unload(Cancel As Integer)
    Unload Form2
End Sub
'*****Form2*****
Private Sub Form_Load()
    Dim nIndex As Long
    '半透明
    nIndex = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
    dmy = SetWindowLong(Me.hwnd, GWL_EXSTYLE, nIndex Or WS_EX_LAYERED)
    dmy = SetLayeredWindowAttributes(Me.hwnd, ByVal 0&, ByVal 150&, LWA_ALPHA)
End Sub
'アンロード対応
Private Sub Form_Unload(Cancel As Integer)
    Unload Form1
End Sub
'*****Module*****
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd&, ByVal nIndex&) As Long
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd&, ByVal crKey&, ByVal bAlpha&, ByVal dwFlags&) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd&, ByVal wMsg&, ByVal wParam&, lParam As Any) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal PWF&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam As Long) As Long
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2
Public Const GWL_EXSTYLE = (-20)
Public Const GWL_WNDPROC = (-4)
Public dmy&
Public oad&
Public Const WM_MOVE = &H3 
'フォーム移動対応
Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If uMsg = WM_MOVE Then
        With Form1
            Form2.Move .Left, .Top, .Width, .Height
        End With
    End If
    WindowProc = CallWindowProc(oad, hwnd, uMsg, wParam, lParam)
End Function

←解決時は質問者本人がここをチェックしてください。

戻る