Kresj av 2 eller flere Shapes

[ggp]

Er det noen som kan gi meg et eksempel på en kollisjons script som utløser seg når 2 eller flere shapes kresjer sammen?

 

Takker

[aadnk]

Det enkleste blir å implementere dette med en enkel rektangelkollideringsrutine:

Public Function BoxCollision(Box1 As Shape, Box2 As Shape) As Boolean

 

    ' Returnerer SANN om en av boksene er innenfor den andre

    BoxCollision = (Box1.Left > Box2.Left - Box1.Width) And (Box1.Left < Box2.Left + Box2.Width) And _

    (Box1.Top > Box2.Top - Box1.Height) And (Box1.Top < Box2.Top + Box2.Height)

   

End Function

 

Public Function SomethingHasCollided() As Boolean

 

    Dim Tell As Long, SubCount As Long, oShapes As Collection

   

    ' Henter alle shapes (dette kan godt gjøres i Form_Load)

    Set oShapes = Shapes

   

    ' Optimalisert søket etter det faktum at Collision(A, B) = Collision(B, A).

    For Tell = 1 To oShapes.Count

        For SubCount = Tell + 1 To oShapes.Count

            If BoxCollision(oShapes(Tell), oShapes(SubCount)) Then

               

                ' * Dersom du trenger å gjøre noe når to objekter har kollidert,

                ' bør dette (på en eller annen måte) gjøres her. *

           

                ' Vi vet nå med sikkerhet at noe har kollidert

                SomethingHasCollided = True

               

                ' Det er nå ikke nødvendig med flere søk.

                Exit Function

           

            End If

        Next

    Next

   

End Function

 

Public Function Shapes() As Collection

 

    Dim Shape As Shape

 

    ' Lager en ny kolleksjon

    Set Shapes = New Collection

   

    ' Laster inn alle shapes

    For Each Shape In Me.Controls

        Shapes.Add Shape

    Next

 

End Function

Endret 2. april 2007 av aadnk