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
以下是我做的程序的一部分,可能粘的不是完全'''''使窗体的关闭按钮无效 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
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
[email protected] mndsoft可以给我一份吗?
////
什麼東西, am之類,又不難,偶這還一份原碼,隻是不好玩
可以也给偶来一份?
[email protected]
謝謝俺也想要一份
[email protected]
[email protected]
我都要:[email protected]
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
可以也给偶来一份?
[email protected]