VB API如何获取鼠标在某一控件中的绝对坐标位置值?
我在VB窗体中加一个PictureBox控件,并想用API函数获取鼠标在这个图片控件中的坐标不是屏幕的坐标。原代码为:PrivateSubPicture2_MouseDo...
我在VB窗体中加一个PictureBox控件,并想用API函数获取鼠标在这个图片控件中的坐标不是屏幕的坐标。原代码为:
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.Refresh
Picture2.Line (startx, starty)-(X, Y) '显示橡皮筋效果
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
End Sub
我想改为像CAD那样的画线,用鼠标单击第一次左键时记住起点,单击第二次左键时画线,在单击第二次出移动鼠标不按钮时还是显示橡皮筋效果,我改的是:
Private Sub Picture3_Click()
Call draw_line
End Sub
Private Sub draw_line()
If line_state = 1 Then
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
line_state = 2
ElseIf line_state = 2 Then
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
line_state = 1
End If
Picture2.Refresh '画出最后确认的直线
Picture2.Line (startx, starty)-(X, Y)
End Sub
感觉差个API获得鼠标坐标的值,不会了,请高手指教,本人是初学者请附个程序,先谢了! 展开
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.Refresh
Picture2.Line (startx, starty)-(X, Y) '显示橡皮筋效果
End Sub
Private Sub Picture2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
End Sub
我想改为像CAD那样的画线,用鼠标单击第一次左键时记住起点,单击第二次左键时画线,在单击第二次出移动鼠标不按钮时还是显示橡皮筋效果,我改的是:
Private Sub Picture3_Click()
Call draw_line
End Sub
Private Sub draw_line()
If line_state = 1 Then
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
line_state = 2
ElseIf line_state = 2 Then
endx = X '记住终止点
endy = Y
Picture2.AutoRedraw = True
Picture2.Line (startx, starty)-(endx, endy) '最终画线
line_state = 1
End If
Picture2.Refresh '画出最后确认的直线
Picture2.Line (startx, starty)-(X, Y)
End Sub
感觉差个API获得鼠标坐标的值,不会了,请高手指教,本人是初学者请附个程序,先谢了! 展开
3个回答
展开全部
在你的窗体代码最顶上(那就第一行吧,其实就是“声明”那里),加入以下代码:
Private Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function ClientToScreen Lib "user32" Alias "ClientToScreen" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
然后呢,我告诉你取鼠标相对控件位置的方法(注意注意:这里取得的坐标是以像素为单位的!!!而VB默认单位是“缇”即Twips。1像素=15缇):
Dim MousePos As POINTAPI
GetCursorPos MousePos
ClientToScreen 控件名.hWnd, MousePos
完了以后,MousePos.x和MousePos.y就是鼠标相对控件的位置的横纵坐标。去掉“ClientToScreen 控件名.hWnd, MousePos”这句,就是取鼠标在屏幕上的位置。
你原来的代码里有
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
这个过程。实际上,这里的X和Y是鼠标在容器(控件)内的位置,以“缇”为单位。要转化成像素(Pixel),你得把原坐标的横纵值除以15.
Private Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function ClientToScreen Lib "user32" Alias "ClientToScreen" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Public Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI) As Long
然后呢,我告诉你取鼠标相对控件位置的方法(注意注意:这里取得的坐标是以像素为单位的!!!而VB默认单位是“缇”即Twips。1像素=15缇):
Dim MousePos As POINTAPI
GetCursorPos MousePos
ClientToScreen 控件名.hWnd, MousePos
完了以后,MousePos.x和MousePos.y就是鼠标相对控件的位置的横纵坐标。去掉“ClientToScreen 控件名.hWnd, MousePos”这句,就是取鼠标在屏幕上的位置。
你原来的代码里有
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
这个过程。实际上,这里的X和Y是鼠标在容器(控件)内的位置,以“缇”为单位。要转化成像素(Pixel),你得把原坐标的横纵值除以15.
追问
填上了,但是没画出直线来呀,给以发一份给我吗
参考资料: !!
2011-08-18
展开全部
我可以给你介绍一个同道中人
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
'整个代码
dim IsPaint as Boolean
dim startx as single,starty as single
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
ispaint=not ispaint
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If ispaint Then
Picture2.cls
Picture2.Line (startx, starty)-(X, Y)
end if '显示橡皮筋效果
End Sub
'如果你想画多条线,就得用数组
dim IsPaint as Boolean
dim startx as single,starty as single
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
Picture2.AutoRedraw = False
startx = X '记住起始点
starty = Y
ispaint=not ispaint
End Sub
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If ispaint Then
Picture2.cls
Picture2.Line (startx, starty)-(X, Y)
end if '显示橡皮筋效果
End Sub
'如果你想画多条线,就得用数组
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询