 |
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 |
Manu
Anmeldungsdatum: 16.07.2006
Beiträge: 174
Wohnort: Bayern
|
 Verfasst am: 06.10.2006, 17:12 Titel: Verbesserungsvorschläge am Quelltext - Danke |
 |
|
Ich hab jetzt TIC TAC TOE fertig programmiert, doch leider gibt es kleinere Fehler wenn man in ein Feld klickt kommt abundzu Kreis aber auch ab und zu X. Normalerweise sollte es halt immer abwechselnd sein.
Könnt ihr vll. bei euch mal nachschauen. Danke
mfg Manu
hier der code:
| Code: |
CLS
CALL xscreen(&H101)
CALL set.picture(100, 100, "feld.BMP")
CALL xmouse("ON", 0, 0, 0)
start:
DO
CALL xmouse("CTRL", t%, x%, y%)
LOOP UNTIL t% = 1
IF x% >= 130 AND x% <= 235 AND y% >= 130 AND y% <= 221 THEN 'linksoben
CALL set.picture(150, 145, "kreis.BMP")
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 131 AND y% <= 222 THEN 'mitteoben
CALL set.picture(270, 145, "kreis.BMP")
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 131 AND y% <= 222 THEN ' rechtsoben
CALL set.picture(390, 145, "kreis.BMP")
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 222 AND y% <= 314 THEN 'mittelinks
CALL set.picture(150, 235, "kreis.BMP")
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 222 AND y% <= 314 THEN 'mittemitte
CALL set.picture(268, 235, "kreis.BMP")
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 222 AND y% <= 314 THEN 'rechtsmitte
CALL set.picture(390, 235, "kreis.BMP")
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 314 AND y% <= 432 THEN 'linksunten
CALL set.picture(150, 346, "kreis.BMP")
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 314 AND y% <= 432 THEN 'mitteunten
CALL set.picture(268, 346, "kreis.BMP")
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 314 AND y% <= 432 THEN 'rechtsunten
CALL set.picture(390, 346, "kreis.BMP")
END IF
'Spieler 2
DO
CALL xmouse("CTRL", t%, x%, y%)
LOOP UNTIL t% = 1
IF x% >= 130 AND x% <= 235 AND y% >= 130 AND y% <= 221 THEN 'linksoben
CALL set.picture(150, 145, "kreis2.BMP")
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 131 AND y% <= 222 THEN 'mitteoben
CALL set.picture(270, 145, "kreis2.BMP")
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 131 AND y% <= 222 THEN ' rechtsoben
CALL set.picture(390, 145, "kreis2.BMP")
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 222 AND y% <= 314 THEN 'mittelinks
CALL set.picture(150, 235, "kreis2.BMP")
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 222 AND y% <= 314 THEN 'mittemitte
CALL set.picture(268, 235, "kreis2.BMP")
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 222 AND y% <= 314 THEN 'rechtsmitte
CALL set.picture(390, 235, "kreis2.BMP")
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 314 AND y% <= 432 THEN 'linksunten
CALL set.picture(150, 346, "kreis2.BMP")
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 314 AND y% <= 432 THEN 'mitteunten
CALL set.picture(268, 346, "kreis2.BMP")
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 314 AND y% <= 432 THEN 'rechtsunten
CALL set.picture(390, 346, "kreis2.BMP")
END IF
'PRINT t%
'PRINT x%
'PRINT y%
GOTO start:
SLEEP
end
|
hier die .exe
http://www.file-upload.net/download_06.10.06_cza4db.zip.html
Achtung!!!!!!!!
das Programm lässt sich nicht von selber beenden, es muss über rechtsklick schließen oder über den Taskmanager beendet werden. |
|
| Nach oben |
|
 |
