フォームを透明にする
'フォームのBorderStyleプロパティを「0-なし」に変更する。
'フォームに以下のコードを貼り付ける。
Option Explicit
'デバイスコンテキストのハンドル取得
Private Declare Function GetDC Lib "user32"
(ByVal hwnd As Long) As Long
'デスクトップハンドル取得
Private Declare Function GetDesktopWindow
Lib "user32" () As Long
'Rect構造体
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'デバイスコンテキストからデータをおくる
Private Declare Function BitBlt Lib "gdi32"
_
(ByVal hDestDC As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
'反転した転送元ビットマップを転送先ビットマップにコピーする
Private Const SRCCOPY = &HCC0020
'デバイスコンテキスト開放
Private Declare Function ReleaseDC Lib "user32"
(ByVal hwnd As Long, ByVal hdc As Long) As
Long
Private Type POINTAPI
X As Long
Y As Long
End Type
'クライアント座標をスクリーン座標に転換する
Private Declare Function ClientToScreen Lib
"user32" _
(ByVal hwnd As Long, _
lpPoint As POINTAPI) As Long
Private Sub Form_Activate()
Dim lngDTWHwnd As Long 'デスクトップのハンドルを取得する
Dim lngDTWDC As Long
Dim lngRet As Long
Dim PA As POINTAPI
'デスクトップハンドルを取得する
lngDTWHwnd = GetDesktopWindow
'デバイスコンテキスト取得
lngDTWDC = GetDC(lngDTWHwnd)
PA.X = 0
PA.Y = 0
'スクリーン座標に変換する
lngRet = ClientToScreen(Me.hwnd, PA)
'デバイスコンテキストより反転されたビットマップデータ転送
lngRet = BitBlt(Me.hdc, 0, 0, Me.Width, Me.Height,
lngDTWDC, PA.X, PA.Y, SRCCOPY)
'デバイスコンテキスト開放
lngRet = ReleaseDC(lngDTWHwnd, lngDTWDC)
End Sub
Private Sub Form_Load()
AutoRedraw = True
End Sub