垂直的算法

阅读更多

工程中先引用控件 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