| Option Explicit
Private Type PointType
X As Double
Y As Double
End Type
Private Type LineType
Pt1 As PointType
Pt2 As PointType
End Type
Private Sub LinesIntersect(ln1 As LineType, ln2 As LineType, _
pt As PointType, bParallel As Boolean)
Dim bVertical(1 To 2) As Boolean
Dim m(1 To 2) As Double
Dim b(1 To 2) As Double
'Check to see if either of the lines is vertical
bVertical(1) = (ln1.Pt1.X = ln1.Pt2.X)
bVertical(2) = (ln2.Pt1.X = ln2.Pt2.X)
bParallel = False
If bVertical(1) And bVertical(2) Then
'Both lines are vertical, so they're parallel
bParallel = True
ElseIf bVertical(1) Then
'Calculate the non-vertical line's slope and offset
m(2) = (ln2.Pt2.Y - ln2.Pt1.Y) / (ln2.Pt2.X - ln2.Pt1.X)
b(2) = ln2.Pt1.Y - (m(2) * ln2.Pt1.X)
'and use it to determine the intersection point
pt.X = ln1.Pt1.X
pt.Y = m(2) * pt.X + b(2)
ElseIf bVertical(2) Then
'Calculate the non-vertical line's slope and offset
m(1) = (ln1.Pt2.Y - ln1.Pt1.Y) / (ln1.Pt2.X - ln1.Pt1.X)
b(1) = ln1.Pt1.Y - (m(1) * ln1.Pt1.X)
'and use it to determine the intersection point
pt.X = ln2.Pt1.X
pt.Y = m(1) * pt.X + b(1)
Else
'Calculate the slopes of both lines
m(1) = (ln1.Pt2.Y - ln1.Pt1.Y) / (ln1.Pt2.X - ln1.Pt1.X)
m(2) = (ln2.Pt2.Y - ln2.Pt1.Y) / (ln2.Pt2.X - ln2.Pt1.X)
If m(1) = m(2) Then
'The slopes are equal, so the lines are parallel
bParallel = True
Else
'They differ, so calculate the offset of the lines
b(1) = ln1.Pt1.Y - (m(1) * ln1.Pt1.X)
b(2) = ln2.Pt1.Y - (m(2) * ln2.Pt1.X)
'Now, calculate the intersection point
pt.X = (b(2) - b(1)) / (m(1) - m(2))
pt.Y = m(1) * pt.X + b(1)
End If
End If
End Sub
|
| 'Requires two lines (Line1, Line2) and one shape (Shape1)
Randomize Timer
Dim bParallel As Boolean
Dim pt As PointType
Dim ln1 As LineType
Dim ln2 As LineType
'Randomly position the lines
Line1.X1 = Rnd * ScaleWidth
Line1.X2 = Rnd * ScaleWidth
Line2.X1 = Rnd * ScaleWidth
Line2.X2 = Rnd * ScaleWidth
Line1.Y1 = Rnd * ScaleHeight
Line1.Y2 = Rnd * ScaleHeight
Line2.Y1 = Rnd * ScaleHeight
Line2.Y2 = Rnd * ScaleHeight
'Set our line type to the lines' position
ln1.Pt1.X = Line1.X1
ln1.Pt1.Y = Line1.Y1
ln1.Pt2.X = Line1.X2
ln1.Pt2.Y = Line1.Y2
ln2.Pt1.X = Line2.X1
ln2.Pt1.Y = Line2.Y1
ln2.Pt2.X = Line2.X2
ln2.Pt2.Y = Line2.Y2
'Calculate the point of intersection
LinesIntersect ln1, ln2, pt, bParallel
If bParallel Then
MsgBox "Lines are parallel or the same line."
Else
Shape1.Width = 90
Shape1.Height = 90
Shape1.Top = pt.Y - Shape1.Height / 2
Shape1.Left = pt.X - Shape1.Width / 2
End If
|