| |
Автор: Винокуров К.
Этот код показывает, как нарисовать тень от формы.
'КОД ФОРМЫ
Option Explicit
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Sub Form_Load()
SetParent picShadow.hwnd, GetDesktopWindow
SetProc hwnd
End Sub
'КОД МОДУЛЯ
Option Explicit
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal lngHandle As Long, ByVal lngMsg As Long, ByVal lngFirstParam As Long, ByVal lngLastParam As Long) As Long
Private Declare Function SetWindowLongA Lib "user32" (ByVal lngHandle As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private lngOldProc As Long
Public Sub SetProc(ByVal lngHandle As Long)
lngOldProc = SetWindowLongA(lngHandle, -4, AddressOf WinProc)
End Sub
Private Function WinProc(ByVal lngHandle As Long, ByVal lngMsg As Long, ByVal lngFirstParam As Long, ByVal lngLastParam As Long) As Long
If lngMsg = &H3 Then
frmMain.picShadow.Move frmMain.Left, frmMain.Top
DoEvents
BitBlt frmMain.picShadow.hDC, 0, 0, frmMain.picShadow.Width, frmMain.picShadow.Height, GetDC(0), frmMain.picShadow.Left / Screen.TwipsPerPixelX + 30, frmMain.picShadow.Top / Screen.TwipsPerPixelY + 30, vbSrcCopy
frmMain.picShadow.Line (0, 0)-(frmMain.picShadow.ScaleWidth, frmMain.picShadow.ScaleHeight), vbGrayText, BF
frmMain.picShadow.Move frmMain.Left + (30 * Screen.TwipsPerPixelX), frmMain.Top + (30 * Screen.TwipsPerPixelY), frmMain.Width, frmMain.Height
End If
WinProc = CallWindowProcA(lngOldProc, lngHandle, lngMsg, lngFirstParam, lngLastParam)
End Function
|
|