Private Type MyCircle
  X As Single
  Y As Single
  Radius As Single
End Type
 
Private Type RECT
  Left As Single
  Top As Single
  Right As Single
  Bottom As Single
End Type
 
Private Sub Command1_Click()
Dim C As MyCircle
Dim R As RECT
Dim ret As Boolean
 
  ' Rechteck Shape1
  R.Left = Shape1.Left
  R.Top = Shape1.Top
  R.Right = Shape1.Left + Shape1.Width
  R.Bottom = Shape1.Top + Shape1.Height
 
  ' Kreis Shape2 (X und Y = Kreismittelpunkt)
  C.X = Shape2.Left + Shape2.Width / 2
  C.Y = Shape2.Top + Shape2.Height / 2
  C.Radius = Shape2.Width / 2
 
  ret = CircleRectCollision(C, R)
 
  If ret Then
    MsgBox "Rechteck und Kreis berühren sich."
  Else
    MsgBox "Rechteck und Kreis berühren sich NICHT."
  End If
 
End Sub
 
Private Function CircleRectCollision(TheCircle As MyCircle, TheRect As RECT) As _
  Boolean
Dim TestX As Single, TestY As Single
 
TestX = TheCircle.X
TestY = TheCircle.Y
 
If TestX < TheRect.Left Then TestX = TheRect.Left
 
If TestX > TheRect.Right Then TestX = TheRect.Right
 
If TestY < TheRect.Top Then TestY = TheRect.Top
 
If TestY > TheRect.Bottom Then TestY = TheRect.Bottom
 
CircleRectCollision = FindDistance(TheCircle.X, _
TheCircle.Y, TestX, TestY) < TheCircle.Radius
 
End Function
 
Private Function FindDistance(X1 As Single, Y1 As Single, X2 As Single, Y2 As _
  Single) As Single
  FindDistance = Sqr((X2 - X1) * (X2 - X1) + (Y2 - Y1) * (Y2 - Y1))
End Function