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

小泽zz 2005-06-11 07:57:16
感谢枕善居提供的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 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

...全文
398 21 打赏 收藏 转发到动态 举报
写回复
用AI写文章
21 条回复
切换为时间正序
请发表友善的回复…
发表回复
threenewbee 2005-08-17
  • 打赏
  • 举报
回复
学习
3q2008Com 2005-08-17
  • 打赏
  • 举报
回复
学习
YuyuanJian 2005-08-17
  • 打赏
  • 举报
回复
好东西
babymm 2005-07-08
  • 打赏
  • 举报
回复
好东西
xr105 2005-07-07
  • 打赏
  • 举报
回复
UP................
jxw111 2005-07-07
  • 打赏
  • 举报
回复
我也学了一招!
Freshmen007_Bug 2005-07-07
  • 打赏
  • 举报
回复
cool
newwish2 2005-07-07
  • 打赏
  • 举报
回复
资源共享~~
VsonChow 2005-07-07
  • 打赏
  • 举报
回复
对于资源分享的,一个字:顶。
AprilSea 2005-07-06
  • 打赏
  • 举报
回复
IORI915189 2005-07-06
  • 打赏
  • 举报
回复
引用:daisy8675(莫依)
实现这个功能的代码N前都有了。。。。
是的,高手肯定是N年前就有了 可是我们这些菜鸟没有... 顶
wosirius 2005-07-06
  • 打赏
  • 举报
回复
mm
hxy2003 2005-07-06
  • 打赏
  • 举报
回复
?
hyxgdzj 2005-07-01
  • 打赏
  • 举报
回复
关注中..
wyj7485 2005-07-01
  • 打赏
  • 举报
回复
又学了一招!
daisy8675 2005-07-01
  • 打赏
  • 举报
回复
实现这个功能的代码N前都有了。。。。
VirtualDesktop 2005-07-01
  • 打赏
  • 举报
回复
哈~ZX Messenger 就是我写的~~~~
小泽zz 2005-06-21
  • 打赏
  • 举报
回复
好代码````再顶
小泽zz 2005-06-14
  • 打赏
  • 举报
回复
再顶一下`````这么好的代码```哈哈
XenosPeng 2005-06-12
  • 打赏
  • 举报
回复
顶一下哈~~~
加载更多回复(1)

1,485

社区成员

发帖
与我相关
我的任务
社区描述
VB API
社区管理员
  • API
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