工程中先引用控件 Line1,Line2
Dim ux As Integer
Dim uy As Integer
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ux = X
uy = Y
Line1.X1 = X
Line1.X2 = X
Line1.Y1 = Y - 300
Line1.Y2 = Y + 300
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'x的坐标为 sqr(a^2 * ((y2-y1)^2/((y2-y1)^2+(x2-x1)^2)))+x1
If Button = 1 Then
Me.Cls
Line (ux, uy)-(X, Y)
If X < ux Then
Line1.X1 = ux + Sqr(300 ^ 2 * ((Y - uy) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
Else
Line1.X1 = ux - Sqr(300 ^ 2 * ((Y - uy) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
End If
If Y > uy Then
Line1.Y1 = uy + Sqr(300 ^ 2 * ((X - ux) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
Else
Line1.Y1 = uy - Sqr(300 ^ 2 * ((X - ux) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
End If
'Line1.X1 = ux + 300 * Cos(Atn((X - ux) / (uy - Y)))
'Line1.Y1 = uy + 300 * Sin(Atn(X - ux) / (uy - Y))
If X > ux Then
Line1.X2 = ux + Sqr(300 ^ 2 * ((Y - uy) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
Else
Line1.X2 = ux - Sqr(300 ^ 2 * ((Y - uy) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
End If
If Y < uy Then
Line1.Y2 = uy + Sqr(300 ^ 2 * ((X - ux) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
Else
Line1.Y2 = uy - Sqr(300 ^ 2 * ((X - ux) ^ 2 / ((Y - uy) ^ 2 + (X - ux) ^ 2)))
End If
Line2.X1 = Line1.X1 + X - ux
Line2.Y1 = Line1.Y1 + Y - uy
Line2.X2 = Line1.X2 + X - ux
Line2.Y2 = Line1.Y2 + Y - uy
End If
End Sub