『透明Form（らしきもの^^;）for.VB』
Option Explicit
Private Type wuRECT
x1 As Long
y1 As Long
x2 As Long
y2 As Long
End Type
Private Declare Function wuGetWindowRect Lib "User32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As wuRECT) As Long
Private Declare Function wuGetDC Lib "User32" Alias "GetDC" (ByVal hWnd As Long) As Long
Private Declare Function wuReleaseDC Lib "User32" Alias "ReleaseDC" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function wuMoveWindow Lib "User32" Alias "MoveWindow" (ByVal hwin&, ByVal X&, ByVal Y&, ByVal dx&, ByVal dy&, ByVal fRepaint%) As Long
Private Declare Function wuStretchBlt Lib "gdi32" Alias "StretchBlt" (ByVal hDC 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function wuGetSystemMetrics Lib "User32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4
Private Const SM_CYBORDER = 6
Private Const SM_CYDLGFRAME = 8
Private Const SM_CYFRAME = 33
Private posX1&
Private posX2&
Private posY1&
Private posY2&
'***********************************************
Private Sub hpWindow()
'** 要form.AutoReadraw = True
Dim rDesk As wuRECT
Dim dx&, dy&
Dim X&, Y&
Dim hy&
Dim hDCScreen&
Call wuGetWindowRect(Me.hWnd, rDesk)
dx& = rDesk.x2 - rDesk.x1
dy& = rDesk.y2 - rDesk.y1
X& = rDesk.x1
Y& = rDesk.y1
hy& = 0
hy& = hy& + wuGetSystemMetrics(SM_CYCAPTION)
Select Case Me.BorderStyle
'*** ↓ココちょっと自信なしですぅ^^;;;;
'*** ↓VBのFormのStyleってもっとありましたっけ？
Case vbFixedSingle
hy& = hy& + wuGetSystemMetrics(SM_CYBORDER)
Case vbSizable
hy& = hy& + wuGetSystemMetrics(SM_CYFRAME)
Case vbFixedDialog
hy& = hy& + wuGetSystemMetrics(SM_CYDLGFRAME)
End Select
Call wuMoveWindow(Me.hWnd, 0 - dx&, 0 - dy&, dx&, dy&, True)
DoEvents '*** ←適当ですぅ^^;
DoEvents
DoEvents
hDCScreen = wuGetDC(0)
wuStretchBlt Me.hDC, 0, 0, dx&, dy&, _
hDCScreen, X, Y + hy&, dx&, dy&, SRCCOPY
wuReleaseDC 0, hDCScreen
Call wuMoveWindow(Me.hWnd, X&, Y&, dx&, dy&, True)
Exit Sub
End Sub
'***********************************************
Private Sub Timer1_Timer()
'***
'*** タイマーで、WindowのPosが変化した際に、
'*** 再描写って感じですぅ〜
'*** （Paintイベントって良くわかんないのでぇ〜）
Dim rDesk As wuRECT
Call wuGetWindowRect(Me.hWnd, rDesk)
If posX1 <> rDesk.x1 Or _
posX2 <> rDesk.x2 Or _
posY1 <> rDesk.y1 Or _
posY2 <> rDesk.y2 Then
Call hpWindow
posX1 = rDesk.x1
posX2 = rDesk.x2
posY1 = rDesk.y1
posY2 = rDesk.y2
End If
End Sub
'-------------------
/e
|