高分求一个VB编写的 跟踪鼠在屏幕上运动标轨迹并描绘出来的小软件
2个回答
展开全部
VB绘制鼠标移动轨迹
主要代码及注释如下:
Public Class Form1Class Form1
Dim PtStart As Point '记录绘制直线的起始点
Dim PtEnd As Point '记录绘制直线的终点
Dim ShouldDrawLine As Boolean '是否绘制直线
'记录鼠标左键点击的位置,第二次点击后开始绘制直线
Private Sub Pic1_MouseDown()Sub Pic1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Pic1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
If Not ShouldDrawLine Then
PtStart = New Point(e.X, e.Y)
ShouldDrawLine = True
Else
PtEnd = New Point(e.X, e.Y)
'下面两句根据需要进行取舍
'Call DrawLine(PtStart, PtEnd) '绘制一条直线
Call DrawLines(PtStart, PtEnd) '绘制多条直线
ShouldDrawLine = False
End If
End If
End Sub
'绘制鼠标的移动轨迹(仅在鼠标第一次点击后开始绘制轨迹)
Private Sub Pic1_MouseMove()Sub Pic1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Pic1.MouseMove
Static pt As Point
If ShouldDrawLine Then
'鼠标第一次点击的位置(需转化为屏幕坐标)
Dim p As Point = Pic1.PointToScreen(PtStart)
'清除原先绘制的鼠标移动轨迹
If pt <> Nothing Then ControlPaint.DrawReversibleLine(p, pt, Color.Red)
'绘制鼠标移动后新的轨迹
pt = Pic1.PointToScreen(New Point(e.X, e.Y))
ControlPaint.DrawReversibleLine(p, pt, Color.Red)
Else
pt = Nothing '清除鼠标原位置
End If
End Sub
'绘制鼠标两次点击位置之间的直线
Private Sub DrawLine()Sub DrawLine(ByVal mPoint1 As Point, ByVal mPoint2 As Point)
Pic1.Refresh() '用于刷新Picturebox表面
Pic1.CreateGraphics.DrawLine(Pens.Blue, mPoint1, mPoint2) '绘制两点间的直线
End Sub
'绘制多条直线,每两次鼠标点击确定一条线
Private Sub DrawLines()Sub DrawLines(ByVal mPoint1 As Point, ByVal mPoint2 As Point)
'此句不可删除,用于清除鼠标点击前的轨迹
ControlPaint.DrawReversibleLine(Pic1.PointToScreen(mPoint1), Pic1.PointToScreen(mPoint2), Color.Red)
Pic1.CreateGraphics.DrawLine(Pens.Blue, mPoint1, mPoint2) '绘制两点间的直线
End Sub
Private Sub Form1_Load()Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.UserPaint, True)
End Sub
End Class
注:此代码运行需要一个Form,Form上存在一个Pic1的Picturebox控件。
主要代码及注释如下:
Public Class Form1Class Form1
Dim PtStart As Point '记录绘制直线的起始点
Dim PtEnd As Point '记录绘制直线的终点
Dim ShouldDrawLine As Boolean '是否绘制直线
'记录鼠标左键点击的位置,第二次点击后开始绘制直线
Private Sub Pic1_MouseDown()Sub Pic1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Pic1.MouseDown
If e.Button = Windows.Forms.MouseButtons.Left Then
If Not ShouldDrawLine Then
PtStart = New Point(e.X, e.Y)
ShouldDrawLine = True
Else
PtEnd = New Point(e.X, e.Y)
'下面两句根据需要进行取舍
'Call DrawLine(PtStart, PtEnd) '绘制一条直线
Call DrawLines(PtStart, PtEnd) '绘制多条直线
ShouldDrawLine = False
End If
End If
End Sub
'绘制鼠标的移动轨迹(仅在鼠标第一次点击后开始绘制轨迹)
Private Sub Pic1_MouseMove()Sub Pic1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Pic1.MouseMove
Static pt As Point
If ShouldDrawLine Then
'鼠标第一次点击的位置(需转化为屏幕坐标)
Dim p As Point = Pic1.PointToScreen(PtStart)
'清除原先绘制的鼠标移动轨迹
If pt <> Nothing Then ControlPaint.DrawReversibleLine(p, pt, Color.Red)
'绘制鼠标移动后新的轨迹
pt = Pic1.PointToScreen(New Point(e.X, e.Y))
ControlPaint.DrawReversibleLine(p, pt, Color.Red)
Else
pt = Nothing '清除鼠标原位置
End If
End Sub
'绘制鼠标两次点击位置之间的直线
Private Sub DrawLine()Sub DrawLine(ByVal mPoint1 As Point, ByVal mPoint2 As Point)
Pic1.Refresh() '用于刷新Picturebox表面
Pic1.CreateGraphics.DrawLine(Pens.Blue, mPoint1, mPoint2) '绘制两点间的直线
End Sub
'绘制多条直线,每两次鼠标点击确定一条线
Private Sub DrawLines()Sub DrawLines(ByVal mPoint1 As Point, ByVal mPoint2 As Point)
'此句不可删除,用于清除鼠标点击前的轨迹
ControlPaint.DrawReversibleLine(Pic1.PointToScreen(mPoint1), Pic1.PointToScreen(mPoint2), Color.Red)
Pic1.CreateGraphics.DrawLine(Pens.Blue, mPoint1, mPoint2) '绘制两点间的直线
End Sub
Private Sub Form1_Load()Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Me.SetStyle(ControlStyles.AllPaintingInWmPaint Or ControlStyles.OptimizedDoubleBuffer Or ControlStyles.UserPaint, True)
End Sub
End Class
注:此代码运行需要一个Form,Form上存在一个Pic1的Picturebox控件。
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询