首先你得有个FORM1,然后添加一个模块,写入下面:
Const GWL_WNDPROC = (-4)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _
ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Const PROP_PREVPROC = "PrevProc"
Const PROP_FORM = "FormObject"
Private Declare Function SetProp Lib "user32" Alias "SetPropA" ( _
ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal hData As Long) As Long
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 hWnd As Long, _
ByVal lpString As String) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
Dest As Any, _
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" ( _
ByVal hWnd As Long, _
lpRect As RECT) As Long
Private Declare Function apiOleTranslateColor Lib "oleaut32" Alias "OleTranslateColor" ( _
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
End Enum
Private Declare Function apiAnimateWindow Lib "user32" Alias "AnimateWindow" ( _
ByVal hWnd As Long, _
ByVal dwTime As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function MulDiv Lib "kernel32" ( _
ByVal Mul As Long, _
ByVal Nom As Long, _
ByVal Den As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" ( _
ByVal crColor 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 Declare Function CreateCompatibleDC Lib "gdi32" ( _
ByVal hDC As Long) As Long
Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" ( _
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
Private Declare Function DeleteObject Lib "gdi32" ( _
ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" ( _
ByVal hDC As Long, _
ByVal hObject As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _
ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long
''注释:
''注释: AnimateWindow
''注释:
''注释: Wrapper for AnimateWindow api
'注释:
Sub AnimateWindow( _
ByVal Form As Form, _
ByVal dwTime As Long, _
ByVal dwFlags As AnimateWindowFlags)
'注释: Set the properties
SetProp Form.hWnd, PROP_PREVPROC, GetWindowLong(Form.hWnd, GWL_WNDPROC)
SetProp Form.hWnd, PROP_FORM, ObjPtr(Form)
'注释: Subclass the window
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
'注释: Refresh the form
Form.Refresh
End Sub
'注释:
'注释: AnimateWinProc
'注释:
'注释: Window procedure for AnimateWindow
'注释:
Private Function AnimateWinProc( _
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
'注释: Get the previous WinProc pointer
lPrevProc = GetProp(hWnd, PROP_PREVPROC)
'注释: Get the form object
lForm = GetProp(hWnd, PROP_FORM)
MoveMemory oForm, lForm, 4&
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
'注释: form background color
hBr = CreateSolidBrush(OleTranslateColor(oForm.BackColor))
'注释: Fill the DC with the
'注释: background Color
FillRect wParam, tRect, hBr
'注释: Delete the brush
DeleteObject hBr
If Not oForm.Picture Is Nothing Then
Dim lScrDC As Long
Dim lMemDC As Long
Dim lPrevBMP As Long
'注释: Create a compatible DC
lScrDC = GetDC(0&)
lMemDC = CreateCompatibleDC(lScrDC)
ReleaseDC 0, lScrDC
'注释: Select the form picture in the DC
lPrevBMP = SelectObject(lMemDC, oForm.Picture.Handle)
'注释: Draw the picture in the DC
BitBlt wParam, _
0, 0, _
HM2Pix(oForm.Picture.Width), HM2Pix(oForm.Picture.Height), _
lMemDC, 0, 0, vbSrcCopy
'注释: Release the picture
SelectObject lMemDC, lPrevBMP
'注释: Delete the DC
DeleteDC lMemDC
End If
End Select
'注释: Release the form object
MoveMemory oForm, 0&, 4&
'注释: Call the original window procedure
AnimateWinProc = CallWindowProc(lPrevProc, hWnd, Msg, wParam, lParam)
End Function
'注释:
'注释: HM2Pix
'注释:
'注释: Converts HIMETRIC to Pixel
'注释:
Private Function HM2Pix(ByVal Value As Long) As Long
HM2Pix = MulDiv(Value, 1440, 2540) / Screen.TwipsPerPixelX
End Function
'注释:
'注释: OleTranslateColor
'注释:
'注释: Wrapper for OleTranslateColor API
'注释:
Private Function OleTranslateColor(ByVal Clr As Long) As Long
apiOleTranslateColor Clr, 0, OleTranslateColor
End Function
...........................................................................
在form1的unload里面写入
Private Sub Form_Unload(Cancel As Integer)
AnimateWindow Me, 1000, &H80000 + &H10000
Set Form1 = Nothing
End Sub
...............................运行,关闭看看特效。。窗口隐身而出。。。没有的话,联系我。。呵呵 我是KELVIN,联系我
Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As Long
其中:
hwnd只对Form有效,其他像Picture1都无法产生效果。
dwTime是动画持续的时间,默认为200。
dwFlags可取以下值:
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) '淡入淡出效果
温馨提示:答案为网友推荐,仅供参考