 |
Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
|
| Vorheriges Thema anzeigen :: Nächstes Thema anzeigen |
| Autor |
Nachricht |
isiprimax
Anmeldungsdatum: 02.01.2009
Beiträge: 77
|
 Verfasst am: 09.01.2009, 00:12 Titel: Pixel genaue Kollision |
 |
|
Hallo,
Ich arbeite mich grade in das thema Kollision ein.
Ich habe nach einem Tutorial gearbeitet -> http://de.dawiki.wikia.com/wiki/Tutorial:Pixelgenaue_Kollision
Es ist soweit auch alles verständlich, aber ich glaube Point arbeitet anderst als sich der Tutorial Ersteller sich dachte.
Ich habe meinen Code beigefügt und ergänzt.
| Code: | Dim As Integer a, OffsetXUFO,OffsetYUFO,OffsetXBaum,OffsetYBaum,OffsetWidth,OffsetHeight,Pixel1,Pixel2,xpos,ypos
ScreenRes 800,600,32,2
ScreenSet 1,0
Type xbaum
X As Integer = 200
Y As Integer = 200
Width As Integer = 90
height As Integer = 90
OffsetX As Integer = 0
OffsetY As Integer = 0
Bild As Byte ptr
End Type
Dim As xbaum baum
Type xufo
X As Integer
Y As Integer
Width As Integer = 80
height As Integer = 80
OffsetX As Integer = 0
OffsetY As Integer = 0
Bild As Byte Ptr
End Type
Dim As xufo ufo
ufo.Bild = ImageCreate(ufo.Width,ufo.height)
baum.bild = ImageCreate(baum.Width,baum.height)
Paint ufo.bild,(2,2),RGB(255,0,255)
Circle ufo.bild,(ufo.X+40,ufo.y+40),20,RGB(100,100,255),,,,F
Paint baum.bild,(2,2),RGB(255,0,255)
Circle baum.bild,(45,45),40,RGB(100,100,255),,,,F
Do
Sleep 1
Cls
GetMouse ufo.x,ufo.Y
Locate 3,1:?"Maus x";ufo.X;" y";ufo.Y
Put (ufo.X,ufo.y),ufo.Bild,Trans
Put (baum.X,baum.y),baum.Bild,Trans
a = Point (ufo.X,ufo.Y)
Locate 2,1:?"1 "; Hex(a);" "
If (((UFO.X >= Baum.X AND UFO.X <= Baum.X+Baum.Width) OR _
(Baum.X >= UFO.X AND Baum.X <= UFO.X+UFO.Width)) AND _
((UFO.Y >= Baum.Y AND UFO.Y <= Baum.Y+Baum.Height) OR _
(Baum.Y >= UFO.Y AND Baum.Y <= UFO.Y+UFO.Height))) THEN
OffsetXUFO=0
OffsetXBaum=0
OffsetYUFO=0
OffsetYBaum=0
OffsetWidth=UFO.Width
OffsetHeight=UFO.Height
IF(OffsetWidth > Baum.Width) THEN OffsetWidth = Baum.Width
IF(OffsetHeight > Baum.Height) THEN OffsetHeight = Baum.Height
IF(UFO.X < Baum.X) Then
UFO.OffsetX = Baum.X - UFO.X
IF(Baum.X+Baum.Width > UFO.X+UFO.Width) Then
OffsetWidth=UFO.X+UFO.Width-Baum.X ' FALL 1
endif
Else
Baum.OffsetX = UFO.X - Baum.X
IF(UFO.X + UFO.Width > Baum.X + Baum.Width) Then
OffsetWidth=Baum.X+Baum.Width-UFO.X ' FALL 1
endif
endif
IF(UFO.Y < Baum.Y) Then
UFO.OffsetY = Baum.Y - UFO.Y
IF(Baum.Y+Baum.Height > UFO.Y+UFO.Height) Then
OffsetHeight=UFO.Y+UFO.Height-Baum.Y ' FALL 1
endif
Else
Baum.OffsetY = UFO.Y - Baum.Y
IF(UFO.Y + UFO.Height > Baum.Y + Baum.Height) THEN
OffsetHeight=Baum.Y+Baum.Height-UFO.Y ' FALL 1
endif
endif
FOR XPos = 0 TO OffsetWidth
FOR YPos = 0 TO OffsetHeight
'Hier vermute ich den fehler!!!
Pixel1 = Point(UFO.X + UFO.OffsetX + XPos, UFO.Y + UFO.OffsetY + YPos, UFO.Bild)
Pixel2 = Point(Baum.X + Baum.OffsetX + XPos, Baum.Y + Baum.OffsetY + YPos, Baum.Bild)
IF(Hex(Pixel1) <> "FF00FF" AND Hex(Pixel2) <> "FF00FF") Then
Locate 1,1:?"// KOLLISION:"
Exit For
endif
Next
Next
endif
ScreenCopy
Loop Until InKey = Chr(27)
|
So ist es lauffähig, nur gibt es viel zu früh eine Kollision meldung!
Ich bin für jeden Tip dankebar.
mfg |
|
| Nach oben |
|
 |
