|
Dim ObjectA As Control
Dim ObjectB As Control
Public Function contact(object1 As Control, object2 As Control)
'
CheckLeft:
'
'Check to see if Left of Object1 is in Object2
If object1.Left >= object2.Left And object1.Left <= object2.Left
+ object2.Width Then GoTo CheckTop
'If not, then check to see if the right is instead
If object1.Left + object1.Width >= object2.Left And object1.Left +
object1.Width <= object2.Left + object2.Width Then GoTo CheckTop
'No Contact detected, set contacted to show this
contacted = 0
'
'Now Check the objects the other way round
GoTo CheckLeft2
'
CheckTop:
'Check to see if Top of Object1 is in Object2
If object1.Top >= object2.Top And object1.Top <= object2.Top + object2.Height
Then contacted = 1: GoTo Finished
'If not, then check to see if Bottom is instead
If object1.Top + object1.Height >= object2.Top And object1.Top + object1.Height
<= object2.Top + object2.Height Then contacted = 1: GoTo Finished
'No Contact Detected, set contacted to show this
contacted = 0
'
'Now Check the objects the other way round
GoTo CheckTop2
'
CheckLeft2:
'Check to see if Left of Object2 is in Object1
If object2.Left >= object1.Left And object2.Left <= object1.Left
+ object1.Width Then GoTo CheckTop2
'If not, then check to see if the right is instead
If object2.Left + object2.Width >= object1.Left And object2.Left +
object2.Width <= object1.Left + object1.Width Then GoTo CheckTop2
'No Contact detected, set contacted to show this
contacted = 0
'
'No Contact Made
GoTo Finished
'
CheckTop2:
'Check to see if Top of Object2 is in Object1
If object2.Top >= object1.Top And object2.Top <= object1.Top + object2.Height
Then contacted = 1: cobject = X: GoTo Finished
'If not, then check to see if Bottom is instead
If object2.Top + object2.Height >= object1.Top And object2.Top + object2.Height
<= object1.Top + object1.Height Then contacted = 1: GoTo Finished
'No Contact Detected, set contacted to show this
contacted = 0
'
'No Contact Made
GoTo Finished
'
Finished:
'Set Contact to show the result
contact = contacted
End Function
Private Sub Command1_Click()
'
'Just use the following code to check for
'contact between 2 objects.
'
'Set ObjectA and ObjectB as the controls you want to test for contact
'
'a will be 1 if there is contact, or 0 if there
'is none.
'
a = contact(ObjectA, ObjectB)
End Sub
|