为何我用GetCursorPos得到的鼠标位置和计算的鼠标位置有这么大的差距!!!

huang_yi_cn 2003-08-25 09:51:15
我在我的control中想通过计算无hWnd控件的各个点的位置来确定鼠标是否在该控件区域内,却发现GetCursorPos得到的鼠标位置和计算的鼠标位置不一样,下面是我程序的原码,请大家帮忙参考。谢谢!!!
Private m_frmParent As Form
Private m_Left As Long
Private m_Top As Long
Private m_Right As Long
Private m_Bottom As Long

Private m_Point As POINTAPI

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
'我的control只在form中,不在form中的其它容器内
Set m_frmParent = UserControl.Extender.Parent

With m_frmParent
m_Left = .Left / Screen.TwipsPerPixelX
m_Top = .Top / Screen.TwipsPerPixelY

End With

With UserControl.Extender
If m_frmParent.ScaleMode = vbTwips Then
m_Left = m_Left + .Left / Screen.TwipsPerPixelX
m_Top = m_Top + .Top / Screen.TwipsPerPixelY

ElseIf m_frmParent.ScaleMode = vbPixels Then
m_Left = m_Left + .Left
m_Top = m_Top + .Top

End If

End With

With Label1
m_Left = m_Left + .Left
m_Top = m_Top + .Top

m_Right = m_Left + .Width
m_Bottom = m_Top + .Height

End With

Call GetCursorPos(m_Point)

If (m_Point.x > m_Left And m_Point.y < m_Right) And _
(m_Point.y > m_Top And m_Point.y < m_Bottom) Then

Label1.BackColor = vbRed
Label1.Caption = "mouse is in client"

Else

Label1.BackColor = vbBlue
Label1.Caption = "mouse is not in client"

End If

End Sub


...全文
124 9 打赏 收藏 转发到动态 举报
写回复
用AI写文章
9 条回复
切换为时间正序
请发表友善的回复…
发表回复
James0001 2003-08-26
  • 打赏
  • 举报
回复
GetCursorPos 返回的是屏幕坐标,要把它转换成客户区坐标,并作相应单位转换(ScaleX, ScaleY 什么的)后才能进行比较。


屏幕坐标和客户区坐标之间的换算是乘或除15
----------------------------------------
错了,应该是:
像素 和 缇 的换算是乘或除15(具体情况要看设备和用户设置而定)
rainstormmaster 2003-08-26
  • 打赏
  • 举报
回复
ScreenToClient不光是单位的换算,还涉及坐标轴的变换
hxy2003 2003-08-25
  • 打赏
  • 举报
回复
UP
danielinbiti 2003-08-25
  • 打赏
  • 举报
回复
m_Left = .Left / Screen.TwipsPerPixelX
m_Top = .Top / Screen.TwipsPerPixelY

这个坐标错了,这个得到的不是窗体在屏幕上的坐标
用getwindowrect
获得整个窗口的范围矩形,窗口的边框、标题栏、滚动条及菜单等都在这个矩形内
【返回值】
Long,非零表示成功,零表示失败
danielinbiti 2003-08-25
  • 打赏
  • 举报
回复
m_Left = .Left / Screen.TwipsPerPixelX
m_Top = .Top / Screen.TwipsPerPixelY

这个坐标错了,这个得到的不是窗体在屏幕上的坐标
用getwindowrect
获得整个窗口的范围矩形,窗口的边框、标题栏、滚动条及菜单等都在这个矩形内
【返回值】
Long,非零表示成功,零表示失败
liul17 2003-08-25
  • 打赏
  • 举报
