Nabend Joe 
Mache es dir mal nicht so schwer. Auch denke mal nicht so kompliziert.
Aus deinem Ansatz könnte man etwas machen 
Aber das waere sehr rechenaufwaendig.
Es geht Viel einfacher
Nutze einfach die API IntersectRect! Sie gibt dir zurueck ob sich 2 Objecte ueberlappen!
Die Declaration und defintionschaut wiefolgt aus
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Declare Function IntersectRect Lib "user32" Alias "IntersectRect" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
Sodele nun einmal zu den Parametern!
Der zweite und dritte Parameter, sind deine 2 Objecte, die auf Kollision überwacht werden sollen!
Im ersten Parameter bekommst du die Überlappung wieder!
Wenn du eine Variable als Boolean declarierst und dann die API Aufrufst bekommst du ein true zurueck wenn eine Kollision stattgefunden hat, ansonsten False
Bsp.:
dim Col as Boolean
Col = IntersectRect(udtTempRect, mudtRect1, mudtRect2)
Soll aber eine Kresiförmige Kollisionsabfrage stattfinden, so musst du nen bissl tricksen Verwende dazu folgende Function
Private Function GetDist(intX1 As Single, intY1 As Single, intX2 As Single, intY2 As Single) As Single
GetDist = Sqr((intX1 - intX2) ^ 2 + (intY1 - intY2) ^ 2)
End Function
Aber nun mal schnell nen kleines Demo, ist ungetestet sollte aber laufen
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function IntersectRect Lib "user32" (lpDestRect \_
As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
Dim mudtRect1 As RECT
Dim mudtRect2 As RECT
'Kreis Koordinaten
Dim msngCircle1X As Single
Dim msngCircle1Y As Single
Dim msngCircle2X As Single
Dim msngCircle2Y As Single
'Flags
Dim mblnCircles As Boolean 'Es handelt sich um Kreise
Dim mblnRects As Boolean ' Es handelt sich um Rechtecke
Dim mblnCollision As Boolean 'Kollision
Dim mblnRunning As Boolean 'Ist gestartet
Dim mblnLeftKey As Boolean 'links bewegen
Dim mblnRightKey As Boolean 'Rechts bewegen
Dim mblnDownKey As Boolean 'Nach Unten bewegen
Dim mblnUpKey As Boolean 'Nach oben bewegen
Private Sub Form\_Load()
'Bei Verwendung von Kreisen, dann die kresikoordinaten festlegen!
'bsp
'Randomize
'msngCircle1X = Rnd() \* me.ScaleWidth
'msngCircle1Y = Rnd() \* me.ScaleHeight
'msngCircle2X = Rnd() \* me.ScaleWidth
'msngCircle2Y = Rnd() \* me.ScaleHeight
With mudtRect1
.Top = Daten Top von deinen Object
.Left = Daten Left von deinen Object
.Bottom = 'Unter Kante deines Objectes (Top + HEIGHT)
.Right = 'Rechte Kante deines Objectes (Left + WIDTH)
End With
With mudtRect2
.Top = Selbe wir mudtRect1 nur von dem anderen Object
.Left =Selbe wir mudtRect1 nur von dem anderen Object
.Bottom = Selbe wir mudtRect1 nur von dem anderen Object
.Right = Selbe wir mudtRect1 nur von dem anderen Object
End With
mblnRects = True
mblnRunning = True
Do While mblnRunning
If mblnCircles Then
CircleCollision
MoveCircle
DrawCircle msngCircle1X, msngCircle1Y, 30, vbWhite
If mblnCollision Then
DrawCircle msngCircle2X, msngCircle2Y, 20, vbRed
Else
DrawCircle msngCircle2X, msngCircle2Y, 20, vbWhite
End If
ElseIf mblnRects Then
RectCollision
MoveRect
DrawRect mudtRect1, vbWhite
If mblnCollision Then
DrawRect mudtRect2, vbRed
Else
DrawRect mudtRect2, vbWhite
End If
End If
End If
DoEvents
Loop
End Sub
Private Sub MoveCircle()
If mblnDownKey = True Then msngCircle1Y = msngCircle1Y + 1
If mblnUpKey = True Then msngCircle1Y = msngCircle1Y - 1
If mblnLeftKey = True Then msngCircle1X = msngCircle1X - 1
If mblnRightKey = True Then msngCircle1X = msngCircle1X + 1
End Sub
Private Sub MoveRect()
With mudtRect1
If mblnDownKey = True Then
.Top = .Top + 1
.Bottom = .Bottom + 1
End If
If mblnUpKey = True Then
.Top = .Top - 1
.Bottom = .Bottom - 1
End If
If mblnLeftKey = True Then
.Left = .Left - 1
.Right = .Right - 1
End If
If mblnRightKey = True Then
.Left = .Left + 1
.Right = .Right + 1
End If
End With
End Sub
Private Sub CircleCollision()
mblnCollision = GetDist(msngCircle1X, msngCircle1Y, \_
msngCircle2X, msngCircle2Y)
Sodele das muesste alles gewesen sein und wie du siehst eigentlich ganz simple. Die Eigentliche Abfrage bedarf nur 1 Zeile! :wink:
MfG Alex
P