 |
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: 02.05.2008, 16:18 Titel: Gehirn?trainer |
 |
|
Hi zusammen,
hier mal ein kleiner Versuch eine Idee aus einem "Gehirn-Jogging"-Programm, welche mir gefiel, in FreeBasic zu programieren...ist nur ein Anfang-aber vielleicht hat ja einer Spass dran. Ich komme bis Level 10 - dann wirds finster...
| Code: |
randomize timer
dim as integer x,y,xx,yy,mx,my,mr,ms,t,z,z1,rr,gg,bb,r,ok,notaus
dim as integer tim,tim1,score,anz,xstart,ystart,hit
dim as string soll,ist,a
dim f(10,10) as integer
dim pr(40,40) as integer
dim pl(40,40) as integer
dim po(40,40) as integer
dim pu(40,40) as integer
dim ps(40,40) as integer
declare sub build ()
screen 19,32,1,1
color rgb(255,255,255),rgb(0,0,150)
cls
build
for z=2 to 37
line(37,20)-(2,z),rgb(200,0+z*2,0+z*2)
next z
get(0,0)-(39,39),pr
build
for z=2 to 37
line(2,20)-(37,z),rgb(0+z*2,200,0+z*2)
next z
get(0,0)-(39,39),pl
build
for z=2 to 37
line(20,37)-(z,2),rgb(0+z*2,0+z*2,200)
next z
get(0,0)-(39,39),pu
build
for z=2 to 37
line(20,2)-(z,37),rgb(100,50+z*2,50+z*2)
next z
get(0,0)-(39,39),po
for z=40 to 1 step-1
line(0,0)-(x+z,y+z),rgb(100+z,100+z,100+z),b
next z
get(0,0)-(39,39),ps
anz=5 'länge des Weges am Start
tim=300 'Wartezeit 1
tim1=1000 'Wartezeit 2
do
do
loop until inkey=""
build
locate 36,1:? space$(80)
locate 36,1:? "SCORE: ";score,"LEVEL:";anz-4
'alte Werte löschen
for x=1 to 10
for y=1 to 10
f(x,y)=0
next y
next x
ist=""
soll=""
locate(27,1):?"Druecke eine Taste fuer Start:"
locate(28,1):?"Vorgezeigten Weg merken und genau nachgehen..."
locate(30,1):?"Pfeiltasten fuer links/rechts/hoch/runter ESC fuer Ende"
do
a=inkey
loop until a<>""
if a=chr(27) or a=chr(255,107) then end
locate (27,1):? space$(40)
xx=int(rnd(1)*8)+2
yy=int(rnd(1)*8)+2
xstart=xx
ystart=yy
put(xx*40-40,yy*40-40),ps,pset
f(xx,yy)=1
sleep tim
for t=1 to anz
ok=0:notaus=0
do
z=int(rnd(1)*4)+1
if z=1 and xx-1>0 then
if f(xx-1,yy)=0 then
xx=xx-1
f(xx,yy)=1
soll=soll+"L"
put(xx*40-40,yy*40-40),pl,pset
ok=1
end if
end if
if z=2 and xx+1<11 then
if f(xx+1,yy)=0 then
xx=xx+1
f(xx,yy)=1
put(xx*40-40,yy*40-40),pr,pset
soll=soll+"R"
ok=1
end if
end if
if z=3 and yy-1>0 then
if f(xx,yy-1)=0 then
yy=yy-1
f(xx,yy)=1
put(xx*40-40,yy*40-40),po,pset
soll=soll+"O"
ok=1
end if
end if
if z=4 and yy+1<11 then
if f(xx,yy+1)=0 then
yy=yy+1
f(xx,yy)=1
put(xx*40-40,yy*40-40),pu,pset
soll=soll+"U"
ok=1
end if
end if
notaus=notaus+1
if notaus>=10 then ok=1
loop until ok=1
sleep tim
next t
soll=soll+"X"
sleep tim1
build
for x=1 to 10
for y=1 to 10
f(x,y)=0
next y
next x
ok=0
hit=0
ist=""
xx=xstart:yy=ystart
put(xx*40-40,yy*40-40),ps,pset
f(xx,yy)=1
do
loop until inkey=""
do
a=inkey
if a=chr(27) or a=chr(255,107) then end
if a=chr(255,72) or a=chr(255,75) or a=chr(255,77) or a=chr(255,80) then hit=hit+1
if a=chr(255,75) and xx-1>0 then
if f(xx-1,yy)=0 then
xx=xx-1
f(xx,yy)=1
put(xx*40-40,yy*40-40),pl,pset
ist=ist+"L"
end if
end if
if a=chr(255,77) and xx+1<11 then
if f(xx+1,yy)=0 then
xx=xx+1
f(xx,yy)=1
put(xx*40-40,yy*40-40),pr,pset
ist=ist+"R"
end if
end if
if a=chr(255,72) and yy-1>0 then
if f(xx,yy-1)=0 then
yy=yy-1
f(xx,yy)=1
put(xx*40-40,yy*40-40),po,pset
ist=ist+"O"
end if
end if
if a=chr(255,80) and yy+1<11 then
if f(xx,yy+1)=0 then
'put(xx*40-40,yy*40-40),pu,pset
yy=yy+1
f(xx,yy)=1
put(xx*40-40,yy*40-40),pu,pset
ist=ist+"U"
end if
end if
if mid$(soll,hit+1,1)="X" then ok=1
if mid$(soll,hit,1)<>mid$(ist,hit,1) then
for t=1 to 40
draw string (xx*40-30,yy*40-40),"FALSCH!!!",rgb(0,255,0)
screensync:screensync
draw string (xx*40-30,yy*40-40),"FALSCH!!!",rgb(0,0,255)
screensync:screensync
draw string (xx*40-30,yy*40-40),"FALSCH!!!",rgb(255,0,0)
screensync:screensync
next t
ok=2
end if
'also:warte bis keine Taste gedrückt...tut's aber nicht!
do
loop until inkey=""
a="" 'zur Sicherheit auch noch die Eingabevariable leerpusten...tut's auch nicht!
loop until ok>0
sleep tim
if ok=1 then
score=score+((len(soll)-1)*anz)
anz=anz+1:ok=0
end if
if ok=2 then
score=0
anz=5:ok=0
end if
loop
sub build ()
dim as Integer x,y,z
cls
for y=0 to 399 step 40
for x=0 to 399 step 40
for z=40 to 1 step-1
line(x,y)-(x+z,y+z),rgb(200-z,200-z,200-z),b
next z
line(x,y)-(x+40,y+40),rgb(100,100,100),b
next x
next y
end sub
|
so, habs mal editiert...was mich nun echt wundert: Das "leeren" des Tastaturpuffers haut nicht so ganz hin (Zeile 226...also im unteren Bereich)! Eigentlich sollte das Programm dort warten bis keine Taste gedrückt wird. Bleibt mal auf einer Pfeiltaste drauf - funzt net!
Zuletzt bearbeitet von mkfezzo am 05.05.2008, 17:34, insgesamt einmal bearbeitet |
|
| Nach oben |
|
 |
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 02.05.2008, 16:32 Titel: |
|
|
ganz nett, nur...
- man kommt nicht aus dem programm per ESC oder den Schließen-Button raus... scancode von esc ist CHR(27), schließen-button ist CHR(255, 107).
- pfeiltasten? CHR(255, 72) = oben, CHR(255, 75) = links, CHR(255, 77) = rechts, CHR(255, 80) = unten.
- leere den tastaturpuffer, nach einem vollendeten level. wenn man zu lang auf einer taste bleibt, wird diese dann nämlich noch im nächten level erkannt:
| Code: |
DO
LOOP UNTIL INKEY = ""
|
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
 |
