 |
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 |
Grassstunger
Anmeldungsdatum: 27.12.2009
Beiträge: 11
|
 Verfasst am: 27.12.2009, 23:17 Titel: Programm Flimmert gewaltig!!! |
 |
|
Hi, ich hab ein ganz simples Retro game in etwa 250 Zeilen Programmiert aber jetz flimmert es un ausstehlich stark, hat jemand ein tip um es zu verringern???  [/url] |
|
| Nach oben |
|
 |
MOD
Fleißiger Referenzredakteur
Anmeldungsdatum: 10.09.2007
Beiträge: 1003
|
| Verfasst am: 27.12.2009, 23:33 Titel: |
|
|
Hi und willkommen im Forum.
Ich denke ein Screenlock vor dem Zeichnen und ein Screenunlock danach könnten dir helfen |
|
| Nach oben |
|
|
Grassstunger
Anmeldungsdatum: 27.12.2009
Beiträge: 11
|
| Verfasst am: 27.12.2009, 23:46 Titel: |
|
|
Juhuu es hat aufgehört zu flimmern dafür Ruckelts jetzt XD
Ich lads mal grad up, dann könnt ihr s euch ja ansehn, (evtl ruckelts ja nur bei meinem PC, da der So lahm ist, aber das bezweifle ich) |
|
| Nach oben |
|
|
Grassstunger
Anmeldungsdatum: 27.12.2009
Beiträge: 11
|
| Verfasst am: 27.12.2009, 23:46 Titel: |
|
|
Juhuu es hat aufgehört zu flimmern dafür Ruckelts jetzt XD
Ich lads mal grad up, dann könnt ihr s euch ja ansehn, (evtl ruckelts ja nur bei meinem PC, da der So lahm ist, aber das bezweifle ich)
(hoppla 2 mal auf absenden gedrückt XD)
http://rapidshare.com/files/326730771/shooter.rar |
|
| Nach oben |
|
|
MOD
Fleißiger Referenzredakteur
Anmeldungsdatum: 10.09.2007
Beiträge: 1003
|
| Verfasst am: 27.12.2009, 23:52 Titel: |
|
|
Um Doppelposts zu vermeiden gibt es rechts über deinem Post ein Button "edit" zum editieren.
Rapidshare würde ich vermeiden, der Download geht zum Beispiel bei mir gerade nicht. Code kannst du auch in einem NoPaste System einstellen und verlinken oder, falls der Code nicht zu lang ist, direkt ins Forum mit den [code]-tags. |
|
| Nach oben |
|
|
Grassstunger
Anmeldungsdatum: 27.12.2009
Beiträge: 11
|
| Verfasst am: 27.12.2009, 23:59 Titel: |
|
|
okay, schreibe mal einfach den code hinein, bilder sounds und bi`s sind halt nicht dabei (ja ich weiss das die meisten Variabeln komische Namen haben, aber so kann ich mir die besser merken^^).
PS: Dies ist mein ERSTES Programm nach Hello World, also nicht verwundern wenn irgendwas Hirnrissiges dabei ist^^
WICHTIG: Wenn jemand es runtergeladen hat sollte er zwischen linie 217 und 218 noch screenunlock ergänzen, ansonsten stürzt es ab wenn mann drei mal wo reingefahren ist 
| Code: |
randomize timer
Screenres 1024, 768 ,32 , 1,&H01
setmouse 0,0,0
Dim enemy As Any Ptr = ImageCreate( 80, 80 )
Dim jude As Any Ptr = ImageCreate( 80, 80 )
BLoad "Grafix\Player.bmp", jude
Bload "Grafix\enemy.bmp", enemy
Dim Laser As Any Ptr = ImageCreate( 80, 80 )
BLoad "Grafix\Laser.bmp", Laser
Dim Leben As Any Ptr = ImageCreate( 13, 13 )
BLoad "Grafix\Leben.bmp", Leben
Dim Punkte as Single
Punkte = 0
dim b as single
b =50
dim Fertig as single
Fertig = 1
dim c as single
c = 50
dim Speed as single
Speed = 80
Dim name_player as string
color rgb (0,255,0)
do
Locate 1,1
input "What is your name? ", name_player
loop until name_player <>""
'Mp3
#INCLUDE "fmod.bi"
' 48kHz sample rate, 8 channels.
FSOUND_Init(48000, 8, 0)
DIM mp3Sound(1 to 100) AS INTEGER PTR
Locate 2,1
Print "Loading Soundtracks..."
DIM Background_Music AS STRING="Sounz\Background.mp3"
DIM Crash_Sound AS STRING="Sounz\Crash1.mp3"
DIM Laser_Sound AS STRING="Sounz\Laser1.mp3"
DIM Laser_Crash AS STRING="Sounz\Crash2.mp3"
mp3Sound(1) = FSOUND_Sample_Load(FSOUND_FREE, Background_Music, 0, 0, 0)
mp3Sound(2) = FSOUND_Sample_Load(FSOUND_FREE,Crash_Sound, 0, 0, 0)
mp3Sound(3) = FSOUND_Sample_Load(FSOUND_FREE,Laser_Sound, 0, 0, 0)
mp3Sound(4) = FSOUND_Sample_Load(FSOUND_FREE,Laser_Crash, 0, 0, 0)
'Musik Starten und endlos wiederholen
FSOUND_Sample_SetMode(mp3Sound(1), FSOUND_LOOP_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(1))
dim d as single
dim q as integer
for q = -20 to 20
next
dim zeit as double
Dim Jesus(1 to 200,1 to 4,1 to 2) as integer
dim zahl as integer
for zahl = 1 to 200
Jesus(zahl,1,1) = rnd*1024
Jesus(zahl,1,2) = rnd*768
Jesus(zahl,2,1) = rnd*1024
Jesus(zahl,2,2) = rnd*768
Jesus(zahl,3,1) = rnd*1024
Jesus(zahl,3,2) = rnd*768
Jesus(zahl,4,1) = rnd*1024
Jesus(zahl,4,2) = rnd*768
next
Dim Moses(1 to 5,1 to 2) as integer
dim zahly as integer
for zahly = 1 to 5
Moses(zahly,1) = rnd*1024+900
Moses(zahly,2) = rnd*688
next
Dim Live as single
Live = 3
dim LZ as integer
for LZ = 1 to Live
next
Dim Laser_Shot(1 to 15,1 to 2) as integer
dim shoot_counter as integer
do
screenlock
cls
zeit = timer
'Lebens anzeige
'Steuerung des eigenen Raumschiffes
if multikey(&h48) then c=c-10 end if
if multikey(&h50) then c=c+10 end if
if multikey(&h10) then
end
end if
if c <0 then
c=0
end if
if c > 688 then
c=688
end if
'Laser
If multikey(&h1C) and shoot_counter = 0 then
'Leere Variabel suchen
For Zahl = 1 to 15
if laser_shot(zahl,1) = 0 then
exit for
end if
next
FSOUND_Sample_SetMode(mp3Sound(3), FSOUND_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(3))
laser_shot(zahl,1) = 80
laser_shot(zahl,2) = c
shoot_counter = 10
end if
For Zahl = 1 to 15
if laser_shot(zahl,1) <> 0 then
laser_shot(zahl,1)=laser_shot(zahl,1)+25
put (laser_shot(zahl,1),laser_shot(zahl,2)),laser, trans
if laser_shot(zahl,1)>1024 then
laser_shot(zahl,1)=0
end if
end if
next
'Sterne
for zahl = 1 to 200
Jesus(zahl,1,1) = Jesus(zahl,1,1) - 1
Jesus(zahl,2,1) = Jesus(zahl,2,1) - 2
Jesus(zahl,3,1) = Jesus(zahl,3,1) - 3
Jesus(zahl,4,1) = Jesus(zahl,4,1) - 10
pset (Jesus(zahl,1,1),Jesus(zahl,1,2)),rgb(255,255,255)
pset (Jesus(zahl,2,1),Jesus(zahl,2,2)),rgb(255,255,255)
pset (Jesus(zahl,3,1),Jesus(zahl,3,2)),rgb(255,255,255)
pset (Jesus(zahl,4,1),Jesus(zahl,4,2)),rgb(255,255,255)
if Jesus(zahl,1,1)<0 then Jesus(zahl,1,1)=1024 end if
if Jesus(zahl,2,1)<0 then Jesus(zahl,2,1)=1024 end if
if Jesus(zahl,3,1)<0 then Jesus(zahl,3,1)=1024 end if
if Jesus(zahl,4,1)<0 then Jesus(zahl,4,1)=1024 end if
next
'Feinde
for zahly = 1 to 5
Moses(zahly,1) = Moses(zahly,1) - 6
for zahl = 1 to 15
for q = -40 to 40
'Elimination durch Laser
if Moses(zahly,1)=laser_shot(zahl,1)+q+20 and Moses(zahly,2)>laser_shot(zahl,2)+q and Moses(zahly,2)<laser_shot(zahl,2)-q and moses(zahly,1)<1000 and moses(zahly,1)>130 then
moses(zahly,1)=1024+rnd*55
moses(zahly,2)=rnd*688
FSOUND_Sample_SetMode(mp3Sound(4), FSOUND_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(4))
Punkte=Punkte+100
Speed=Speed+0.5
end if
'Ins Raumschiff reinfahren
if Moses(zahly,1)<b+80 and Moses(zahly,2)=c+q and moses(zahly,1) > 15 then
FSOUND_Sample_SetMode(mp3Sound(2), FSOUND_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(2))
Live=Live-1
moses(zahly,1)=1024+rnd*55
moses(zahly,2)=rnd*688
end if
next
next
if Moses(zahly,1)<-80 then
moses(zahly,1)=1024+rnd*55
moses(zahly,2)=rnd*688
end if
put (moses(zahly,1),Moses(zahly,2)), enemy , trans
next
'Läbu
if live > 0 Then
Put (490,10), leben , trans
if live > 1 then
Put (505,10), leben , trans
if live > 2 then
Put (520,10), leben , trans
end if
end if
end if
if live <= 0 then
screenunlock
cls
Locate 20,30
Print "Player: ";Name_Player
Locate 20,70
Print"Punkte: ";Punkte
Locate 35,30
Print "Nochmal Spielen? ";"Drücke J fuer Ja, N fuer Nein"
do
if multikey(&h24) then
Live= 3
Punkte=0
Speed = 80
c=50
for zahly = 1 to 5
moses(zahly,1)=rnd*1024+1000
moses(zahly,2)=rnd*688
next
end if
if multikey(&h31) then
end
end if
loop until Live=3
end if
Put (b,c), jude , trans
if shoot_counter > 0 then shoot_counter = shoot_counter - 1 end if
Locate 2,1
print "Punkte: " ; Punkte
do
loop until zeit + (1/Speed) < timer
pcopy 0,1
screenunlock
loop until Fertig<>1
sleep
|
|
|
| Nach oben |
|
|
St_W
Anmeldungsdatum: 22.07.2007
Beiträge: 956
Wohnort: Austria
|
| Verfasst am: 28.12.2009, 00:43 Titel: |
|
|
Hab ich eigentlich schon einmal gesagt wie ich Rapidshare hasse. Naja jedenfalls kann ich wieder einmal nicht herunterladen:
| Zitat: | Diese Datei können Sie nur als Premium-Mitglied runterladen.
Es sind derzeit keine freien Download-Plätze für Nicht-Mitglieder verfügbar. Falls Sie kein Premium-Mitglied werden wollen, können Sie den Download später noch einmal probieren. |
Könntest du die Datei bitte irgendwo anders hochladen? (z.B. http://uploaded.to/ oder http://netload.in/ oder http://megaupload.com/ oder ...). Ziemlich jeder Hoster ist besser als Rapidshare, darum kann ich einfach nicht verstehen, warum dort noch immer so viel hochgeladen wird.
Dann wären nämlich auch die Grafiken dabei, die hier fehlen, und man könnte seine Vorschläge ausprobieren.
_________________
Aktuelle FreeBasic Builds, Projekte, Code-Snippets unter http://users.freebasic-portal.de/stw/
http://www.mv-lacken.at Musikverein Lacken (MV Lacken) |
|
| Nach oben |
|
|
Grassstunger
Anmeldungsdatum: 27.12.2009
Beiträge: 11
|
| Verfasst am: 28.12.2009, 00:52 Titel: |
|
|
http://ul.to/8snk7o
ist bei uploaded.to, version funzt ohne die ergänzung die ich vorhin erwähnt hab, da ich sie selber hinzugefügt hab^^ |
|
| Nach oben |
|
|
Muttonhead
Anmeldungsdatum: 26.08.2008
Beiträge: 565
Wohnort: Jüterbog
|
| Verfasst am: 28.12.2009, 01:16 Titel: |
|
|
hab mal, statt screenlocks, mit nem Pageflip schnell was gebastelt.
bin mir aber nicht so sicher obs so richtig ist, aber es läuft.
an der politisch korrekten Variablen-Namen-Wahl solltest du aber noch dringendst arbeiten 
Mutton
| Code: | randomize timer
Screenres 1024, 768 ,32 , 2,&H01'<------------------------------------------
setmouse 0,0,0
Dim enemy As Any Ptr = ImageCreate( 80, 80 )
Dim jude As Any Ptr = ImageCreate( 80, 80 )
BLoad "Grafix\Player.bmp", jude
Bload "Grafix\enemy.bmp", enemy
Dim Laser As Any Ptr = ImageCreate( 80, 80 )
BLoad "Grafix\Laser.bmp", Laser
Dim Leben As Any Ptr = ImageCreate( 13, 13 )
BLoad "Grafix\Leben.bmp", Leben
Dim Punkte as Single
Punkte = 0
dim b as single
b =50
dim Fertig as single
Fertig = 1
dim c as single
c = 50
dim Speed as single
Speed = 80
Dim name_player as string
color rgb (0,255,0)
do
Locate 1,1
input "What is your name? ", name_player
loop until name_player <>""
'Mp3
#INCLUDE "fmod.bi"
' 48kHz sample rate, 8 channels.
FSOUND_Init(48000, 8, 0)
DIM mp3Sound(1 to 100) AS INTEGER PTR
Locate 2,1
Print "Loading Soundtracks..."
DIM Background_Music AS STRING="Sounz\Background.mp3"
DIM Crash_Sound AS STRING="Sounz\Crash1.mp3"
DIM Laser_Sound AS STRING="Sounz\Laser1.mp3"
DIM Laser_Crash AS STRING="Sounz\Crash2.mp3"
mp3Sound(1) = FSOUND_Sample_Load(FSOUND_FREE, Background_Music, 0, 0, 0)
mp3Sound(2) = FSOUND_Sample_Load(FSOUND_FREE,Crash_Sound, 0, 0, 0)
mp3Sound(3) = FSOUND_Sample_Load(FSOUND_FREE,Laser_Sound, 0, 0, 0)
mp3Sound(4) = FSOUND_Sample_Load(FSOUND_FREE,Laser_Crash, 0, 0, 0)
'Musik Starten und endlos wiederholen
FSOUND_Sample_SetMode(mp3Sound(1), FSOUND_LOOP_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(1))
dim d as single
dim q as integer
for q = -20 to 20
next
dim zeit as double
Dim Jesus(1 to 200,1 to 4,1 to 2) as integer
dim zahl as integer
for zahl = 1 to 200
Jesus(zahl,1,1) = rnd*1024
Jesus(zahl,1,2) = rnd*768
Jesus(zahl,2,1) = rnd*1024
Jesus(zahl,2,2) = rnd*768
Jesus(zahl,3,1) = rnd*1024
Jesus(zahl,3,2) = rnd*768
Jesus(zahl,4,1) = rnd*1024
Jesus(zahl,4,2) = rnd*768
next
Dim Moses(1 to 5,1 to 2) as integer
dim zahly as integer
for zahly = 1 to 5
Moses(zahly,1) = rnd*1024+900
Moses(zahly,2) = rnd*688
next
Dim Live as single
Live = 3
dim LZ as integer
for LZ = 1 to Live
next
Dim Laser_Shot(1 to 15,1 to 2) as integer
dim shoot_counter as integer
screenset 1,0'<------------------------------------------
do
cls
zeit = timer
'Lebens anzeige
'Steuerung des eigenen Raumschiffes
if multikey(&h48) then c=c-10 end if
if multikey(&h50) then c=c+10 end if
if multikey(&h10) then
end
end if
if c <0 then
c=0
end if
if c > 688 then
c=688
end if
'Laser
If multikey(&h1C) and shoot_counter = 0 then
'Leere Variabel suchen
For Zahl = 1 to 15
if laser_shot(zahl,1) = 0 then
exit for
end if
next
FSOUND_Sample_SetMode(mp3Sound(3), FSOUND_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(3))
laser_shot(zahl,1) = 80
laser_shot(zahl,2) = c
shoot_counter = 10
end if
'Sterne
for zahl = 1 to 200
Jesus(zahl,1,1) = Jesus(zahl,1,1) - 1
Jesus(zahl,2,1) = Jesus(zahl,2,1) - 2
Jesus(zahl,3,1) = Jesus(zahl,3,1) - 3
Jesus(zahl,4,1) = Jesus(zahl,4,1) - 10
pset (Jesus(zahl,1,1),Jesus(zahl,1,2)),rgb(255,255,255)
pset (Jesus(zahl,2,1),Jesus(zahl,2,2)),rgb(255,255,255)
pset (Jesus(zahl,3,1),Jesus(zahl,3,2)),rgb(255,255,255)
pset (Jesus(zahl,4,1),Jesus(zahl,4,2)),rgb(255,255,255)
if Jesus(zahl,1,1)<0 then Jesus(zahl,1,1)=1024 end if
if Jesus(zahl,2,1)<0 then Jesus(zahl,2,1)=1024 end if
if Jesus(zahl,3,1)<0 then Jesus(zahl,3,1)=1024 end if
if Jesus(zahl,4,1)<0 then Jesus(zahl,4,1)=1024 end if
next
'Feinde
for zahly = 1 to 5
Moses(zahly,1) = Moses(zahly,1) - 6
for zahl = 1 to 15
for q = -40 to 40
'Elimination durch Laser
if Moses(zahly,1)=laser_shot(zahl,1)+q+20 and Moses(zahly,2)>laser_shot(zahl,2)+q and Moses(zahly,2)<laser_shot(zahl,2)-q and moses(zahly,1)<1000 and moses(zahly,1)>130 then
moses(zahly,1)=1024+rnd*55
moses(zahly,2)=rnd*688
FSOUND_Sample_SetMode(mp3Sound(4), FSOUND_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(4))
Punkte=Punkte+100
Speed=Speed+0.5
end if
'Ins Raumschiff reinfahren
if Moses(zahly,1)<b+80 and Moses(zahly,2)=c+q and moses(zahly,1) > 15 then
FSOUND_Sample_SetMode(mp3Sound(2), FSOUND_NORMAL)
FSOUND_PlaySound(FSOUND_FREE, mp3Sound(2))
Live=Live-1
moses(zahly,1)=1024+rnd*55
moses(zahly,2)=rnd*688
end if
next
next
if Moses(zahly,1)<-80 then
moses(zahly,1)=1024+rnd*55
moses(zahly,2)=rnd*688
end if
put (moses(zahly,1),Moses(zahly,2)), enemy , trans
next
'Läbu
if live > 0 Then
Put (490,10), leben , trans
if live > 1 then
Put (505,10), leben , trans
if live > 2 then
Put (520,10), leben , trans
end if
end if
end if
if live <= 0 then
cls
Locate 20,30
Print "Player: ";Name_Player
Locate 20,70
Print"Punkte: ";Punkte
Locate 35,30
Print "Nochmal Spielen? ";"Drücke J fuer Ja, N fuer Nein"
do
if multikey(&h24) then
Live= 3
Punkte=0
Speed = 80
c=50
for zahly = 1 to 5
moses(zahly,1)=rnd*1024+1000
moses(zahly,2)=rnd*688
next
end if
if multikey(&h31) then
end
end if
screencopy'<------------------------------------------
loop until Live=3
end if
For Zahl = 1 to 15
if laser_shot(zahl,1) <> 0 then
laser_shot(zahl,1)=laser_shot(zahl,1)+25
if live>0 then
put (laser_shot(zahl,1),laser_shot(zahl,2)),laser, trans
if laser_shot(zahl,1)>1024 then
laser_shot(zahl,1)=0
end if
end if
end if
next
Put (b,c), jude , trans
if shoot_counter > 0 then shoot_counter = shoot_counter - 1 end if
Locate 2,1
print "Punkte: " ; Punkte
do
loop until zeit + (1/Speed) < timer
screencopy'<------------------------------------------
loop until Fertig<>1
sleep |
|
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 28.12.2009, 01:25 Titel: |
|
|
Das Flimmern kommt jedenfalls vom regelmäßigen CLS (gleich nach dem DO). Falls sich das vermeiden lässt, dann würde ich stattdessen lieber nur die veränderten Stellen neu zeichnen.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1. |
|
| Nach oben |
|
|
Grassstunger
Anmeldungsdatum: 27.12.2009
Beiträge: 11
|
| Verfasst am: 28.12.2009, 01:36 Titel: |
|
|
| inzwischen löifts prima, dank screenlock/unlock, weiss jemand wie man eine Rangliste Speichert bzw. abruft, da hab ich kein plan |
|
| Nach oben |
|
|
nemored
Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/
|
| Verfasst am: 28.12.2009, 01:57 Titel: |
|
|
Dateizugriff läuft z. B. über OPEN, PRINT # und INPUT #.
_________________
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
