Родительское окно - форма Form1, дочернее - UserControl1
Копируется изображение формы, находящеестя под UserControl1
Неделю туплю... вместо нужного изображения формы получается "дыра"
Что не так?
- Код: Выделить всё
Option Explicit
'
'
'
'
Implements ISubclass
'
'
'
'
Private Const WM_ERASEBKGND As Long = &H14
Private Const WM_PAINT As Long = &HF&
'
'
'
'
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type SIZE
cx As Long
cy As Long
End Type
Private Type PAINTSTRUCT
hDC As Long
fErase As Long
rcPaint As RECT
fRestore As Long
fIncUpdate As Long
rgbReserved As Byte
End Type
'
'
'
'
Private Declare Function BitBlt Lib "gdi32.dll" ( _
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 Declare Function GetUpdateRect Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpRect As RECT, _
ByVal bErase As Long) As Long
Private Declare Function ValidateRect Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpRect As RECT) As Long
Private Declare Function BeginPaint Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpPaint As PAINTSTRUCT) As Long
Private Declare Function EndPaint Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpPaint As PAINTSTRUCT) As Long
Private Declare Function GetParent Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpRect As RECT) As Long
Private Declare Function GetClientRect Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpRect As RECT) As Long
Private Declare Function GetWindowExtEx Lib "gdi32.dll" ( _
ByVal hDC As Long, _
ByRef lpSize As SIZE) As Long
Private Declare Function GetWindowOrgEx Lib "gdi32.dll" ( _
ByVal hDC As Long, _
ByRef lpPoint As POINTAPI) As Long
Private Declare Function CopyRect Lib "user32.dll" ( _
ByRef lpDestRect As RECT, _
ByRef lpSourceRect As RECT) As Long
Private Declare Function GetWindowDC Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
Private Declare Function GetDC Lib "user32.dll" ( _
ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function GetDCOrgEx Lib "gdi32.dll" ( _
ByVal hDC As Long, _
ByRef lpPoint As POINTAPI) As Long
Private Declare Function ClientToScreen Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByRef lpPoint As POINTAPI) As Long
'
'
'
'
Private Function ISubclass_Callback(ByVal hWnd As Long, wMsg As Long, wParam As Long, lParam As Long, ByVal PrevProc As Long) As Long
Dim typPS As PAINTSTRUCT
Dim typPT As POINTAPI
Dim typParentPT As POINTAPI
Dim typRC As RECT
Dim typParentRC As RECT
Dim hWndParent As Long
Dim hDC As Long
Dim hDCParent As Long
Dim lngX As Long
Dim lngY As Long
Select Case wMsg
Case WM_PAINT
If (hWnd) Then
GetClientRect hWnd, typRC
hDC = GetDC(hWnd)
If (hDC) Then
hWndParent = GetParent(hWnd)
If (hWndParent) Then
GetWindowRect hWndParent, typParentRC
hDCParent = GetWindowDC(hWndParent)
If (hDCParent) Then
GetDCOrgEx hDC, typPT
GetDCOrgEx hDCParent, typParentPT
lngX = typPT.x - typParentPT.x
lngY = typPT.y - typParentPT.y
With typRC
BitBlt hDC, .Left, .Top, .Right, .Bottom, hDCParent, lngX, lngY, vbSrcCopy
End With
ReleaseDC hWnd, hDCParent
End If
End If
ReleaseDC hWnd, hDC
End If
End If
ISubclass_Callback = 0
Case Else
ISubclass_Callback = SubClasser.CallWindowProc(PrevProc, hWnd, wMsg, wParam, lParam)
End Select
End Function
'
'
'
'
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
If (Ambient.UserMode) Then SubClasser.AddSubclassHook hWnd, Me, DoNotTransfer
End Sub
Private Sub UserControl_Terminate()
SubClasser.RemoveSubclassHook hWnd
End Sub
Также прикрепил весь проект...