by Paul Briley (1 Submission)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Mon 12th February 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
This is an easy to use function that checks to see if two objects are contacting with each other.
API Declarations
'You must read, understand and accept the comments within the code
'before using it.
'
'Note: In the instance below - A command button (command1) is used to call the
'contact checking function. It may, however, be called from other things.
VBcoders
' Okay - Some nice code here, not sure if it's all
' necessary or if there's a simpler way
' but nevermind, here you go:
'
'Author: Paul Briley
'Code is freeware
'
'If you use this code then please help us out
'and visit www.getpaid.fsnet.co.uk
'There's 3 links to different people who pay
'you just for receiving free advertising e-mails!
'It's actually pretty cool.
'
'Cheers,
'Enjoy!
'
'Positive / Constructive Feedback to:
'[email protected]
'
'The author accepts no responsibility whatsoever
'for faults or errors that may be in or arise
'from the use of this, or any, code.
'
'Use entirely at your own risk.
'
If object1.Left >= object2.Left And object1.Left <= object2.Left + object2.Width Then GoTo c2
If object1.Left + object1.Width >= object2.Left And object1.Left + object1.Width <= object2.Left + object2.Width Then GoTo c2
contacted = 0
GoTo cont2
c2:
If object1.Top >= object2.Top And object1.Top <= object2.Top + object2.Height Then contacted = 1: cobject = X: GoTo c2a
If object1.Top + object1.Height >= object2.Top And object1.Top + object1.Height <= object2.Top + object2.Height Then contacted = 1: GoTo c2a
cont2:
If object2.Left >= object1.Left And object2.Left <= object1.Left + object1.Width Then GoTo c2a
If object2.Left + object2.Width >= object1.Left And object2.Left + object2.Width <= object1.Left + object1.Width Then GoTo c2a
contit2:
contacted = 0
GoTo 4000
c2a:
If object2.Top >= object1.Top And object2.Top <= object1.Top + object2.Height Then contacted = 1: cobject = X: GoTo 4000
If object2.Top + object2.Height >= object1.Top And object2.Top + object2.Height <= object1.Top + object1.Height Then contacted = 1: GoTo 4000
contacted = 0
4000
contact = contacted
End Function
Private Sub Command1_Click()
'
'Just use the following code to check for
'contact between 2 objects.
'
'Replace 'Object1' and 'Object2' with the names
'of the objects that are being tested.
'
'a will be 1 if there is contact, or 0 if there
'is none.
'
a = contact(object1, object2)
End Sub
No comments have been posted about This is an easy to use function that checks to see if two objects are contacting with each other.. Why not be the first to post a comment about This is an easy to use function that checks to see if two objects are contacting with each other..