Michael712
aka anfänger, programmierer
Anmeldungsdatum: 26.03.2005
Beiträge: 1593
|
| Verfasst am: 06.10.2006, 17:29 Titel: Re: Verbesserungsvorschläge am Quelltext - Danke |
|
|
Sollte klappen:
| Code: | CLS
CALL xscreen(&H101)
CALL set.picture(100, 100, "feld.BMP")
CALL xmouse("ON", 0, 0, 0)
spieler%=0
Do 'hauptschleife
If spieler%<>1 Then spieler%=1 Elseif spieler%=1 Then spieler%=0
DO
CALL xmouse("CTRL", t%, x%, y%)
If t%=2 Then End
LOOP UNTIL t% = 1
If spieler%=1 Then bild="kreis.BMP" else bild$="kreis2.BMP"
IF x% >= 130 AND x% <= 235 AND y% >= 130 AND y% <= 221 THEN 'linksoben
CALL set.picture(150, 145, bild$)
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 131 AND y% <= 222 THEN 'mitteoben
CALL set.picture(270, 145, bild$)
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 131 AND y% <= 222 THEN ' rechtsoben
CALL set.picture(390, 145, bild$)
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 222 AND y% <= 314 THEN 'mittelinks
CALL set.picture(150, 235, bild$)
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 222 AND y% <= 314 THEN 'mittemitte
CALL set.picture(268, 235, bild$)
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 222 AND y% <= 314 THEN 'rechtsmitte
CALL set.picture(390, 235, bild$)
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 314 AND y% <= 432 THEN 'linksunten
CALL set.picture(150, 346, bild$)
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 314 AND y% <= 432 THEN 'mitteunten
CALL set.picture(268, 346, bild$)
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 314 AND y% <= 432 THEN 'rechtsunten
CALL set.picture(390, 346, bild$)
END IF
DO
CALL xmouse("CTRL", t%, x%, y%)
If t%=2 Then End
LOOP UNTIL t% = 0 'so lange laufen bis die maustaste nicht mehr gedrückt ist
Loop
SLEEP
end
|
_________________
| Code: | | #include "signatur.bi" |
|
|
| Nach oben |
|
|
SpionAtom
Anmeldungsdatum: 10.01.2005
Beiträge: 395
|
| Verfasst am: 06.10.2006, 18:25 Titel: |
|
|
Hab auch mal sowas gemacht, allerdings ohne Lib...
| Code: | DECLARE SUB Kreis (x%, y%)
DECLARE SUB Ixx (x%, y%)
1 CLS : SCREEN 13 'von Thomas Decker (10.3.2001)
LOCATE 2, 13: PRINT "TIC - TAC - TOE"
LINE (0, 0)-(319, 24), 15, B
LINE (0, 26)-(319, 199), 15, B
DIM Feldi%(1 TO 3, 1 TO 3)
MalFeld$ = "BM160,100 BM-27,-27 U25E5R5F5D25R25U25E5R5F5D25 R25F5D5G5L25D25R25F5D5G5L25 D25G5L5H5U25L25D25G5L5H5U25 L25H5U5E5R25U25L25H5U5E5R25 BM+15,15 R25D25L25U25"
FG% = 39: s% = 18
FOR i% = 0 TO 360 STEP 20
Winkel$ = "TA" + LTRIM$(STR$(i%))
DRAW "C15" + Winkel$ + MalFeld$
SZ! = TIMER: DO WHILE SZ! + .001 > TIMER: LOOP
DRAW "C0" + Winkel$ + MalFeld$
NEXT i%
DRAW "C15" + Winkel$ + MalFeld$
LOCATE 22, 2: PRINT "Dr?cken Sie [ENTER] um fortzufahren"
DO: a$ = INKEY$
IF a$ = CHR$(13) THEN EXIT DO
IF a$ = CHR$(27) THEN PRINT "Ende...": END
LOOP
LOCATE 22, 2: PRINT "Spielen Sie nun dieses tolle Spiel!"
DRAW "C15" + Winkel$ + MalFeld$ + "BM-5,-5 P9,15"
COLOR 4: LOCATE 5, 2: PRINT "Spieler 1"
COLOR 1: LOCATE 5, 30: PRINT "Spieler 2"
Kreis 40, 50
Ixx 270, 50
dran1% = 1
dran2% = 2
P1% = 1
P2% = 1
zuege% = 0
DO
dran% = dran1%
IF dran1% = 1 THEN COLOR 7: LOCATE 10, 2: PRINT "ist am Zug": COLOR 0: LOCATE 10, 30: PRINT "ist am Zug"
IF dran2% = 1 THEN COLOR 7: LOCATE 10, 30: PRINT "ist am Zug": COLOR 0: LOCATE 10, 2: PRINT "ist am Zug"
DO: a$ = INKEY$
IF a$ <> "" THEN
LINE (102 + P1% * FG% - FG% + 10, 42 + P2% * FG% - FG% + 10)-(102 + P1% * FG% - 10, 42 + P2% * FG% - 10), 0, BF
IF Feldi%(P1%, P2%) = 1 THEN Kreis 102 + P1% * FG% - FG% + s%, 42 + P2% * FG% - FG% + s%
IF Feldi%(P1%, P2%) = 2 THEN Ixx 102 + P1% * FG% - FG% + s%, 42 + P2% * FG% - FG% + s%
END IF
SELECT CASE a$
CASE CHR$(0) + "H": P2% = P2% - 1: IF P2% < 1 THEN P2% = 1
CASE CHR$(0) + "P": P2% = P2% + 1: IF P2% > 3 THEN P2% = 3
CASE CHR$(0) + "K": P1% = P1% - 1: IF P1% < 1 THEN P1% = 1
CASE CHR$(0) + "M": P1% = P1% + 1: IF P1% > 3 THEN P1% = 3
CASE CHR$(13)
IF Feldi%(P1%, P2%) = 0 THEN
IF dran% = 1 THEN Feldi%(P1%, P2%) = 1
IF dran% = 2 THEN Feldi%(P1%, P2%) = 2
IF Feldi%(P1%, P2%) = 1 THEN Kreis 102 + P1% * FG% - FG% + s%, 42 + P2% * FG% - FG% + s%
IF Feldi%(P1%, P2%) = 2 THEN Ixx 102 + P1% * FG% - FG% + s%, 42 + P2% * FG% - FG% + s%
zuege% = zuege% + 1
EXIT DO
ELSE
PLAY "O1L64CDEF"
END IF
CASE CHR$(27): PRINT "Ende...": END
CASE ELSE
END SELECT
LINE (102 + P1% * FG% - FG% + 10, 42 + P2% * FG% - FG% + 10)-(102 + P1% * FG% - 10, 42 + P2% * FG% - 10), 2, B
LOOP
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'KONTROLLE
drei% = 0
DIM F%(1 TO 3, 1 TO 3)
FOR i% = 1 TO 3: FOR j% = 1 TO 3: F%(i%, j%) = Feldi%(i%, j%): NEXT j%: NEXT i%
IF F%(1, 1) = F%(1, 2) AND F%(1, 2) = F%(1, 3) THEN drei% = F%(1, 1)
IF F%(2, 1) = F%(2, 2) AND F%(2, 2) = F%(2, 3) THEN drei% = F%(2, 1)
IF F%(3, 1) = F%(3, 2) AND F%(3, 2) = F%(3, 3) THEN drei% = F%(3, 1)
IF F%(1, 1) = F%(2, 1) AND F%(2, 1) = F%(3, 1) THEN drei% = F%(1, 1)
IF F%(1, 2) = F%(2, 2) AND F%(2, 2) = F%(3, 2) THEN drei% = F%(1, 2)
IF F%(1, 3) = F%(2, 3) AND F%(2, 3) = F%(3, 3) THEN drei% = F%(1, 3)
IF F%(1, 1) = F%(2, 2) AND F%(2, 2) = F%(3, 3) THEN drei% = F%(1, 1)
IF F%(1, 3) = F%(2, 2) AND F%(2, 2) = F%(3, 1) THEN drei% = F%(1, 3)
IF drei% > 0 THEN
ERASE Feldi%, F%
COLOR 14
LOCATE 10, 15: PRINT "S P I E L E R "
LOCATE 11, 20: PRINT drei%
LOCATE 12, 15: PRINT "G e w i n n t"
COLOR 7
LOCATE 23, 1: PRINT "Enter f?r Nochmal, sonst Esc"
DO: a$ = INKEY$
IF a$ = CHR$(13) THEN GOTO 1
IF a$ = CHR$(27) THEN END
LOOP
END IF
IF zuege% = 9 THEN
ERASE Feldi%, F%
COLOR 14
LOCATE 10, 15: PRINT " K E I N E R "
LOCATE 11, 20: PRINT ""
LOCATE 12, 15: PRINT "G e w i n n t"
ERASE Feldi%, F%
COLOR 7
LOCATE 23, 1: PRINT "Enter f?r Nochmal, sonst Esc"
DO: a$ = INKEY$
IF a$ = CHR$(13) THEN GOTO 1
IF a$ = CHR$(27) THEN END
LOOP
END IF
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
SWAP dran1%, dran2%
LOOP
SLEEP
SUB Ixx (x%, y%)
MalX$ = "E5F5G5F5G5H5G5H5E5H5E5F5 BD2 P1,15"
PSET (x%, y% - 5), 15
DRAW MalX$
END SUB
SUB Kreis (x%, y%)
CIRCLE (x%, y%), 12, 15: PAINT STEP(0, 0), 4, 15
CIRCLE (x%, y%), 6, 15: PAINT STEP(0, 0), 0, 15
END SUB |
_________________
Inzwischen gehöre ich auch zu den BlitzBasicern. Also verzeiht mir, wenn mir mal ein LOCATE 100, 100 oder dergleichen rausrutscht. |
|
| Nach oben |
|
|
Manu
Anmeldungsdatum: 16.07.2006
Beiträge: 174
Wohnort: Bayern
|
| Verfasst am: 07.10.2006, 10:45 Titel: Re: Verbesserungsvorschläge am Quelltext - Danke |
|
|
| programmierer hat Folgendes geschrieben: | Sollte klappen:
| Code: | CLS
CALL xscreen(&H101)
CALL set.picture(100, 100, "feld.BMP")
CALL xmouse("ON", 0, 0, 0)
spieler%=0
Do 'hauptschleife
If spieler%<>1 Then spieler%=1 Elseif spieler%=1 Then spieler%=0
DO
CALL xmouse("CTRL", t%, x%, y%)
If t%=2 Then End
LOOP UNTIL t% = 1
If spieler%=1 Then bild="kreis.BMP" else bild$="kreis2.BMP"
IF x% >= 130 AND x% <= 235 AND y% >= 130 AND y% <= 221 THEN 'linksoben
CALL set.picture(150, 145, bild$)
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 131 AND y% <= 222 THEN 'mitteoben
CALL set.picture(270, 145, bild$)
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 131 AND y% <= 222 THEN ' rechtsoben
CALL set.picture(390, 145, bild$)
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 222 AND y% <= 314 THEN 'mittelinks
CALL set.picture(150, 235, bild$)
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 222 AND y% <= 314 THEN 'mittemitte
CALL set.picture(268, 235, bild$)
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 222 AND y% <= 314 THEN 'rechtsmitte
CALL set.picture(390, 235, bild$)
END IF
IF x% >= 130 AND x% <= 235 AND y% >= 314 AND y% <= 432 THEN 'linksunten
CALL set.picture(150, 346, bild$)
END IF
IF x% >= 236 AND x% <= 364 AND y% >= 314 AND y% <= 432 THEN 'mitteunten
CALL set.picture(268, 346, bild$)
END IF
IF x% >= 364 AND x% <= 494 AND y% >= 314 AND y% <= 432 THEN 'rechtsunten
CALL set.picture(390, 346, bild$)
END IF
DO
CALL xmouse("CTRL", t%, x%, y%)
If t%=2 Then End
LOOP UNTIL t% = 0 'so lange laufen bis die maustaste nicht mehr gedrückt ist
Loop
SLEEP
end
|
|
danke programmierer
aber immer wenn ich auf ein feld drücke kommt immer kreis2.BMP
kannst du mir da vielleicht helfen
danke
mfg Manu |
|
| Nach oben |
|
|
Manu
Anmeldungsdatum: 16.07.2006
Beiträge: 174
Wohnort: Bayern
|
| Verfasst am: 07.10.2006, 10:54 Titel: |
|
|
@spion atom
super prog
bloß wie hast du die schirft so groß gemacht?
danke
mfg Manu |
|
| Nach oben |
|
|
Michael712
aka anfänger, programmierer
Anmeldungsdatum: 26.03.2005
Beiträge: 1593
|
| Verfasst am: 07.10.2006, 11:49 Titel: |
|
|
Guck mal hier!
Sollte gehen 
_________________
| Code: | | #include "signatur.bi" |
|
|
| Nach oben |
|
|
Skilltronic
Anmeldungsdatum: 10.09.2004
Beiträge: 1148
Wohnort: Köln
|
| Verfasst am: 07.10.2006, 12:57 Titel: |
|
|
Hallo
| Manu hat Folgendes geschrieben: | | bloß wie hast du die schirft so groß gemacht? |
Er arbeitet mit SCREEN 13. Die hat nur 320x200 Pixel, da wird die Schrift automatisch so gross.
Gruss
Skilltronic
_________________
Elektronik und QB? www.skilltronics.de ! |
|
| Nach oben |
|
|
Manu
Anmeldungsdatum: 16.07.2006
Beiträge: 174
Wohnort: Bayern
|
| Verfasst am: 07.10.2006, 20:23 Titel: |
|
|
danke für alle antworten
jetzt funktioniert mein programm
ein spezielles dankeschön an programmieren
mfg Manu |
|
| 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
