Мда ты меня заставил самому позаниматься этим...чесно никогда не работал с этим.
Во-первых зачем GetWindowRect(). Это лишнее используй свойства Picture1: Left, Top, Height, Width
Во-вторых
Dim pLeft, pWidth, PTop, pHeight As Long ' все переменные кроме pHeight типа Variant.
'Правильнее будет
Dim pLeft as Long, pWidth as Long, PTop as Long, pHeight As Long
'либо
Dim pLeft&, pWidth&, PTop&, pHeight&
То что на 3 больше - это вроде из-за использования этой апишки. Хотя возможно при переходах из Пикселей в Твипы.
Вообщем, если задача содрать кусок изображения с формы и засунуть в Picture1, то вот, что у меня выходит:
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Const SM_CXBORDER = 5
Private Const SM_CXFRAME = 32
Private Const SM_CYFRAME = 33
Private Const SM_CYBORDER = 6
Private Const SM_CYDLGFRAME = 8
Private Const SM_CXDLGFRAME = 7
Private Const SM_CYFIXEDFRAME = SM_CYDLGFRAME
Private Const SM_CXFIXEDFRAME = SM_CXDLGFRAME
Dim tPx, tPy As Long
Dim rc As RECT
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CYCAPTION = 4
Собственно фунцкция:
Private Sub UserControl_Paint()
Dim tRes As Long
Dim tLeft&, tTop&, tHei&, tWid&, tCap&, tXOfs&, tyOfs&
'On Error Resume Next
tPx = Screen.TwipsPerPixelX
tPy = Screen.TwipsPerPixelY
With UserControl
tCap = GetSystemMetrics(SM_CYCAPTION)
tRes = GetWindowRect(UserControl.hwnd, rc)
Select Case Parent.BorderStyle
Case Is = vbBSNone
tXOfs = 0
tyOfs = 0
tCap = 0
Case Is = vbSizable
tXOfs = GetSystemMetrics(SM_CXFRAME)
tyOfs = GetSystemMetrics(SM_CYFRAME)
Case Is = vbFixedSingle
tXOfs = GetSystemMetrics(SM_CXFIXEDFRAME)
tyOfs = GetSystemMetrics(SM_CYFIXEDFRAME)
End Select
tLeft = tPy * rc.Left - Parent.Left - tXOfs * tPy
tTop = tPx * rc.Top - Parent.Top - tPx * tCap - tyOfs * tPx
tHei = tPx * (-rc.Top + rc.Bottom)
tWid = tPy * (rc.Right - rc.Left)
.PaintPicture Parent.Picture, 0, 0, tWid, tHei, tLeft, tTop, tWid, tHei
End With
End Sub
Но почему-то при интенсивной работе с графикой(изменение Visible/Invislble массива Image) внутри контрола в разных вариациях Opaque/Trans, AutoRedraw(T/F) иногда мелькает белый цвет(не происходит отрисовка.
PS.
Не подскажете где найти нормальный контрол(не ОСХ) для Gif анимации?