Tälläinen pelinalku. Hyödyntää QB64:n mainioita hiiritoimintoja ja _display-komentoa. Palikoiden siirtely vaatii KOKO ruudun piirtämistä uusiksi jokaisella hiirenliikkeellä, siksi pyörii tahmaisesti mopommilla koneilla.
' ' Block Puzzle v.0.2 by Tertsi 2019 ' RANDOMIZE TIMER SCREEN _NEWIMAGE(720, 720, 256) _TITLE "Block Puzzle v.0.2" DIM BS$(5, 3), Alue$(16), Tsekki$(8) DIM ScoreNappi(1200), ResetNappi(1200) rootpath$ = ENVIRON$("SYSTEMROOT") 'ladataan fontit fontfile$ = rootpath$ + "\Fonts\arial.ttf" f& = _LOADFONT(fontfile$, 24): _FONT f& _PRINTMODE _KEEPBACKGROUND IF _FILEEXISTS("Block Puzzle.top") THEN 'luetaan highscore tiedostosta OPEN "Block Puzzle.top" FOR INPUT AS #1 INPUT #1, highscore CLOSE #1 ELSE highscore = 0 OPEN "Block Puzzle.top" FOR OUTPUT AS #1 'luodaan uusi tiedosto jos eka pelikerta PRINT #1, highscore CLOSE #1 END IF FOR x = 30 TO 100: CIRCLE (x, 30), 20, 9: NEXT x GET (10, 10)-(120, 50), ScoreNappi() COLOR 0: _PRINTSTRING (25, 20), "RESET" GET (10, 10)-(120, 50), ResetNappi() Resetointi: pojot = 0 Buuttaa$ = "JEP" FOR y = 1 TO 16 IF y < 9 THEN Alue$(y) = SPACE$(8) + "XXXXXXXX" IF y > 8 THEN Alue$(y) = "XXXXXXXXXXXXXXXX" NEXT y Pala$(1) = "OFF": Pala$(2) = "OFF": Pala$(3) = "OFF" GOSUB Tausta Alku: FOR z = 1 TO 3 v = INT(RND * 5) + 1 SELECT CASE v CASE 1 BS$(1, z) = " " BS$(2, z) = " +### " BS$(3, z) = " # " BS$(4, z) = " # " BS$(5, z) = " # " CASE 2 BS$(1, z) = " " BS$(2, z) = " +## " BS$(3, z) = " ### " BS$(4, z) = " ### " BS$(5, z) = " " CASE 3 BS$(1, z) = " # " BS$(2, z) = " + " BS$(3, z) = " # " BS$(4, z) = " # " BS$(5, z) = " # " CASE 4 BS$(1, z) = " " BS$(2, z) = " +## " BS$(3, z) = " " BS$(4, z) = " " BS$(5, z) = " " CASE 5 BS$(1, z) = " " BS$(2, z) = " + " BS$(3, z) = " " BS$(4, z) = " " BS$(5, z) = " " END SELECT mx(z) = z * 220 - 140: my(z) = 500 Pala$(z) = "DOWN" NEXT z xk = -100: yk = -100 FOR g = 1 TO 3 GOSUB Palikka _DISPLAY _DELAY .1 NEXT g GOSUB Tausta DO DO WHILE _MOUSEINPUT hiirix = _MOUSEX hiiriy = _MOUSEY rx = FIX(hiirix / 40) - 4 ry = FIX(hiiriy / 40) - 1 IF _MOUSEBUTTON(1) THEN IF hiirix >= 600 AND hiirix <= 710 AND hiiriy <= 50 AND hiiriy >= 10 THEN IF POINT(hiirix, hiiriy) = 0 OR POINT(hiirix, hiiriy) = 9 THEN Buuttaa$ = "JOO" END IF IF POINT(hiirix, hiiriy) > 0 AND POINT(hiirix, hiiriy) < 4 THEN z = POINT(hiirix, hiiriy) Pala$(z) = "PICK" END IF IF Pala$(z) = "PICK" THEN mx(z) = hiirix: my(z) = hiiriy GOSUB Tausta END IF END IF IF Buuttaa$ = "JOO" AND _MOUSEBUTTON(1) = 0 THEN GOTO Resetointi IF Pala$(z) = "PICK" AND _MOUSEBUTTON(1) = 0 THEN Pala$(z) = "DOWN" IF rx > 0 AND rx < 9 AND ry > 0 AND ry < 9 THEN pala = 0: ruutu = 0 FOR y = 1 TO 5 FOR x = 1 TO 6 IF MID$(BS$(y, z), x, 1) <> " " THEN pala = pala + 1 IF MID$(Alue$(y - 2 + ry), x - 2 + rx, 1) = " " THEN ruutu = ruutu + 1 END IF END IF NEXT x NEXT y IF pala > 0 AND pala = ruutu THEN FOR y = 1 TO 5 FOR x = 1 TO 6 IF MID$(BS$(y, z), x, 1) <> " " THEN MID$(Alue$(y - 2 + ry), x - 2 + rx, 1) = "5" END IF NEXT x NEXT y Pala$(z) = "OFF" GOSUB Tausta GOSUB Tarkistus IF Pala$(1) = "OFF" AND Pala$(2) = "OFF" AND Pala$(3) = "OFF" THEN GOTO Alku END IF END IF END IF LOOP LOOP Tausta: CLS IF Buuttaa$ = "JEP" THEN PUT (600, 10), ResetNappi(), PRESET FOR y = 1 TO 8 FOR x = 1 TO 8 IF MID$(Alue$(y), x, 1) = "5" THEN LINE (160 + x * 40, 40 + y * 40)-(200 + x * 40, 80 + y * 40), 9, BF ELSE LINE (160 + x * 40, 40 + y * 40)-(200 + x * 40, 80 + y * 40), 0, BF END IF LINE (160 + x * 40, 40 + y * 40)-(200 + x * 40, 80 + y * 40), 8, B NEXT x NEXT y IF Buuttaa$ <> "JEP" THEN PUT (600, 10), ResetNappi(), PSET Buuttaa$ = "EI" GOSUB Pisteet FOR g = 1 TO 3 GOSUB Palikka NEXT g _DISPLAY RETURN Palikka: IF Pala$(g) <> "OFF" THEN FOR y = 1 TO 5 FOR x = 1 TO 6 IF MID$(BS$(y, g), x, 1) <> " " THEN LINE (x * 40 + mx(g) + xk, y * 40 + my(g) + yk)-(x * 40 + mx(g) + 40 + xk, y * 40 + my(g) + 40 + yk), g, BF LINE (x * 40 + mx(g) + xk, y * 40 + my(g) + yk)-(x * 40 + mx(g) + 40 + xk, y * 40 + my(g) + 40 + yk), 15, B IF MID$(BS$(y, g), x, 1) = "+" THEN LINE (x * 40 + mx(g) + xk + 10, y * 40 + my(g) + 20 + yk)-(x * 40 + mx(g) + 30 + xk, y * 40 + my(g) + 20 + yk), 15 LINE (x * 40 + mx(g) + xk + 20, y * 40 + my(g) + yk + 10)-(x * 40 + mx(g) + 20 + xk, y * 40 + my(g) + 30 + yk), 15 END IF END IF NEXT x NEXT y END IF RETURN Pisteet: PUT (10, 10), ScoreNappi(), PSET plev = FIX(_PRINTWIDTH(STR$(pojot)) / 2) _PRINTSTRING (60 - plev, 20), STR$(pojot) IF pojot > highscore THEN OPEN "Block Puzzle.top" FOR OUTPUT AS #1 highscore = pojot PRINT #1, highscore CLOSE #1 END IF PUT (10, 60), ScoreNappi(), PSET hlev = FIX(_PRINTWIDTH(STR$(highscore)) / 2) _PRINTSTRING (60 - hlev, 70), STR$(highscore) RETURN Tarkistus: rivit = 0 FOR y = 1 TO 8 Tsekki$(y) = SPACE$(8) IF LEFT$(Alue$(y), 8) = "55555555" THEN Tsekki$(y) = "555555555": rivit = rivit + 1 NEXT y FOR x = 1 TO 8 vitoset = 0 FOR y = 1 TO 8 IF MID$(Alue$(y), x, 1) = "5" THEN vitoset = vitoset + 1 NEXT y IF vitoset = 8 THEN FOR y = 1 TO 8 MID$(Tsekki$(y), x, 1) = "5" NEXT y rivit = rivit + 1 END IF NEXT x IF rivit > 0 THEN FOR y = 1 TO 8 FOR x = 1 TO 8 IF MID$(Tsekki$(y), x, 1) = "5" THEN MID$(Alue$(y), x, 1) = " " LINE (160 + x * 40, 40 + y * 40)-(200 + x * 40, 80 + y * 40), 15, BF LINE (160 + x * 40, 40 + y * 40)-(200 + x * 40, 80 + y * 40), 8, B END IF NEXT x NEXT y _DISPLAY _DELAY .2 FOR y = 1 TO 8 FOR x = 1 TO 8 IF MID$(Tsekki$(y), x, 1) = "5" THEN LINE (160 + x * 40, 40 + y * 40)-(200 + x * 40, 80 + y * 40), 0, BF LINE (160 + x * 40, 40 + y * 40)-(200 + x * 40, 80 + y * 40), 8, B END IF NEXT x NEXT y pojot = pojot + rivit GOSUB Pisteet _DISPLAY _DELAY .2 END IF RETURN
Aihe on jo aika vanha, joten et voi enää vastata siihen.