求类似于QQ窗体自动隐藏的代码，鼠标指向后能自动弹出

Question

我想做一个VB小程序，求类似于QQ窗体自动隐藏的代码，鼠标指向后能自动弹出，调试通过立即送高分。

Answer 1

OICQ聊天时的窗体自动隐藏功能，用VC 或CBC都可以很简单地实现，前几天看到有一则用CBC实现的例子，便想用VB实现一下，可惜当窗体上放满控件时，FORM的MOUSEMOVE事件不能很好地触发，所以只好用以下的笨办法，现把代码贴上，窗体上需放一TIMER控件，Interval属性为200。大伙如有好的意见，不妨贴出来，让我学习学习。 
Option ExplicitPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private 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 LongPrivate Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End TypePrivate Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Sub Form_Load()
'窗体放在最前面
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End SubPrivate Sub Timer1_Timer()
Dim p As POINTAPI
Dim f As RECT
GetCursorPos p '得到MOUSE位置
GetWindowRect Me.hwnd, f '得到窗体的位置
If Me.WindowState <> 1 Then
If p.X > f.Left And p.X < f.Right And p.Y > f.Top And p.Y < f.Bottom Then
'MOUSE 在窗体上 
If Me.Top < 0 Then
Me.Top = -10
Me.Show
ElseIf Me.Left < 0 Then
Me.Left = -10
Me.Show
ElseIf Me.Left + Me.Width >= Screen.Width Then
Me.Left = Screen.Width - Me.Width + 10
Me.Show
End IfElse
If f.Top <= 4 Then
Me.Top = 40 - Me.Height
ElseIf f.Left <= 4 Then
Me.Left = 40 - Me.Width
ElseIf Me.Left + Me.Width >= Screen.Width - 4 Then
Me.Left = Screen.Width - 40
End If
End If
End IfEnd Sub 
 
 
 

Answer 2

告诉我mail，我给你一个很酷的仿qq!

Answer 3

用time控件很浪费CPU资源的呀！
[email protected] mndsoft可以给我一份吗？

Answer 4

好的，我要仿QQ,我的信箱[email protected], 谢谢mndsoft(枕善居主) 。

Answer 5

我给你一个很酷的仿qq!
////
什麼東西， am之類，又不難，偶這還一份原碼，隻是不好玩

Answer 6

晚辈也要一份,谢了[email protected]

Answer 7

好的，我要仿QQ,我的信箱[email protected], 谢谢mndsoft(枕善居主) 。

Answer 8

mndsoft(枕善居主) 
可以也给偶来一份？
[email protected]

Answer 9

[email protected]
謝謝俺也想要一份

Answer 10

能否给偶一份，谢谢~~~
[email protected]

Answer 11

我也想要一份啊. [email protected]

Answer 12

我也想要仿QQ
 [email protected]

Answer 13

好东西应该拿出来共亨
我都要:[email protected]

Answer 14

以下是我做的程序的一部分，可能粘的不是完全'''''使窗体的关闭按钮无效
Const MF_REMOVE = &H1000&   '移除按钮
Const SC_CLOSE = &HF060     '关闭按钮 的ASC码
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
'准备用来使窗体始终在最前面
Private 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
Const HWND_TOPMOST = -1   '让窗体一直在上方的参数,
'获得鼠标指针在屏幕坐标上的位置
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
'获得窗口在屏幕坐标中的位置
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'判断指定的点是否在指定的巨型内部
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
 
Private Type POINTAPI   '当前鼠标的位置
        x As Long
        y As Long
End TypePrivate Type RECT       '当前窗体的位置
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End TypePrivate MyRect As RECT
Private MyPoint As POINTAPIPrivate max As Long   '窗口变长以后的尺寸(用户可随意改动)
'--------------------------
Sub Get_Windows_Rect()
Dim dl&  'max=390
max = 3105: Me.Height = max
Me.Top = 0      '窗体始终放在屏幕顶部
dl& = GetWindowRect(Me.hwnd, MyRect)
End SubPrivate Sub Form_Load()
'调用API使窗体的关闭按钮无效
RemoveMenu GetSystemMenu(Me.hwnd, 0), SC_CLOSE, MF_REMOVE
Dim pm     '调用API函数，使窗体一直在上面
pm = SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3) '负1代表把窗体至于上面
Get_Windows_Rect                 '调用确定窗体的位置的函数
End SubPrivate Sub Timer2_Timer()
   Dim dl&
   dl& = GetCursorPos(MyPoint)   '获得鼠标指针在屏幕坐标上的位置
   If (PtInRect(MyRect, MyPoint.x, MyPoint.y) And _
                Me.Height = max) Or MyPoint.y <= 20 Then '判断指定的点是否在指定的巨型内部
       Me.Height = max
   Else
       Me.Height = 30 '窗体变小
   End If
End Sub

Answer 15

mndsoft(枕善居主) 
可以也给偶来一份？
[email protected]