|
| Nach oben |
|
|
mkfezzo
Anmeldungsdatum: 16.08.2007
Beiträge: 25
|
| Verfasst am: 02.05.2008, 16:39 Titel: |
|
|
Stimmt vollkommen! Ich mache das ganze zuhause noch mal in "schön"...und richtig: die chr-Codes fehlten mir!
Ansonsten ist gleich endlich WE!  |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
|
| Nach oben |
|
|
Bauchredner
Anmeldungsdatum: 11.01.2008
Beiträge: 57
|
| Verfasst am: 28.05.2008, 11:11 Titel: |
|
|
Sollte man beim Multikeycode nicht noch #include "fbgfx.bi" hinschreiben?
_________________
Zu meiner Homepage |
|
| Nach oben |
|
|
Jojo
alter Rang
Anmeldungsdatum: 12.02.2005
Beiträge: 9736
Wohnort: Neben der Festplatte
|
| Verfasst am: 28.05.2008, 15:41 Titel: |
|
|
probier's doch auch. brauchst du nicht. das brauchst du nur, wenn du unbedingt die konstanten benutzen willst. Konstanten sind aber lame 
_________________
» Die Mathematik wurde geschaffen, um Probleme zu lösen, die es nicht gäbe, wenn die Mathematik nicht erschaffen worden wäre.
|
|
| 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
