如何在窗体显示时进行屏幕特效？

Question

金山词霸在显示时，会有个从中心扩散到正常窗体的特效，
扩散时，窗体大小没有变化，只是显示部分是从中心到窗体大小。
我也想实现类似的效果！

Answer 1

我只能从一点向两个方向长，不太好，希望对你有启发
Dim i As Integer
Dim j As Integer
Private Sub Form_Load()
Timer1.Interval = 1
End SubPrivate Sub Timer1_Timer()
If i < 5000 Then
i = i + 50
j = j + 50
Form1.Height = i
Form1.Width = j
End If
End Sub

Answer 2

是这个意思吗：
Const IDANI_OPEN = &H1
Const IDANI_CLOSE = &H2
Const IDANI_CAPTION = &H3
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
Private Declare Function SetRect Lib "User32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DrawAnimatedRects Lib "User32" (ByVal hWnd As Long, ByVal idAni As Long, lprcFrom As RECT, lprcTo As RECT) As Long
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: [email protected]
    Dim rSource As RECT, rDest As RECT, ScreenWidth As Long, ScreenHeight As Long
    'retrieve the screen width and height
    ScreenWidth = Screen.Width / Screen.TwipsPerPixelX
    ScreenHeight = Screen.Height / Screen.TwipsPerPixelY
    'set the source and destination rects
    SetRect rSource, ScreenWidth, ScreenHeight, ScreenWidth, ScreenHeight
    SetRect rDest, 0, 0, 200, 200
    'animate
    DrawAnimatedRects Me.hWnd, IDANI_CLOSE Or IDANI_CAPTION, rSource, rDest
    'set the form's position
    Me.Move 0, 0, 200 * Screen.TwipsPerPixelX, 200 * Screen.TwipsPerPixelY
End Sub

Answer 3

通过timer来控制窗体的width,height,left,top，用haohaohappy() 的方法简单易懂

Answer 4

我又改了一下，效果还不错
Dim i As Integer
Dim j As IntegerPrivate Sub Command1_Click()
Unload Me
End SubPrivate Sub Form_Load()
Timer1.Interval = 1
i = 405
j = 1680
End SubPrivate Sub Timer1_Timer()
If i < 5000 Then
i = i + 50
j = j + 50
Form1.Height = i
Form1.Width = j
Form1.Move Screen.Height / 2 - Form1.Height / 2, Screen.Width / 2 - Form1.Width / 2
End If
End Sub

Answer 5

'必须用API
'以下在模块中：
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Sub DeShrinkForm(ByRef frm As Form)
   Dim lngWin As Long
   Dim oldMode As Integer
   Dim wW As Integer, hH As Integer, hToW As Single
   Dim hfW    As Integer
   Dim hfH    As Integer
   Dim i      As Integer
   
   frm.ScaleMode = vbPixels
   
   wW = frm.ScaleWidth
   hH = frm.ScaleHeight
   hfW = wW \ 2
   hfH = hH \ 2
   hToW = hH / wW
   lngWin = CreateRectRgn(hfW - 1, hfW - 1, hfW + 1, hfW + 1)
   SetWindowRgn frm.hwnd, lngWin, True
   DeleteObject lngWin
   frm.Visible = True
   For i = hfW To -20 Step -1
      lngWin = CreateRectRgn(i, i * hToW, wW - i, hH - i * hToW)
      SetWindowRgn frm.hwnd, lngWin, True
      DeleteObject lngWin
      DoEvents
   Next
   lngWin = CreateRectRgn(0, 0, Screen.Width, Screen.Height)
   SetWindowRgn frm.hwnd, lngWin, True
   DeleteObject lngWin
   frm.ScaleMode = oldMode
End Sub
'以下窗体中
Private Sub Form_Initialize()
   DeShrinkForm Me
End Sub
'对函数DeShrinkForm 进一步修改，可以实现非常丰富的效果。