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

概述一个Form1,一个Module1, Form1上再添个Timer控件 interval 为100   添加一个模块Module1，里面代码如下：  Public   Declare   Function   GetWindowRect   Lib   "user32 "   (ByVal   hWnd   As   Long,   lpRect   As   RECT)   As   Long 

一个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.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,3 End Sub ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '窗体里的代码 Private Sub Form_Load() Setontop Me End Sub Private Sub Timer1_Timer() 'Timer的Interval值设为500吧 Call QQ(Me) End Sub 总结

以上是内存溢出为你收集整理的VB 窗体在屏幕上方自动伸缩全部内容，希望文章能够帮你解决VB 窗体在屏幕上方自动伸缩所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。