 |
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 |
mkfezzo
Anmeldungsdatum: 16.08.2007
Beiträge: 25
|
 Verfasst am: 25.03.2010, 20:43 Titel: Hänge bei kleinem get/put-problem (grafik) (gelöst) |
 |
|
Hallo zusammen,
ich hänge bei einem projekt etwas fest: ich versuche per get und put einen "sprite" zu bewegen und habe erstmal ne kleine bewegungsroutine rausgehauen. läuft auch ganz ok, bis ich nun hintergrund einfüge. ich hänge den code mal an den text an. ich habe die sprites durch einen block ersetzt, um die grafikdateien nicht gleich mithochzuladen. diesen block kann man per mausklick links auf die gewünschte position verschieben. darunter liegt ein kreis (hitergrund). verschiebt mal den block ein stück nach links und dann anschliessend wieder zum rechten rand, dann seht ihr was ich meine - der hintergrund läuft mit...passiert aber nicht bei anderen verschiebungen. das rechteck um den block zeigt die maske, die ich immer vor der verschiebung wieder put-te. müsste eigentlich reichen-tuts aber nicht! irgendwer ne idee?
| Code: |
dim shared e(20,168*169) as integer
dim as integer t,x,y,r,mx,my,mr,ms,raus,mov
dim as string txt,a
screen 19,32,,
cls
for t=1 to 8
'txt="D:\Program Files\FreeBASIC\progs\neu\e"+str(t)+".bmp"
'bload txt
line(10,10)-(158,159),rgb(255,255,255),bf
get(1,1)-(166,167),e(t,0)
next t
'put(100,100),e(5,0),trans
cls
circle(200,200),50,rgb(100,100,100),,,,f
x=100:y=100:r=3:raus=0
get(x,y)-(x+168,y+167),e(9,0)
line(x,y)-(x+168,y+167),rgb(200,200,200),b
put(x,y),e(r,0),trans
do
a=inkey
getmouse mx,my,mr,ms
'locate 1,1:?mx,my,ms
if ms=1 then
mx=mx-166/2
my=my-166/2
raus=0
if mx>=x and my>=y and raus=0 then
do
if r<4 then r=r+1
if r>4 then r=r-1
put(x,y),e(9,0),pset
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync:sleep 50
loop until r=4
do
put(x,y),e(9,0),pset
mov=0
if x<mx then x=x+1:r=3:mov=1
if y<my then y=y+1:r=5:mov=1
if x<mx and y<my then r=4:mov=1
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync
raus=1
loop until mov=0
end if
if mx>=x and my<=y and raus=0 then
do
if r<2 then r=r+1
if r>2 then r=r-1
put(x,y),e(9,0),pset
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync:sleep 50
loop until r=2
do
put(x,y),e(9,0),pset
mov=0
if x<mx then x=x+1:r=3:mov=1
if y>my then y=y-1:r=1:mov=1
if x<mx and y>my then r=2:mov=1
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync
raus=1
loop until mov=0
end if
if mx<=x and my<=y and raus=0 then
do
if r<8 then r=r+1
if r>8 then r=r-1
put(x,y),e(9,0),pset
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync:sleep 50
loop until r=8
do
put(x,y),e(9,0),pset
mov=0
if x>mx then x=x-1:r=7:mov=1
if y>my then y=y-1:r=1:mov=1
if x>mx and y>my then r=8:mov=1
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync
raus=1
loop until mov=0
end if
if mx<x and my>y and raus=0 then
do
if r<6 then r=r+1
if r>6 then r=r-1
put(x,y),e(9,0),pset
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync:sleep 50
loop until r=6
do
put(x,y),e(9,0),pset
mov=0
if x>mx then x=x-1:r=7:mov=1
if y<my then y=y+1:r=5:mov=1
if x>mx and y<my then r=6:mov=1
get(x,y)-(x+168,y+167),e(9,0)
put(x,y),e(r,0),trans
line(x,y)-(x+168,y+167),rgb(200,200,200),b
screensync
raus=1
loop until mov=0
end if
end if
sleep 1
loop until a=chr(27)
|
Zuletzt bearbeitet von mkfezzo am 25.03.2010, 21:33, insgesamt einmal bearbeitet |
|
| Nach oben |
|
 |
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4597
Wohnort: ~/
|
| Verfasst am: 25.03.2010, 21:06 Titel: |
|
|
Ich nehme mal an, der Fehler passiert, wenn sich der Block teilweise außerhalb des Fensters befindet? Ich frage deshalb, weil da bei mir das Programm abstürzt; es möchte außerhalb des Grafikfensters lesen. Ich könnte mir vorstellen, dass bei dir der gelesene Buffer angepasst wird und damit der falsche Bildschirmbereich gelesen wird. Ist aber nur eine Vermutung.
Als Lösungsvorschlag: Lies nicht den gesamten Bereich ein, sondern nur den, der sich im Grafikfenster befindet. Muss man ein bisschen tüfteln, lässt sich aber bewerkstelligen, wie ich von meinem patfinder weiß. 
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
mkfezzo
Anmeldungsdatum: 16.08.2007
Beiträge: 25
|
| Verfasst am: 25.03.2010, 21:27 Titel: |
|
|
| Jep! - ist ja witzig. ich habe den kreis weiter in die mitte gelegt ...und bin nochmals aus allen richtungen mit dem block darübergeschwebt: no problem! passiert also echt nur, wenn ich aus dem fenster rutsche. Das ist doch mal wenigstens ein ansatz...dachte schon ich krieg die kurve mal wieder nicht. THX...wär ich sooo schnell nicht drauf gekommen. |
|
| Nach oben |
|
|
Luke
Anmeldungsdatum: 14.01.2009
Beiträge: 92
Wohnort: Ostfriesland !
|
| Verfasst am: 28.03.2010, 15:19 Titel: |
|
|
Moin!
Ich hab mal sowas ähnliches programmiert. Probier das doch mal aus:
| Code: | dim shared g1(90000) as string
dim shared h(90000) as string
dim as integer x,y,i,i2
screen 20,32,3
screenset 1, 0
randomize timer
dim as integer r, g, b,ri, ab
ab =0
ri = 3
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (16, 16), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (16, 216), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (216, 16), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 16 to 0 step-1
circle (216, 216), y, RGB(r,g,b),,,,F
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 0 to 16
line (16, y)-(216, y), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for y = 232 to 216 step-1
line (16, y)-(216, y), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next y
r = 100
g = 10
b = 10
for x = 0 to 16
line (x, 16)-(x, 216), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next x
r = 100
g = 10
b = 10
for x = 232 to 216 step-1
line (x, 16)-(x-ab, 216), rgb(r, g, b)
r = r + 20
if r > 255 then
b = b + ri
g = g + ri
r = 255
end if
next x
line (17,17)-(215, 215),RGB(r,g,b),BF
'line (0,0)-(220,220),rgb(100,0,0),bf
get (0,0)-(232,232),h
cls
dim as integer t, c,c2,c3,an,ps,pz
for t = 1 to 50
an = rnd*255
c = rnd*(255-an)
c2 = rnd*(255-an)
c3 = rnd*(255-an)
ps = rnd*1024
pz = rnd*768
for i = an to 0 step-1
circle (ps, pz), i,RGB(c,c2,c3),,,,F
c = c+1
c2 = c2+1
c3 = c3+1
next
next
pcopy 1, 0
sleep
i = 1
i2 = 1
x = 256
y = 192
setmouse ,,0,1
do
getmouse x,y
if x > 823 then setmouse 823,y,0,1
if y > 567 then setmouse x,567,0,1
screenset 1, 0
get (x,y)-(x+200,y+200),g1
screenset 0, 2
cls
put (x-16,y-16),h
line (x,y)-(x+200,y+200),rgb(0,0,0),bf
line (x-1,y-1)-(x+201,y+201),rgb(100,0,0),b
put (x,y),g1
pcopy 0, 2
loop until inkey$ =CHR(27)
end |
Ist nicht ganz sooo schön, aber es funzt. 
_________________
ICH war mal schizophren, aber jetzt sind WIR okay. |
|
| Nach oben |
|
|
mkfezzo
Anmeldungsdatum: 16.08.2007
Beiträge: 25
|
| Verfasst am: 29.03.2010, 20:21 Titel: |
|
|
| Hi Luke, naja nicht ganz so schöööön? sieht super aus und ist ganz schön weich beim scrollen...aaaaaber: geh mal mit deinem Rechteck an den rechten rand oder an den unteren...wenn mich nicht alles täuscht "flackert" da genau das selbe prob wie bei meinem Beispiel. bin übrigens erstmal ne ecke weiter - nur schränkt mich das "überdenranddarfstenichtgettenundputten" echt noch ein. |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4597
Wohnort: ~/
|
| Verfasst am: 29.03.2010, 21:20 Titel: |
|
|
Ich habe mir dazu was erarbeitet, was problemlos funktioniert, aber das ist so programmspezifisch, dass ich erst mal sehen muss, ob ich das wieder extrahieren kann ...
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4597
Wohnort: ~/
|
| Verfasst am: 31.03.2010, 11:55 Titel: |
|
|
Du kannst das hier mal probieren; ohne Gewähr (der kurze Test sah ganz gut aus):
| Code: | type koord
as integer startx, starty, endx, endy
end type
declare function berechne(x as integer, y as integer) as koord
screenres 400, 400
dim as integer mx, my, ax, ay
dim as any ptr bild = imagecreate(50, 50, 1), temp
dim as koord box
circle (199, 199), 190, 4,,,, f
do
getmouse mx, my
sleep 1
loop until mx >= 0 and mx < 400
box = berechne(mx, my)
temp = imagecreate(box.endx-box.startx+1, box.endy-box.starty+1)
get (box.startx, box.starty)-(box.endx, box.endy), temp
put (box.startx, box.starty), bild, (25+box.startx-mx, 25+box.starty-my)-(25+box.endx-mx, 25+box.endy-my), pset
ax = mx
ay = my
do
getmouse mx, my
if mx >= 0 and mx < 400 then
put (box.startx, box.starty), temp, pset
imagedestroy temp
box = berechne(mx, my)
temp = imagecreate(box.endx-box.startx+1, box.endy-box.starty+1)
get (box.startx, box.starty)-(box.endx, box.endy), temp
put (box.startx, box.starty), bild, (25+box.startx-mx, 25+box.starty-my)-(25+box.endx-mx, 25+box.endy-my), pset
ax = mx
ay = my
end if
sleep 1
loop until inkey <> ""
imagedestroy temp
imagedestroy bild
function berechne(x as integer, y as integer) as koord
dim ret as koord
ret.startx = iif(x < 25, 0, x - 25)
ret.starty = iif(y < 25, 0, y - 25)
ret.endx = iif(x > 374, 399, x + 24)
ret.endy = iif(y > 374, 399, y + 24)
return ret
end function |
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| 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
