拉幕效果出現的窗體

Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
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

Dim MyRect As Long
Dim MyRgn As Long

Dim X1 As Integer, Y1 As Integer
Dim X2 As Integer, Y2 As Integer
Dim OpenSpeed As Integer

Private Sub Form_Load()
  X1 = Me.Width / Screen.TwipsPerPixelX / 2 - 1
  Y1 = 0
 
  X2 = Me.Width / Screen.TwipsPerPixelX / 2 + 1
  Y2 = Me.Height / Screen.TwipsPerPixelY
 
  MyRect = CreateRectRgn(X1, Y1, X2, Y2)
  MyRgn = SetWindowRgn(Me.hWnd, MyRect, True)
 
  OpenSpeed = 5          '速度
  Timer1.Interval = 10   '平滑度
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Call DeleteObject(MyRect)
End Sub

Private Sub Timer1_Timer()
  X1 = X1 - OpenSpeed
  X2 = X2 + OpenSpeed
 
  If X1 <= 0 Then
 
    MyRect = CreateRectRgn(0, 0, Me.Width / Screen.TwipsPerPixelX, Y2)
    MyRgn = SetWindowRgn(Me.hWnd, MyRect, True)
   
    Timer1.Enabled = False

  End If
 
  MyRect = CreateRectRgn(X1, Y1, X2, Y2)
  MyRgn = SetWindowRgn(Me.hWnd, MyRect, True)
End Sub