VB实现窗体淡入淡出代码

ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function apiOleTranslateColor Lib "oleaut32" Alias "OleTranslateColor" ( _
Private Declare Function GetProp Lib "user32" Alias "GetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" ( _
ByVal hDC As Long) As Long
Private Declare Function FillRect Lib "user32" ( _
ByVal hDC As Long, _
lpRect As RECT, _
ByVal hBrush As Long) As Long
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
''注释:
''注释: AnimateWindow
Private Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long) As Long
Privat
e Declare Function SelectObject Lib "gdi32" ( _
首先你得有个FORM1,然后添加一个模块，写入下面：
Const GWL_WNDPROC = (-4)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
'注释： form background color
hBr = CreateSolidBrush(OleTranslateColor(oForm.BackColor))
'注释： Fill the DC with the
'注释: background Color
Select Case Msg
Case WM_PRINTCLIENT
Dim tRect As RECT
Dim hBr As Long
'注释： Get the window client size
GetClientRect hWnd, tRect
'注释： Create a brush with the
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Const PROP_PREVPROC = "PrevProc"
Const PROP_FORM = "FormObject"
ByVal ySrc As Long, _
ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" ( _
ByVal hWnd As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" ( _
SetWindowLong Form.hWnd, GWL_WNDPROC, AddressOf AnimateWinProc
'注释： Call AnimateWindow API
apiAnimateWindow Form.hWnd, dwTime, dwFlags
'注释： Unsubclass the window
SetWindowLong Form.hWnd, GWL_WNDPROC, GetProp(Form.hWnd, PROP_PREVPROC)
'注释： Remove the properties
RemoveProp Form.hWnd, PROP_FORM
RemoveProp Form.hWnd, PROP_PREVPROC
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 lOleColor As Long, _
ByVal lHPalette As Long, _
lColorRef As Long) As Long
Enum AnimateWindowFlags
AW_HOR_POSITIVE = &H1
AW_HOR_NEGATIVE = &H2
AW_VER_POSITIVE = &H4
AW_VER_NEGATIVE = &H8
AW_CENTER = &H10
AW_HIDE = &H10000
AW_ACTIVATE = &H20000
AW_SLIDE = &H40000
AW_BLEND = &H80000
Src As Any, _
ByVal DestL As Long)
Const WM_PRINTCLIENT = &H318
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetClientRect Lib "user32" ( _
Private Declare Function CreateSolidBrush Lib "gdi32" ( _
ByVal crColor As Long) As Long
Private Declare Function BitBlt Lib "gdi32" ( _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
Dim lPrevProc As Long
Dim lForm As Long
Dim oForm As Form
Private Declare Function SetProp Lib "user32" Alias "SetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long
ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
'注释： Get the previous WinProc pointer
lPrevProc = GetProp(hWnd, PROP_PREVPROC)
'注释： Get the form object
lForm = GetProp(hWnd, PROP_FORM)