回复
给你几个例子,你看看有没有用
'//第1个示例
'This project needs
'a Form, called 'Form1'
'a Picture Box, called 'ExplButton' (50x50 pixels)
'a Picture Box with an icon in it, called 'picIcon'
'two timers (Timer1 and Timer2), both with interval 100
'Button, called 'Command1'
'In general section
Private 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 Type
'Declare the API-Functions
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Sub DrawButton(Pushed As Boolean)
Dim Clr1 As Long, Clr2 As Long
If Pushed = True Then
'If Pushed=True then clr1=Dark Gray
Clr1 = &H808080
'If Pushed=True then clr1=White
Clr2 = &HFFFFFF
ElseIf Pushed = False Then
'If Pushed=True then clr1=White
Clr1 = &HFFFFFF
'If Pushed=True then clr1=Dark Gray
Clr2 = &H808080
End If
With Form1.ExplButton
' Draw the button
Form1.ExplButton.Line (0, 0)-(.ScaleWidth, 0), Clr1
Form1.ExplButton.Line (0, 0)-(0, .ScaleHeight), Clr1
Form1.ExplButton.Line (.ScaleWidth - 1, .ScaleHeight - 1)-(.ScaleWidth - 1, 0), Clr2
Form1.ExplButton.Line (.ScaleWidth - 1, .ScaleHeight - 1)-(0, .ScaleHeight - 1), Clr2
End With
End Sub
Private Sub Command1_Click()
Dim Rec As RECT
'Get Left, Right, Top and Bottom of Form1
GetWindowRect Form1.hwnd, Rec
'Set Cursor position on X
SetCursorPos Rec.Right - 15, Rec.Top + 15
End Sub
Private Sub ExplButton_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton True
End Sub
Private Sub ExplButton_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton False
End Sub
Private Sub ExplButton_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
DrawButton False
End Sub
Private Sub Form_Load()
Dim Stretched As Boolean
'picIcon.Visible = False
'API uses pixels
picIcon.ScaleMode = vbPixels
'No border
ExplButton.BorderStyle = 0
'API uses pixels
ExplButton.ScaleMode = vbPixels
'Set graphic mode te 'persistent graphic'
ExplButton.AutoRedraw = True
'API uses pixels
Me.ScaleMode = vbPixels
'Set the button's caption
Command1.Caption = "Set Mousecursor on X"
' If you set Stretched to true then stretch the icon to te Height and Width of the button
' If Stretched=False, the icon will be centered
Stretched = False
If Stretched = True Then
' Stretch the Icon
ExplButton.PaintPicture picIcon.Picture, 1, 1, ExplButton.ScaleWidth - 2, ExplButton.ScaleHeight - 2
ElseIf Stretched = False Then
' Center the picture of the icon
ExplButton.PaintPicture picIcon.Picture, (ExplButton.ScaleWidth - picIcon.ScaleWidth) / 2, (ExplButton.ScaleHeight - picIcon.ScaleHeight) / 2
End If
' Set icon as picture
ExplButton.Picture = ExplButton.Image
End Sub
Private Sub Timer1_Timer()
Dim Rec As RECT, Point As POINTAPI
' Get Left, Right, Top and Bottom of Form1
GetWindowRect Me.hwnd, Rec
' Get the position of the cursor
GetCursorPos Point
' If the cursor is located above the form then
If Point.X >= Rec.Left And Point.X <= Rec.Right And Point.Y >= Rec.Top And Point.Y <= Rec.Bottom Then
Me.Caption = "MouseCursor is on form."
Else
' The cursor is not located above the form
Me.Caption = "MouseCursor is not on form."
End If
End Sub
Private Sub Timer2_Timer()
Dim Rec As RECT, Point As POINTAPI
' Get Left, Right, Top and Bottom of ExplButton
GetWindowRect ExplButton.hwnd, Rec
' Get the position of the cursor
GetCursorPos Point
' If the cursor isn't located above ExplButton then
If Point.X < Rec.Left Or Point.X > Rec.Right Or Point.Y < Rec.Top Or Point.Y > Rec.Bottom Then ExplButton.Cls
End Sub

'//第2个示例
'This Project needs
'- two timers, interval=100
'- a button
'in general section
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Sub Form_Load()
Timer1.Interval = 100
Timer1.Enabled = True
Timer2.Interval = 100
Timer2.Enabled = True
Command1.Caption = "Draw Text"
End Sub
'This will draw an Ellipse on the active window
Sub Timer1_Timer()
Dim Position As POINTAPI
'Get the cursor position
GetCursorPos Position
'Draw the Ellipse on the Screen's DC
Ellipse GetWindowDC(0), Position.x - 5, Position.y - 5, Position.x + 5, Position.y + 5
End Sub
Sub Command1_Click()
Dim intCount As Integer, strString As String
strString = "Cool, text on screen !"
For intCount = 0 To 30
'Draw the text on the screen
TextOut GetWindowDC(0), intCount * 20, intCount * 20, strString, Len(strString)
Next intCount
End Sub
Private Sub Timer2_Timer()
'Draw the text to the active window
TextOut GetWindowDC(GetActiveWindow), 50, 50, "This is a form", 14
End Sub

luckygjl 2003-08-25
  • 打赏
  • 举报
回复
屏幕坐标和客户区坐标之间的换算是乘或除15
rainstormmaster 2003-08-25
  • 打赏
  • 举报
回复
要用ScreenToClient把屏幕坐标转换为客户区坐标
huang_yi_cn 2003-08-25
  • 打赏
  • 举报
回复
m_Left = .Left / Screen.TwipsPerPixelX
m_Top = .Top / Screen.TwipsPerPixelY
这个是没有错的,不信你可以去试一试,Screen的ScaleMode总是Twips

1,451

社区成员

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

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