如何以一定的动画效果来展开窗体？

Question

在加载窗体时想以一定的动画效果来显示，预备用下面这个函数来实现：
Private Declare Function AnimateWindow Lib "user32" (ByVal hWnd As Long, ByVal mytime As Long, ByVal style As Long) As BooleanPrivate Sub Form_Load()
outspread = AnimateWindow(Me.hWnd, 1000, 16)
Me.Refresh
'AnimateWindow 第一个参数是句柄
'AnimateWindow 第二个参数是打开的速度（值越大速度越慢，否则相反）
'AnimateWindow 第三个参数是打开的样式
'说明第三个参数
'0 没有模式
'1 从左向右展开
'2 从右向左展开
'4 从上向下
'5 从左上角到右下角
'6 从右上角到左下角
'8 从下向上
'9 从左下角到右上角
'10 从右下角到左上角
'16 从中间向四边张开
End Sub
AnimateWindow Me.hWnd,1000,16
Me.Refresh
现在的问题是，用这个函数可以实现窗体以一定的形式展开，但是展开的时候窗体是黑色的，且形式较为单一，请问，如何使得展开时窗体的颜色不为黑色，而为窗体本来的颜色呢？
另外有没有办法实现更好看的展开方式呢？比如窗体从无到有淡出，或者螺旋展开，就像ppT里面图片有很多好看的方式出现的，请指教，谢谢！

Answer 1

'AnimateWindow窗体动画,hwnd只对窗体有效
'dwtime  -- 是动画持续的时间，默认值为200；
'dwflags -- 是动画方式，可以取&H1、&H2、&H3、&H4、&H5、&H6、&H8、&H9、和&H10共8个值，分别代表左右、右左、上下、左上到右下、右上到左下、下上、左下到右上以及中间到四周等。
'AW_HIDE 在窗体卸载时若想使用本函数就得加上此常量
'AW_ACTIVATE 在窗体通过本函数打开后，默认情况下会失去焦点，除非加上本常量
'AW_SLIDE 窗体移动滑出滑入
'AW_BLEND 淡入淡出效果(适用于WIN2000)Private Declare Function AnimateWindow Lib "user32" (ByVal hwnd As Long, ByVal dwTime As Long, ByVal dwFlags As Long) As LongPrivate Const AW_HIDE = &H10000      '在窗体卸载时若想使用本函数就得加上此常量
Private Const AW_ACTIVATE = &H20000  '平常窗体出的方式,即突发式
Private Const AW_SLIDE = &H40000     '在窗体通过本函数打开后，默认情况下会失去焦点，除非加上本常量
Private Const AW_BLEND = &H80000     '渐入式，由透明逐渐出现
Private Const AW_CENTER = &H10       '由中心逐渐出现
Private Const AW_HOR_NEGATIVE = &H2  '由右至左渐出
Private Const AW_HOR_POSITIVE = &H1  '由左至右渐出
Private Const AW_VER_NEGATIVE = &H8  '由下到上渐出
Private Const AW_VER_POSITIVE = &H4  '由上到下渐出Private Sub Form_Load()    AnimateWindow hwnd, 1500, AW_CENTER Or AW_SLIDE Or AW_ACTIVATE   '中间向四周展开并获取焦点
    Me.RefreshEnd SubPrivate Sub Form_Unload(Cancel As Integer)    AnimateWindow hwnd, 1500, AW_BLEND Or AW_ACTIVATE Or AW_HIDE
    Me.Refresh
End Sub

Answer 2

这个貌似也是VB6的一个BUG,别的语言调用AnimateWindow时不会黑.你的其它效果不太好做,比较简单的方案是把你的窗体抓成图片,导入到FLASH中做效果,然后显示这个FLASH.我这里收藏了一个以前下载的代码,是使用子类化重绘窗体,但刚刚试了一下,AW_BLEND样式正常,AW_CENTER样式只能让窗体不黑,却没有正常的显示效果了.另外,如果仅是AW_BLEND样式,可以自己用个循环加上SetLayeredWindowAttributes函数来完成之.

Answer 3

Option ExplicitConst 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 LongConst 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 LongPrivate Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
        Dest As Any, _
        Src As Any, _
        ByVal DestL As Long)Const WM_PRINTCLIENT = &H318Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End TypePrivate Declare Function GetClientRect Lib "user32" ( _
        ByVal hWnd As Long, _
        lpRect As RECT) As LongPrivate Declare Function apiOleTranslateColor Lib "oleaut32" Alias "OleTranslateColor" ( _
        ByVal lOleColor As Long, _
        ByVal lHPalette As Long, _
        lColorRef As Long) As LongEnum 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 EnumPrivate Declare Function apiAnimateWindow Lib "user32" Alias "AnimateWindow" ( _
        ByVal hWnd As Long, _
        ByVal dwTime As Long, _
        ByVal dwFlags As Long) As LongPrivate Declare Function MulDiv Lib "kernel32" ( _
        ByVal Mul As Long, _
        ByVal Nom As Long, _
        ByVal Den As Long) As LongPrivate 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 LongPrivate 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 LongPrivate 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
'
Public 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.RefreshEnd 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.TwipsPerPixelXEnd Function'
'   OleTranslateColor
'
'   Wrapper   for   OleTranslateColor   API
'
Private Function OleTranslateColor(ByVal Clr As Long) As Long
    apiOleTranslateColor Clr, 0, OleTranslateColor
End Function
调用:
Call AnimateWindow(Me, 500, AW_BLEND)