VB 窗体在屏幕上方自动伸缩

一个Form1,一个Module1, Form1上再添个Timer控件 interval 为100

 

添加一个模块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   Type 

Public   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   Sub 

Public   Sub   SetOnTop(xForm   As   Form)   '窗体最顶,象QQ这样的窗体，必须最顶，不然有窗体遮住它且是最大化的，它缩上去屏幕上方，用鼠标指它，它也下不来的 
SetWindowPos   xForm.hWnd,   -1,   0,   0,   0,   0,   3 
End   Sub 

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '窗体里的代码 
Private   Sub   Form_Load() 
SetOnTop   Me 
End   Sub 

Private   Sub   Timer1_Timer() 'Timer的Interval值设为500吧 
Call   QQ(Me) 
End   Sub