[源码]让你的窗体象QQ那样，可以在在屏幕上方自动伸缩（感谢枕善居）

感谢枕善居提供的ZX Messenger,我本菜鸟，折腾了段时间，终于把这个功能的代码从ZX Messenger里分离出来！一个Form1,一个Module1,Form1上再添个Timer控件添加一个模块Module1，里面代码如下：Public Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal _
                                                  hWndInsertAfter As Long, ByVal x As Long, _
                                                  ByVal y As Long, ByVal cx As Long, ByVal cy As Long, _
                                                  ByVal wFlags As Long) As Long
Public MyRect As RECT, MyCur As POINTAPI
Public Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Public Type POINTAPI
        x As Long
        y As Long
End TypePublic Sub QQ(Myform As Form)''哈哈，我把它做成个函数，就可以到处引用了
On Error Resume Next
Dim dl As Long
dl = GetWindowRect(Myform.hWnd, MyRect)
dl = GetCursorPos(MyCur)
If (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Top <= 0 Then
  Myform.Top = 0
  Exit Sub
End If
If Not (PtInRect(MyRect, MyCur.x, MyCur.y)) And Myform.Top <= 0 Then
  Myform.Top = 0 - Myform.Height + 330 / 4
  Exit Sub
End If
End SubPublic Sub SetOnTop(xForm As Form) '窗体最顶,象QQ这样的窗体，必须最顶，不然有窗体遮住它且是最大化的，它缩上去屏幕上方，用鼠标指它，它也下不来的
SetWindowPos xForm.hWnd, -1, 0, 0, 0, 0, 3
End Sub'''''''''''''''''''''''''''''''''窗体里的代码
Private Sub Form_Load()
SetOnTop Me
End SubPrivate Sub Timer1_Timer()'Timer的Interval值设为500吧
Call QQ(Me)
End Sub