# [VB] Kollisionsabfrage von 2 Shapes



## roeb (2. Dezember 2004)

Hallo,

ich habe per index circa 150 shapes angelegt. mit folgender funktion:


```
x = x + 200
If x >= 4440 Then
x = 120
y = y + 200
End If
anz = anz + 1
Load shp_enemy(anz)
shp_enemy(anz).Visible = True
shp_enemy(anz).Left = x
shp_enemy(anz).Top = y

If anz = 153 Then
tim_shapeaufbau.Enabled = False
End If
```

Dann hab ich noch ein weiteres shape welches ich per pfeiltaste bewege. was auch super geht. es soll sobald es über eins der shapes fährt es auf visible=false setzten. Allder dings hab ich ein prob mit den index da er immer nur das dhape auf visible=false setzt welches ich zu lezte erstellt habe (höhsten index). Hier der Code um die shapes auf visible true zu stellen.

If shp_pacman.Left + shp_enemy(anz).Width >= shp_enemy(anz).Left And shp_pacman.Left - shp_enemy(anz).Width <= shp_enemy(anz).Left And shp_pacman.Top + shp_enemy(anz).Height >= shp_enemy(anz).Top And shp_pacman.Top - shp_enemy(anz).Height <= shp_enemy(anz).Top Then
shp_enemy(0 - 150).Visible = False
End If

wie kann ich es anstellen das er auf alle shapes reagiert und nicht nur auf das zuletzt erstellte? is sehr wichtig.

bye roeb


----------



## roeb (2. Dezember 2004)

ist für eine schularbeit.


----------



## Shakie (2. Dezember 2004)

Du musst bei deinem Code nurnoch eine Schleife einbauen, die deinen Code für alle Shapes anwendet:
	
	
	



```
For anz=shp_enemy.Lbound to shp_enemy.Ubound

If shp_pacman.Left + shp_enemy(anz).Width >= shp_enemy(anz).Left _
And shp_pacman.Left - shp_enemy(anz).Width <= shp_enemy(anz).Left _
And shp_pacman.Top + shp_enemy(anz).Height >= shp_enemy(anz).Top _
And shp_pacman.Top - shp_enemy(anz).Height <= shp_enemy(anz).Top Then
shp_enemy(0 - 150).Visible = False

Next
```


----------



## roeb (2. Dezember 2004)

```
For anz = shp_enemy.Lbound To shp_enemy.Ubound

If shp_pacman.Left + shp_enemy(anz).Width >= shp_enemy(anz).Left _
And shp_pacman.Left - shp_enemy(anz).Width <= shp_enemy(anz).Left _
And shp_pacman.Top + shp_enemy(anz).Height >= shp_enemy(anz).Top _
And shp_pacman.Top - shp_enemy(anz).Height <= shp_enemy(anz).Top Then
shp_enemy(anz).Visible = False
End If
Next
```

Da kommt bei mir folgender fehler ... vll könnt ihr mir helfen. Bin am verzweifeln:

Runtime Error 340:
Control array element '1' doesnt exist.


----------



## Operator_Jon (2. Dezember 2004)

Bist du sicher das jedes Shape eine Nummer hat?
Die Fehlermeldung muss der Logik nach bedeuten das das Shape mit der Nummer 1 einfach nicht existiert 
Versuch mal

```
On Error Resume Next
```
einfach einzubauen, das sollte helfen 

/€dit:

```
For anz = shp_enemy.Lbound To shp_enemy.Ubound
On Error Resume Next
If shp_pacman.Left + shp_enemy(anz).Width >= shp_enemy(anz).Left _
And shp_pacman.Left - shp_enemy(anz).Width <= shp_enemy(anz).Left _
And shp_pacman.Top + shp_enemy(anz).Height >= shp_enemy(anz).Top _
And shp_pacman.Top - shp_enemy(anz).Height <= shp_enemy(anz).Top Then
shp_enemy(anz).Visible = False
End If
Next
```
So sollte das gehen


----------



## roeb (2. Dezember 2004)

ahh ich liebe euch 

Nutze VB erst seit circa 2 monaten da übersieht man so einiges. Es geht jetzt


----------