frebas
Anmeldungsdatum: 20.06.2008
Beiträge: 245
|
| Verfasst am: 09.01.2009, 00:24 Titel: |
|
|
| Ich hab bei dem code noch nicht versucht durchzublicken, aber mir z.B. hilft es immmer wenn ich einen Fheler finden will, die wichtigen Variablen im Programm anzeigen zu lassen, evtl. auch die Ergebnisse von den Rechnungen. |
|
| Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008
Beiträge: 565
Wohnort: Jüterbog
|
| Verfasst am: 09.01.2009, 20:05 Titel: |
|
|
Hab das Tutorial einfach nochmal umgesetzt
Das Tutorial hat meiner Meinung nach nen Fehler im Kollisionspart
hab ein paar Sachen weggelassen - es scheint jetzt zu funzen
| Code: |
SCREENRES 800,600,32,2
SCREENSET 1,0
type obj
x as integer
y as integer
w as integer
h as integer
ox as integer
oy as integer
end type
dim as obj ufo,baum
with ufo
.x=0
.y=0
.w=40
.h=40
end with
with baum
.x=200
.y=200
.w=90
.h=90
end with
dim as uinteger ptr img_ufo,img_baum
img_ufo = IMAGECREATE(ufo.w,ufo.h)
img_baum= IMAGECREATE(baum.w,baum.h)
PAINT img_ufo,(2,2),RGB(255,0,255)
CIRCLE img_ufo,(19,19),15,RGB(100,100,255),,,,F
PAINT img_baum,(2,2),RGB(255,0,255)
CIRCLE img_baum,(44,44),40,RGB(0,160,0),,,,F
dim as integer mx,my,osX,osY,px,py,collision
dim as uinteger pufo,pbaum
do
GETMOUSE mx,my
ufo.x=mx-20
ufo.y=my-20
'die Hochkomma bitte entfernen
PUT (baum.X,baum.y),img_baum',trans
PUT (ufo.X,ufo.y),img_ufo',trans
'Überlappung überprüfen !!!!!!
if(((ufo.x >= baum.x and ufo.x <= baum.x+baum.w) or _
(baum.x >= ufo.x and baum.x <= ufo.x+ufo.w)) and _
((ufo.y >= baum.y and ufo.y <= baum.y+baum.h) or _
(baum.y >= ufo.y and baum.y <= ufo.y+ufo.h))) then
locate(1,1):print"Ueberlappung"
ufo.ox=0
ufo.oy=0
baum.ox=0
baum.oy=0
osX=ufo.w
osY=ufo.h
IF(osX > baum.w) THEN osX = baum.w
IF(osY > baum.h) THEN osX = baum.h
if ufo.x < baum.x then
ufo.ox = baum.x - ufo.x
if baum.x+baum.w > ufo.x+ufo.w then osX=ufo.x+ufo.w-baum.x
else
baum.ox = ufo.x - baum.x
if ufo.x + ufo.w > baum.x + baum.w then osX=baum.x+baum.w-ufo.x
end if
if(ufo.y < baum.y) then
ufo.oy = baum.y - ufo.y
if(baum.y+baum.h > ufo.y+ufo.h) then osY=ufo.y+ufo.h-baum.y
else
baum.oy = ufo.y - baum.y
if(ufo.y + ufo.h > baum.y + baum.h) then osY=baum.y+baum.h-ufo.y
end if
'Point liefert hier (32bpp) einen Farbwert mit alpha-channel(hat mit Transparenz zu tun) vorne dran
'also &HFFFF00FF
'aus diesem Grund sind puo und pbaum auch uinteger
for px=0 to osX-1
for py=0 to osY-1
pufo=point(ufo.ox + px,ufo.oy + py,img_ufo)
pbaum=point(baum.ox + px,baum.oy + py,img_baum)
if pufo<>&HFFFF00FF and pbaum<>&HFFFF00FF and collision=0 then collision=1
next py
next px
if collision then
locate(3,1):print "!!!!!! Kollision !!!!!"
end if
collision=0
else
locate(1,1):print " "
locate(3,1):print " "
end if
SCREENCOPY
sleep 1
cls
LOOP UNTIL INKEY <>""
IMAGEDESTROY img_ufo 'nicht vergessen !
IMAGEDESTROY img_baum 'nicht vergessen !
end
|
Mutton
Zuletzt bearbeitet von Muttonhead am 09.01.2009, 20:08, insgesamt einmal bearbeitet |
|
| Nach oben |
|
|
isiprimax
Anmeldungsdatum: 02.01.2009
Beiträge: 77
|
| Verfasst am: 09.01.2009, 20:07 Titel: |
|
|
Ich denke es liegt am Point befehl.
Der funktioniert nicht mit 32 bit Farbtiefe.
In der 16 bit Version schon.
Kleiner Code zum Verständniss.
| Code: | 'test01
'| Hier auf 16 oder 32 machen!
ScreenRes 800,600,32,2
ScreenSet 1,0
Dim As Integer xpos,ypos,pixel1,a=1
Type objekt
x As Integer
y As Integer
gx As Integer
gy As Integer
ox As Integer
oy As Integer
bild As Any Ptr
End Type
Dim As objekt feind
With feind
.x = 0
.y = 0
.gx = 7
.gy = 7
.bild = ImageCreate (feind.gx,feind.gy,RGB(255,0,255))
End With
PSet feind.bild,(2,2),RGB(255,255,255)
Do
Sleep 1
Cls
Put (feind.x,feind.y),feind.bild
?:?:?"Bild gelesen von Bildschrim"
For xpos = 0 To (feind.gx-1)
For ypos = 0 To (feind.gy-1)
pixel1 = Point (xpos,ypos) 'vom bildschrim
Print a;". ";xpos;",";ypos;" = ";pixel1
a+=1
Next
Next
ScreenCopy
a=1
Cls
Sleep
Put (feind.x,feind.y),feind.bild
?:?:?"Bild gelesen aus Speicher"
For xpos = 0 To (feind.gx-1)
For ypos = 0 To (feind.gy-1)
pixel1 = Point (xpos,ypos,feind.bild) 'aus dem Speicher
Print a;". ";xpos;",";ypos;" = ";pixel1
a+=1
Next
Next
ScreenCopy
Sleep
?"Ende mit Taste"
ScreenCopy
Sleep
End
Loop Until InKey = Chr(27)
End
|
|
|
| Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008
Beiträge: 565
Wohnort: Jüterbog
|
| Verfasst am: 09.01.2009, 20:12 Titel: |
|
|
Kreuzfeuer 
ja Point liefert nicht nur RRGGBB sondern AARRGGBB soweit ich weiss
AA >> ALPHAChannel für Transparenz
Mutton |
|
| Nach oben |
|
|
isiprimax
Anmeldungsdatum: 02.01.2009
Beiträge: 77
|
| Verfasst am: 09.01.2009, 20:28 Titel: |
|
|
| Das kann gut sein, nur wieso macht das auf einmal als rückgabe wert -65xxxx ka genau und bei blau = -1. das ist was ich nicht versteh. |
|
| Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008
Beiträge: 565
Wohnort: Jüterbog
|
| Verfasst am: 09.01.2009, 20:43 Titel: |
|
|
also bei 32bpp Screen enthält ein Image den alpha-channel
deswegen enthält point AARRGGBB
hingegen point vom Schirm nur RRGGBB beinhaltet
frag mich jetzt nicht warum...
hab mal pixel1 auf uinteger gesetzt und als hex ausgegeben, da siehst du es genauer. Die 2 zusätzlichen "F" vorne dran.
edit:
beim Bildschirm die Werte von Point einfach mit &HFF000000 verknüpfen:
pixel1=&HFF000000 or POINT (xpos,ypos)
dann sind die Werte gleich 
| Code: |
'test01
'| Hier auf 16 oder 32 machen!
SCREENRES 800,600,32,2
SCREENSET 1,0
DIM AS INTEGER xpos,ypos,a=1
dim as uinteger pixel1
TYPE objekt
x AS INTEGER
y AS INTEGER
gx AS INTEGER
gy AS INTEGER
ox AS INTEGER
oy AS INTEGER
bild AS ANY PTR
END TYPE
DIM AS objekt feind
WITH feind
.x = 0
.y = 0
.gx = 7
.gy = 7
.bild = IMAGECREATE (feind.gx,feind.gy,RGB(255,0,255))
END WITH
PSET feind.bild,(2,2),RGB(255,255,255)
DO
SLEEP 1
CLS
PUT (feind.x,feind.y),feind.bild
?:?:?"Bild gelesen von Bildschrim"
FOR xpos = 0 TO (feind.gx-1)
FOR ypos = 0 TO (feind.gy-1)
pixel1 =&HFF000000 or POINT (xpos,ypos) 'vom bildschrim
PRINT a;". ";xpos;",";ypos;" = ";hex(pixel1)
a+=1
NEXT
NEXT
SCREENCOPY
a=1
CLS
SLEEP
PUT (feind.x,feind.y),feind.bild
?:?:?"Bild gelesen aus Speicher"
FOR xpos = 0 TO (feind.gx-1)
FOR ypos = 0 TO (feind.gy-1)
pixel1 = POINT (xpos,ypos,feind.bild) 'aus dem Speicher
PRINT a;". ";xpos;",";ypos;" = ";hex(pixel1)
a+=1
NEXT
NEXT
SCREENCOPY
SLEEP
?"Ende mit Taste"
SCREENCOPY
SLEEP
END
LOOP UNTIL INKEY = CHR(27)
END
|
|
|
| Nach oben |
|
|
isiprimax
Anmeldungsdatum: 02.01.2009
Beiträge: 77
|
| Verfasst am: 13.01.2009, 22:01 Titel: |
|
|
Bei der Kollision abfrage scheint was nicht richtig zu sein.
Weiss einer gutes Tutorial zu einer 2D Pixelgenauen kolision?
Oder hat gute Ratschläge ?
cu |
|
| Nach oben |
|
|
isiprimax
Anmeldungsdatum: 02.01.2009
Beiträge: 77
|
| Verfasst am: 16.01.2009, 02:08 Titel: |
|
|
| ok habs hinbekommen. Gelöst!! |
|
| Nach oben |
|
|
|
|
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
|
|
FAQ
Suchen
Mitgliederliste
Benutzergruppen
Registrieren
Profil
Einloggen, um private Nachrichten zu lesen
Login
