Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Kreis Kollision Test

Uploader:MitgliedEternal_Pain
Datum/Zeit:02.03.2015 07:30:19

'QUELLE: https://www.spieleprogrammierer.de/wiki/2D-Kollisionserkennung#Kollision_zwischen_zwei_Kreisen

'' Kollision zwischen zwei Kreisen

'' Wenn die Distanz zwischen den Mittelpunkten zweier Kreise kleiner ist als die Summe ihrer Radien,
'' so liegt eine Kollision vor. Also benötigen wir zum Prüfen der Kollision die Positionen und
'' Radien der beiden Kreise. Dabei rechnen wir mit Hilfe des Satz des Pythagoras die Distanz zwischen
'' den beiden Kreisen aus und prüfen zum Schluss, ob diese kleiner ist als die Summe beider Radien.

Function RadKol(byval x1 as Integer, byval y1 as Integer, byval r1 as Integer = 0, byval x2 as Integer, byval y2 as Integer, byval r2 as Integer = 0) as Integer
    Static Dist as Integer
    Dist = int(sqr(((x1-x2)*(x1-x2))+((y1-y2)*(y1-y2))))
    If Dist < (r1+r2) Then Return -1 '' TRUE
    Return 0 '' FALSE
End Function




''MAIN test.bas
Randomize Timer
Screenres 640,480,32

Dim as Integer ax,ay,ar '' Kreis A
Dim as Integer bx,by,br '' Kreis B

'' Zufaellige Startwerte
ax = rnd*640 : ay = rnd*480 : ar = (rnd*25) +1
bx = rnd*640 : by = rnd*480 : br = (rnd*25) +1

If ax-ar <   0 Then ax =   0 + ar
If ax+ar > 639 Then ax = 639 - ar
If ay-ar <   0 Then ay =   0 + ar
If ay+ar > 479 Then ay = 479 - ar

If bx-br <   0 Then bx =   0 + br
If bx+br > 639 Then bx = 639 - br
If by-br <   0 Then by =   0 + br
If by+br > 479 Then by = 479 - br

Dim as Integer axd, ayd '' Bewegungsrichtung Kreis A
Dim as Integer bxd, byd '' Bewegungsrichtung Kreis B

'' Zufaellige Startwerte
    ''axd und ayd dürfen nicht zur selben zeit 0 sein (sonst findet keine bewegung statt)
    Do
        axd = (rnd*2) - 1 : ayd = (rnd*2) -1 '' -1,0,1
    Loop while (axd = 0 and ayd = 0)

    ''bxd und byd dürfen nicht zur selben zeit 0 sein (sonst findet keine bewegung statt)
    Do
        bxd = (rnd*2) - 1 : byd = (rnd*2) -1 '' -1,0,1
    Loop while (bxd = 0 and byd = 0)


Do
    Screenlock
        cls
        Circle (ax,ay),ar,&h808080,,,,F
        Circle (bx,by),br,&hFF1010,,,,F
    Screenunlock

    ax += axd : ay += ayd
    bx += bxd : by += byd

    If RadKol(ax,ay,ar,bx,by,br) Then ''Kolission zwischen beiden Kreisen
        If axd <> 0 Then axd *= -1 Else axd = (rnd*2) -1
        If ayd <> 0 Then ayd *= -1 Else ayd = (rnd*2) -1
        If bxd <> 0 Then bxd *= -1 Else bxd = (rnd*2) -1
        If byd <> 0 Then byd *= -1 Else byd = (rnd*2) -1
    End If

    If ax+ar>639 orelse ax-ar<0 orelse ay+ar>479 orelse ay-ar<0 Then ''Kreis A kollidiert mit Rand
        If ax-ar<  0 orelse ax+ar>639 Then axd *= -1 Else axd = (rnd*2) -1
        If ay-ar<  0 orelse ay+ar>479 Then ayd *= -1 Else ayd = (rnd*2) -1 '' -1,0,1
    End If

    If bx+br>639 orelse bx-br<0 orelse by+br>479 orelse by-br<0 Then ''Kreis B kollidiert mit Rand
        If bx-br<  0 orelse bx+br>639 Then bxd *= -1 Else bxd = (rnd*2) -1
        If by-br<  0 orelse by+br>479 Then byd *= -1 Else byd = (rnd*2) -1 '' -1,0,1
    End If

    sleep 1
Loop UNTIL multikey(&h01) '' ESC