## roeb (3. Dezember 2004)

Ich habe noch eine frage:

ich bewege das eine Shape mit Keydown, und sobald KeyUp hör es sich auf zu bewegen. Jetzt will ich das er sobald er gg ein anderes shape kommt stehen bleibt. also nicht in das shape "reinlaufen" kann. Eine Kollisionsbfrage ist alles vorhanden. Ich weis bloss nicht wie ich das shape anhalten bzw. für sorgen soll das es nicht in das andere shape reinläuft.

Der Code zum bewegen des shapes:

```
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

    ' Wenn man die Taste drückt, bewegt sich das shape
    If KeyCode = vbKeyUp Then
        tim_oben.Enabled = True
    End If

    If KeyCode = vbKeyDown Then
        tim_unten.Enabled = True
    End If

    If KeyCode = vbKeyLeft Then
        tim_links.Enabled = True
    End If

    If KeyCode = vbKeyRight Then
        tim_rechts.Enabled = True
    End If
End Sub
```

Der Code im Timer zum bewegen:

```
Private Sub tim_oben_Timer()
    If shp_pacman.Top > 120 Then
        a = 10
        shp_pacman.Top = shp_pacman.Top - a
    End If
End Sub
```

Den code gibt es dann noch für links, recht und unten.


----------



## roeb (3. Dezember 2004)

vielleicht hab ich mich bissel kompliziert ausgedrückt. Ich möchte nicht das er stehen bleibt wenn er an die wände des shapes kommt sondenr einfach das er nicht in das shape "reinläuft" ... mein ziel ist es eine art pacman zu machen und mir geht es jetzt um die hinternisse im spielfeld.


----------



## roeb (3. Dezember 2004)

kann mir denn niemand helfen :/


----------



## Operator_Jon (3. Dezember 2004)

Mein Vorschlag:

```
Dim at_wall As Integer
```
Nun in die Collisionsabfrage einbauen

```
If collision... Then
    ...
    at_wall = 1
End If
```
In den Timer

```
Private Sub tim_oben_Timer()
    If at_wall = 0 Then
        If shp_pacman.Top > 120 Then
            a = 10
            shp_pacman.Top = shp_pacman.Top - a
        End If
     End If
End Sub
```
Ist nur so ne kleine Idee 

/€dit:
Natürlich musst nun noch gucken, in welche Richtung er sich von der Wand löst!
Dafür musst dann at_wall wieder auf 0 setzen, damit er sich wieder bewegen kann!


----------



## roeb (7. Dezember 2004)

Ich hab das mal versuch wie du es mir geschrieben hast. Also wenn er an die wand kommt setzt es die variable wall auf 1 und im bewegungstimer hab ich folgendes geschrieben:


```
Private Sub tim_links_Timer()
If wall = 0 Then
    If shp_pacman.Left > 0 Then
        a = 10
        shp_pacman.Left = shp_pacman.Left - a
    End If
    If wall = 1 Then
        If shp_pacman.Left < 4320 Then
            a = 10
            shp_pacman.Left = shp_pacman.Left + a
        End If
        wall = 0
    End If
    
End If
End Sub
```

er bleibt zwar stehen sobald er eine wand berühert aber er löst sich auch nicht wieder .... theoretisch müsste er ja in die andere richtung davon laufen wenn ich vbkeyleft nochmals drücke, oder?

// edit:

Hänge hier als anhang mal das komplette Projekt an. Weil ich es vielleicht doch bissel schlecht beschrieben habe


----------



## Operator_Jon (7. Dezember 2004)

Ich hatte sowas auch mal gemacht, ich hab das so gelöst, das ich bei einer Collision einfach sozusagen die Richtung wo die Wand ist gesperrt habe und nur die anderen Richtungen waren dementsprechend frei 

So würde ich das mal versuchen


----------



## roeb (7. Dezember 2004)

also müsst ich rausfinden an welcher seite der wand, in diesem fall ein würfel er anstossen würde? Mhh ich hab zwar ne Kollisionsabfrage geschrieben aber ich blick da irgendwie selber  kaum durch  Deshalb hier mal der Code der Kollisionsabfrage kurz:


```
For anz_w = shp_wall.LBound To shp_wall.UBound
    If shp_pacman.Left + shp_pacman.Width >= shp_wall(anz_w).Left _
    And shp_pacman.Left - shp_wall(anz_w).Width <= shp_wall(anz_w).Left _
    And shp_pacman.Top + shp_pacman.Height >= shp_wall(anz_w).Top _
    And shp_pacman.Top - shp_wall(anz_w).Height <= shp_wall(anz_w).Top Then
        shp_wall(anz_w).BorderColor = vbRed
    Else
        shp_wall(anz_w).BorderColor = vbGreen
    End If
Next
```

Die Tastenerkennung hab ich per Form_keydown bzw. Form_keyup gemacht (Pfeiltasten) und die Bewegungabläufe jeweils in ein Timer, für unten, oben .. usw.


----------



## Operator_Jon (9. Dezember 2004)

Sorry, hab leider grade keine zeit um den Code durchzusehen  

Aber, mach es doch so, dass wenn Left des Spielers größer als Left des Shapes ist (also des blockenden shapes) ist er rechts, wenn kleiner dann links 
Das selbe kannst du ganz einfach auf oben und unten übertragen


----------



## roeb (9. Dezember 2004)

habs mir nochmal anders überlegt und um das ganze nen bissel schwerer zu machen, darf man die wände nicht berühern udn wnen doch startet es neu. Das bekomm ich wenigstens hin  naja ich versuch dein tip trotzdem mal. thx udn ich denke es hat sich jetzt alles erledigt.


----------



## Operator_Jon (16. Dezember 2004)

Hey.
Hab sowas jetzt grade auch mal für die Schule gemacht, ich habs so gelöst:

```
Private Sub player_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyRight Then
        player.Picture = LoadPicture(App.Path & "\gfx\tank_black_right.bmp")
        For i = 0 To (block.Count - 1) Step 1
            If block(i).left > player.left Then
                If player.Top = block(i).Top Then
                    If (player.left + player.Width) < block(i).left Then
                        colli = False
                    Else
                        colli = True
                        Exit For
                    End If
                Else
                    colli = False
                End If
            Else
                colli = False
            End If
        Next i
        If colli = False Then
            If player.left < (Level1.Width - player.Width) Then pmove = 1
        End If
    End If
    
    If KeyCode = vbKeyLeft Then
        player.Picture = LoadPicture(App.Path & "\gfx\tank_black_left.bmp")
        For i = 0 To (block.Count - 1) Step 1
            If block(i).left < player.left Then
                If player.Top = block(i).Top Then
                    If (player.left - player.Width) > block(i).left Then
                        colli = False
                    Else
                        colli = True
                        Exit For
                    End If
                Else
                    colli = False
                End If
            Else
                colli = False
            End If
        Next i
        If colli = False Then
            If player.left > 0 Then pmove = 2
        End If
    End If
    
    If KeyCode = vbKeyDown Then
        player.Picture = LoadPicture(App.Path & "\gfx\tank_black_down.bmp")
        For i = 0 To (block.Count - 1) Step 1
            If block(i).Top > player.Top Then
                If player.left = block(i).left Then
                    If (player.Top + player.Height) < block(i).Top Then
                        colli = False
                    Else
                        colli = True
                        Exit For
                    End If
                Else
                    colli = False
                End If
            Else
                colli = False
            End If
        Next i
        If colli = False Then
            If player.Top < (Level1.Height - player.Height) Then pmove = 3
        End If
    End If
    
    If KeyCode = vbKeyUp Then
        player.Picture = LoadPicture(App.Path & "\gfx\tank_black_up.bmp")
        For i = 0 To (block.Count - 1) Step 1
            If block(i).Top < player.Top Then
                If player.left = block(i).left Then
                    If (player.Top - player.Height) > block(i).Top Then
                        colli = False
                    Else
                        colli = True
                        Exit For
                    End If
                Else
                    colli = False
                End If
            Else
                colli = False
            End If
        Next i
        If colli = False Then
            If player.Top > 0 Then pmove = 4
        End If
    End If
End Sub
```
Das sieht aus wie Spagetti mit Soße


----------

