QB64 Project Site

Unseen Machine's QB64 Project Site

These are my completed (or near completed) programs and demonstration code. Feel free to try, use or assimilate.

TO RUN - COPY THE CODE INTO QB64 and press F5

Program list..

QB Paint v.01 

Simon v.01

System Information viewer v.01

Tic-Tac-Toe

Shoot the light

Pure Mp3

QB Paint v.01

I wrote this just for fun, nothing major, just color, brush sizes and a spray can. I am going to do a  .02 version soon which should have a few more oprtions.

 

DIM SHARED lmclr AS INTEGER, rmclr AS INTEGER
DIM SHARED btype AS INTEGER, bsize AS INTEGER

_TITLE "QB Paint v.01"

a& = _NEWIMAGE(900, 600, 12)
SCREEN a&
RANDOMIZE TIMER

'main
btype = 1 '1 = brush 2 = spray 3 = erase
bsize = 1
lmclr = 1

CLS

CALL mainscreen
CALL bmanage

DO

        CALL mouseevents


LOOP UNTIL INKEY$ = CHR$(27)




'subs

SUB mainscreen

textsmall& = _LOADFONT("C:\windows\fonts\comic.ttf", 20)
_FONT textsmall&

PAINT (1, 1), 15

LINE (0, 0)-(120, 599), 7, BF
LINE (0, 549)-(899, 599), 7, BF

bx = 135: by = 560

FOR i = 1 TO 16

        PSET (bx, by), 8: DRAW "l15d30r30u30l15"
        PAINT STEP(0, 2), i, 8
        bx = bx + 35


NEXT

LINE (19, 19)-(99, 40), 4, B
PAINT (20, 20), 16, 4
LINE (19, 60)-(99, 81), 4, B
PAINT (20, 61), 16, 4
LINE (19, 99)-(99, 120), 4, B
PAINT (20, 100), 16, 4

LOCATE 2, 40: PRINT "Brush"
LOCATE 4, 40: PRINT "Spray"
LOCATE 6, 40: PRINT "Erase"

LINE (19, 130)-(99, 250), 4, B
PAINT (20, 131), 15, 4

LINE (19, 279)-(99, 300), 4, B
PAINT (20, 280), 16, 4
LOCATE 15, 48: PRINT "New"

LINE (19, 550)-(99, 590), lmclr, B
PAINT (56, 560), lmclr, lmclr

END SUB


SUB mouseevents

DO WHILE _MOUSEINPUT

        mx = _MOUSEX
        my = _MOUSEY

        LOCATE 25, 29: PRINT mx; my

        IF _MOUSEBUTTON(1) THEN

                'colour selection
                cxmin = 116: cymin = 560
                IF my >= 560 AND my <= 590 THEN

                        clr = 0

                        DO

                                clr = clr + 1
                                IF mx >= cxmin AND mx <= cxmin + 35 THEN EXIT DO
                                cxmin = cxmin + 35

                        LOOP UNTIL clr = 17

                        IF clr < 17 THEN lmclr = clr

                        LINE (19, 550)-(99, 590), lmclr, B
                        PAINT (56, 560), lmclr, lmclr

                END IF


                'Painting area
                IF mx >= 120 AND mx <= 899 AND my < 549 THEN

                        PSET (mx, my), lmclr

                        IF btype = 1 THEN

                                IF bsize = 1 THEN

                                        LINE (mx - 1, my - 1)-(mx + 1, my + 1), lmclr, BF

                                ELSEIF bsize = 2 AND mx - 4 >= 120 AND my + 4 <= 549 THEN

                                        LINE (mx - 4, my - 4)-(mx + 4, my + 4), lmclr, BF

                                ELSEIF bsize = 3 AND mx - 8 >= 120 AND my + 8 <= 549 THEN

                                        LINE (mx - 8, my - 8)-(mx + 8, my + 8), lmclr, BF

                                END IF

                        ELSEIF btype = 2 THEN

                                IF bsize = 1 THEN

                                        FOR i = 1 TO 50

                                                PSET (mx + INT(RND * 10) + -5, my + INT(RND * 10) + -5), lmclr

                                        NEXT i


                                ELSEIF bsize = 2 THEN

                                        FOR i = 1 TO 150

                                                PSET (mx + INT(RND * 20) + -10, my + INT(RND * 20) + -10), lmclr

                                        NEXT i

                                ELSEIF bsize = 3 THEN

                                        FOR i = 1 TO 250

                                                PSET (mx + INT(RND * 30) + -15, my + INT(RND * 30) + -15), lmclr

                                        NEXT i

                                END IF

                        ELSEIF btype = 3 THEN

                                CIRCLE (mx, my), 8, 8
                                PAINT STEP(0, 0), 15, 8
                                CIRCLE STEP(0, 0), 8, 15

                        END IF

                END IF

                'Brush type
                IF mx >= 19 AND mx <= 99 THEN

                        IF my >= 19 AND my <= 40 THEN

                                btype = 1
                                CALL bmanage

                        ELSEIF my >= 60 AND my <= 81 THEN

                                btype = 2
                                CALL bmanage

                        ELSEIF my >= 99 AND my <= 120 THEN

                                btype = 3
                                CALL bmanage

                        END IF

                END IF

                'brush size
                IF my >= 130 AND my <= 250 THEN

                        csmin = 130
                        IF mx >= 19 AND mx <= 99 THEN
                                size = 0

                                DO

                                        size = size + 1
                                        IF my >= csmin AND my <= csmin + 38 THEN EXIT DO
                                        csmin = csmin + 40

                                LOOP UNTIL size = 4

                                IF size < 4 THEN bsize = size

                        END IF

                END IF

                'new image
                IF mx >= 19 AND mx <= 99 AND my >= 279 AND my <= 300 THEN RUN

        END IF

LOOP

END SUB

SUB bmanage

DIM brx AS INTEGER, bry AS INTEGER

obrx = 60
obry = 160


IF btype = 1 THEN

        PAINT (20, 131), 15, 4

        PSET (59, 150), 16: DRAW "l1u2r2d2l1"
        PAINT STEP(0, -1), 16, 16
        PSET STEP(0, 40), 16: DRAW "l4u8r8d8l4"
        PAINT STEP(0, -1), 16, 16
        PSET STEP(0, 40), 16: DRAW "l8u16r16d16l8"
        PAINT STEP(0, -1), 16, 16

ELSEIF btype = 2 THEN

        PAINT (20, 131), 15, 4

        FOR i = 1 TO 50

                brx = obrx + INT(RND * 10) + -5
                bry = obry + INT(RND * 10) + -5

                PSET (brx, bry), 16

        NEXT i

        obry = 190

        FOR i = 1 TO 150

                brx = obrx + INT(RND * 20) + -10
                bry = obry + INT(RND * 20) + -10

                PSET (brx, bry), 16

        NEXT i

        obry = 220

        FOR i = 1 TO 200

                brx = obrx + INT(RND * 30) + -15
                bry = obry + INT(RND * 30) + -15

                PSET (brx, bry), 16

        NEXT i

END IF


END SUB

Simon v.01

_TITLE "Simple Simon"
DECLARE SUB lose ()
DECLARE SUB compare ()
DECLARE SUB shortimer ()
DECLARE SUB userinput ()
DECLARE SUB randomlights ()
DECLARE SUB ssstartscreen ()

RANDOMIZE TIMER

DIM SHARED lvl AS INTEGER, score AS INTEGER, lives AS INTEGER
lives = 10: lvl = 1

DO

        CALL ssstartscreen

        SLEEP 2

        REDIM SHARED lightrnd(1 TO 40) AS INTEGER

        CALL randomlights

        CALL shortimer

        REDIM SHARED lightusr(1 TO 40) AS INTEGER

        CALL userinput

        SLEEP 1

        CALL compare


LOOP UNTIL lvl = 35

SUB compare
DIM cnt AS INTEGER

DIM results(1 TO 40) AS INTEGER
DIM errorcnt AS INTEGER

DO
        cnt = cnt + 1

        IF lightrnd(cnt) = lightusr(cnt) THEN

                results(cnt) = 1

        ELSE
                IF lives > 1 THEN

                        results(cnt) = 0
                        lives = lives - 1
                        errorcnt = errorcnt + 1

                ELSEIF lives = 1 THEN

                        CALL lose

                END IF

        END IF

LOOP UNTIL cnt = lvl + 4

IF errorcnt = 0 THEN lvl = lvl + 1


IF errorcnt = 0 THEN

        msg$ = "Well done. You were PERFECT!!"

ELSEIF errorcnt = 1 THEN

        msg$ = "Close, but you got one wrong."

ELSEIF errorcnt = 2 THEN

        msg$ = "Not good, you got two wrong."

ELSEIF errorcnt > 2 THEN

        msg$ = "TERRIBLE - You got " + STR$(errorcnt) + " wrong."

END IF

LINE (120, 100)-(520, 250), 15, BF
LINE (122, 102)-(518, 248), 0, BF

LOCATE 10, 40 - (LEN(msg$) / 2): PRINT msg$
LOCATE 12, 28: PRINT "Press ENTER to continue.."

DO: LOOP UNTIL INKEY$ = CHR$(13)

 


END SUB

SUB lose
CLS
LOCATE 15, 40: PRINT "GAME OVER"
SLEEP 1
SYSTEM
END SUB

SUB randomlights

'set on colors

OUT &H3C8, 5: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 60
OUT &H3C8, 6: OUT &H3C9, 0: OUT &H3C9, 60: OUT &H3C9, 0
OUT &H3C8, 7: OUT &H3C9, 60: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, 8: OUT &H3C9, 50: OUT &H3C9, 50: OUT &H3C9, 0

'set off colors

OUT &H3C8, 1: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 40
OUT &H3C8, 2: OUT &H3C9, 0: OUT &H3C9, 40: OUT &H3C9, 0
OUT &H3C8, 4: OUT &H3C9, 40: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, 14: OUT &H3C9, 35: OUT &H3C9, 35: OUT &H3C9, 0


'generate random lights sequence
DIM cnt AS INTEGER

DO

        cnt = cnt + 1
        lightrnd(cnt) = INT(RND * 4) + 1


        IF lightrnd(cnt) = 1 THEN

                PAINT (320, 120), 6, 15

                CALL shortimer
                PAINT (320, 120), 2, 15
                CALL shortimer

        ELSEIF lightrnd(cnt) = 2 THEN

                PAINT (420, 220), 7, 15

                CALL shortimer
                PAINT (420, 220), 4, 15
                CALL shortimer

        ELSEIF lightrnd(cnt) = 3 THEN

                PAINT (320, 320), 8, 15

                CALL shortimer
                PAINT (320, 320), 14, 15
                CALL shortimer


        ELSEIF lightrnd(cnt) = 4 THEN

                PAINT (220, 220), 5, 15

                CALL shortimer
                PAINT (220, 220), 1, 15
                CALL shortimer

        END IF


LOOP UNTIL cnt = lvl + 4

 


END SUB

SUB shortimer

now! = TIMER

DO

        newnow! = TIMER

LOOP UNTIL newnow! - now! >= .6

END SUB

SUB ssstartscreen

CLS
SCREEN 12

COLOR 2: LOCATE 25, 60: PRINT "Level : "; lvl
LOCATE 26, 60: PRINT "Lives : "; lives

'set off colors

OUT &H3C8, 1: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 40
OUT &H3C8, 2: OUT &H3C9, 0: OUT &H3C9, 40: OUT &H3C9, 0
OUT &H3C8, 4: OUT &H3C9, 40: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, 14: OUT &H3C9, 35: OUT &H3C9, 35: OUT &H3C9, 0

DIM level AS INTEGER
light$ = "bu80 r4 f80 d8 g80 l8 h80 u8 e80 r4 bd80"

PSET (220, 220), 15: DRAW light$
PSET STEP(0, 0), 1
PAINT STEP(0, 5), 1, 15

PSET (320, 120), 15: DRAW light$
PSET STEP(0, 0), 2
PAINT STEP(0, 5), 2, 15

PSET (420, 220), 15: DRAW light$
PSET STEP(0, 0), 4
PAINT STEP(0, 5), 4, 15

PSET (320, 320), 15: DRAW light$
PSET STEP(0, 0), 14
PAINT STEP(0, 5), 14, 15

 
END SUB

SUB userinput

'set on colors

OUT &H3C8, 5: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 60
OUT &H3C8, 6: OUT &H3C9, 0: OUT &H3C9, 60: OUT &H3C9, 0
OUT &H3C8, 7: OUT &H3C9, 60: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, 8: OUT &H3C9, 50: OUT &H3C9, 50: OUT &H3C9, 0

'set off colors

OUT &H3C8, 1: OUT &H3C9, 0: OUT &H3C9, 0: OUT &H3C9, 40
OUT &H3C8, 2: OUT &H3C9, 0: OUT &H3C9, 40: OUT &H3C9, 0
OUT &H3C8, 4: OUT &H3C9, 40: OUT &H3C9, 0: OUT &H3C9, 0
OUT &H3C8, 14: OUT &H3C9, 35: OUT &H3C9, 35: OUT &H3C9, 0

DIM acnt AS INTEGER, kval AS INTEGER

DO
        arrow$ = INKEY$

        SELECT CASE arrow$

                CASE CHR$(0) + CHR$(72)

                        acnt = acnt + 1
                        lightusr(acnt) = 1
                        PAINT (320, 120), 6, 15
                        CALL shortimer
                        PAINT (320, 120), 2, 15
                        CALL shortimer


                CASE CHR$(0) + CHR$(77)

                        acnt = acnt + 1
                        lightusr(acnt) = 2
                        PAINT (420, 220), 7, 15

                        CALL shortimer
                        PAINT (420, 220), 4, 15
                        CALL shortimer

                CASE CHR$(0) + CHR$(80)

                        acnt = acnt + 1
                        lightusr(acnt) = 3
                        PAINT (320, 320), 8, 15

                        CALL shortimer
                        PAINT (320, 320), 14, 15
                        CALL shortimer

                CASE CHR$(0) + CHR$(75)

                        acnt = acnt + 1
                        lightusr(acnt) = 4
                        PAINT (220, 220), 5, 15

                        CALL shortimer
                        PAINT (220, 220), 1, 15
                        CALL shortimer


        END SELECT


LOOP UNTIL acnt = lvl + 4


END SUB

 

System Information Viewer v.01

DECLARE SUB SINF ()
DIM MAINOPT AS INTEGER

LNC% = 0
SCREEN 0
COLOR 12, 15

CLS
CALL SINF

SUB SINF
LNC = 0

OPEN "C:\SINF.BAT" FOR OUTPUT AS #1
PRINT #1, "ECHO OFF"
PRINT #1, "CD\"
PRINT #1, "CLS"
PRINT #1, "CMD /C SYSTEMINFO /FO LIST > C:\SINF.SIF"
CLOSE #1

SHELL "C:\SINF.BAT"

OPEN "C:\SINF.SIF" FOR INPUT AS #1

DO UNTIL EOF(1)

        LNC% = LNC% + 1
        LINE INPUT #1, SYSINF$
        IF LNC% = 37 THEN
                LOCATE 39, 1: INPUT "PRESS ENTER TO CONTINUE....", CONT$
                CLS
                LNC% = 0
        END IF
        PRINT SYSINF$

LOOP

CLOSE #1
END SUB

 

Tic Tac Toe (or in ENGLISH - Noughts and Crosses!!!) v.01

I have not coded draw functions or mouse support into this game yet, use the number pad to choose your grid. You have to fill all spaces to start a new game ( A fatal design issue I have yet to address ).  I coded this a long time ago, and the code is not as good as it could be, but it works!


RANDOMIZE TIMER
SCREEN 12
cross$ = "bl10 h30e10f30 e30f10g30 f30g10h30 g30h10e30 "
CLS
LOCATE 2, 30: PRINT "Noughts & Crosses v.02"
LOCATE 4, 4: INPUT "Enter your name : ", usrname$
usrname$ = UCASE$(usrname$)
CLS
DIM ncnt AS INTEGER, cnt AS INTEGER, rndplayer AS INTEGER, player AS INTEGER
rndplayer = INT(RND * 2) + 1
IF rndplayer = 1 THEN player = 1 ELSE player = 2 '1 = user 2 = cpu
       
DO 'master game loop
        COLOR 15
        LOCATE 2, 30: PRINT "Noughts & Crosses v.02"
        PSET (320, 420): DRAW "l180 u360 r360 d360 l180"
        PAINT (320, 415), 2, 15
        PSET STEP(0, 5): DRAW "bl60u360 br120d360 Bu120br120l360 bu120r360"
        DIM cpulevel AS INTEGER

        REM decide how clever the cpu is
        cpulevel = INT(RND * 3) + 1

        DIM grid(1 TO 9) AS INTEGER
        DIM rndnum AS INTEGER, gridcnt AS INTEGER
        DIM kbval AS INTEGER, playcnt AS INTEGER: playcnt = 0

        REM small grid with numbers for input reference
        cnt = 0: nx = 20: ny = 4: ncnt = 0

        DO
                ncnt = ncnt + 1
                cnt = cnt + 1
                LOCATE nx, ny: PRINT cnt
                ny = ny + 3
                IF ncnt = 3 THEN nx = nx + 1: ny = 4: ncnt = 0
        LOOP UNTIL cnt = 9
        PSET (60, 350): DRAW "l30u46r60d46l30 l10u46r20d46 bu14br20l60bu16r60"

        LOCATE 26, 2: PRINT "Player.."

        REM randomize who goes first

        DO 'user and cpu input loop
                COLOR 15
                IF player = 1 THEN
                        LOCATE 27, 2: PRINT SPACE$(3): LOCATE 27, 2: PRINT usrname$
                ELSE
                        LOCATE 27, 2: PRINT SPACE$(LEN(usrname$) + 1): LOCATE 27, 2: PRINT "CPU"
                END IF

                IF player = 1 THEN 'user input code

                        REM input - only exits when array is empty
                        DO
                                kb$ = INKEY$
                                kbval = VAL(kb$)
                                IF kb$ = CHR$(27) THEN SYSTEM
                        LOOP UNTIL kbval >= 1 AND kbval <= 9

                        IF grid(kbval) = 0 THEN

                                REM based on input draw a circle in the right box
                                REM many thanks to artelius for code

                                x% = (kbval% - 1) MOD 3
                                y% = (kbval% - 1) \ 3

                                CIRCLE (200 + x% * 120, 120 + y% * 120), 50, 4
                                CIRCLE (200 + x% * 120, 120 + y% * 120), 35, 4
                                PAINT STEP(40, 0), 4, 4

                                REM set grid array value and change player
                                grid(kbval) = player
                                player = 2: playcnt = playcnt + 1
                        END IF

                ELSEIF player = 2 THEN 'cpu input code

                        REM need to programme 3 ai settings (randomly selected)

                        rndnum = 0

                        REM enhanced ai feature
                        REM search for availabilty of most commonly used tiles in order

                        IF grid(7) = 0 THEN rndnum = 7
                        IF grid(3) = 0 THEN rndnum = 3
                        IF grid(9) = 0 THEN rndnum = 9
                        IF grid(1) = 0 THEN rndnum = 1

                        IF cpulevel = 3 THEN
                                IF grid(7) = 0 AND grid(3) = 0 THEN
                                        chsrnd% = INT(RND * 2) + 1
                                        IF chrsnd% = 1 THEN rndnum = 7 ELSE rndnum = 3
                                END IF
                                IF grid(9) = 0 AND grid(1) = 0 THEN
                                        chsrnd% = INT(RND * 2) + 1
                                        IF chsrnd% = 1 THEN rndnum = 9 ELSE rndnum = 1
                                END IF
                                mainrnd% = INT(RND * 2) + 1
                                IF mainrnd% = 2 AND grid(5) = 0 THEN rndnum = 5
                        END IF

                        REM check for possible opponent win  24 options

                        IF grid(1) = 1 AND grid(2) = 1 AND grid(3) = 0 THEN rndnum = 3
                        IF grid(2) = 1 AND grid(3) = 1 AND grid(1) = 0 THEN rndnum = 1
                        IF grid(4) = 1 AND grid(5) = 1 AND grid(6) = 0 THEN rndnum = 6
                        IF grid(5) = 1 AND grid(6) = 1 AND grid(4) = 0 THEN rndnum = 4
                        IF grid(7) = 1 AND grid(8) = 1 AND grid(9) = 0 THEN rndnum = 9
                        IF grid(8) = 1 AND grid(9) = 1 AND grid(7) = 0 THEN rndnum = 7
                        IF grid(1) = 1 AND grid(4) = 1 AND grid(7) = 0 THEN rndnum = 7
                        IF grid(4) = 1 AND grid(7) = 1 AND grid(1) = 0 THEN rndnum = 1
                        IF grid(2) = 1 AND grid(5) = 1 AND grid(8) = 0 THEN rndnum = 8
                        IF grid(5) = 1 AND grid(8) = 1 AND grid(2) = 0 THEN rndnum = 2
                        IF grid(3) = 1 AND grid(6) = 1 AND grid(9) = 0 THEN rndnum = 9
                        IF grid(6) = 1 AND grid(9) = 1 AND grid(3) = 0 THEN rndnum = 3
                        IF grid(1) = 1 AND grid(5) = 1 AND grid(9) = 0 THEN rndnum = 9
                        IF grid(5) = 1 AND grid(9) = 1 AND grid(1) = 0 THEN rndnum = 1
                        IF grid(3) = 1 AND grid(5) = 1 AND grid(7) = 0 THEN rndnum = 7
                        IF grid(5) = 1 AND grid(7) = 1 AND grid(3) = 0 THEN rndnum = 3

                        IF cpulevel >= 2 THEN
                                IF grid(1) = 1 AND grid(3) = 1 AND grid(2) = 0 THEN rndnum = 2
                                IF grid(4) = 1 AND grid(6) = 1 AND grid(5) = 0 THEN rndnum = 5
                                IF grid(7) = 1 AND grid(9) = 1 AND grid(8) = 0 THEN rndnum = 8
                                IF grid(1) = 1 AND grid(7) = 1 AND grid(4) = 0 THEN rndnum = 4
                                IF grid(2) = 1 AND grid(8) = 1 AND grid(5) = 0 THEN rndnum = 5
                                IF grid(3) = 1 AND grid(9) = 1 AND grid(6) = 0 THEN rndnum = 6
                                IF grid(1) = 1 AND grid(9) = 1 AND grid(5) = 0 THEN rndnum = 5
                                IF grid(3) = 1 AND grid(7) = 1 AND grid(5) = 0 THEN rndnum = 5
                        END IF

                        REM check for possible CPU win

                        IF grid(1) = 2 AND grid(2) = 2 AND grid(3) = 0 THEN rndnum = 3
                        IF grid(2) = 2 AND grid(3) = 2 AND grid(1) = 0 THEN rndnum = 1
                        IF grid(4) = 2 AND grid(5) = 2 AND grid(6) = 0 THEN rndnum = 6
                        IF grid(5) = 2 AND grid(6) = 2 AND grid(4) = 0 THEN rndnum = 4
                        IF grid(7) = 2 AND grid(8) = 2 AND grid(9) = 0 THEN rndnum = 9
                        IF grid(8) = 2 AND grid(9) = 2 AND grid(7) = 0 THEN rndnum = 7
                        IF grid(1) = 2 AND grid(4) = 2 AND grid(7) = 0 THEN rndnum = 7
                        IF grid(4) = 2 AND grid(7) = 2 AND grid(1) = 0 THEN rndnum = 1
                        IF grid(2) = 2 AND grid(5) = 2 AND grid(8) = 0 THEN rndnum = 8
                        IF grid(5) = 2 AND grid(8) = 2 AND grid(2) = 0 THEN rndnum = 2
                        IF grid(3) = 2 AND grid(6) = 2 AND grid(9) = 0 THEN rndnum = 9
                        IF grid(6) = 2 AND grid(9) = 2 AND grid(3) = 0 THEN rndnum = 3
                        IF grid(1) = 2 AND grid(5) = 2 AND grid(9) = 0 THEN rndnum = 9
                        IF grid(5) = 2 AND grid(9) = 2 AND grid(1) = 0 THEN rndnum = 1
                        IF grid(3) = 2 AND grid(5) = 2 AND grid(7) = 0 THEN rndnum = 7
                        IF grid(5) = 2 AND grid(7) = 2 AND grid(3) = 0 THEN rndnum = 3
                        IF grid(1) = 2 AND grid(3) = 2 AND grid(2) = 0 THEN rndnum = 2
                        IF grid(4) = 2 AND grid(6) = 2 AND grid(5) = 0 THEN rndnum = 5
                        IF grid(7) = 2 AND grid(9) = 2 AND grid(8) = 0 THEN rndnum = 8
                        IF grid(1) = 2 AND grid(7) = 2 AND grid(4) = 0 THEN rndnum = 4
                        IF grid(2) = 2 AND grid(8) = 2 AND grid(5) = 0 THEN rndnum = 5
                        IF grid(3) = 2 AND grid(9) = 2 AND grid(6) = 0 THEN rndnum = 6
                        IF grid(1) = 2 AND grid(9) = 2 AND grid(5) = 0 THEN rndnum = 5
                        IF grid(3) = 2 AND grid(7) = 2 AND grid(5) = 0 THEN rndnum = 5

                        REM if all else fails - just choose a random tile

                        IF rndnum = 0 THEN
                                DO
                                        rndnum = INT(RND * 9) + 1
                                LOOP UNTIL grid(rndnum) = 0
                        END IF
                        SLEEP 1
                        x% = (rndnum - 1) MOD 3
                        y% = (rndnum - 1) \ 3
                        COLOR 1: PSET (200 + x% * 120, 120 + y% * 120): DRAW cross$
                        PAINT STEP(5, 0), 1, 1
                        grid(rndnum) = player
                        player = 1: playcnt = playcnt + 1

                END IF

                REM check for a win = 8 possible wins
                winflag = 0

                REM player win cases

                IF grid(1) = 1 AND grid(2) = 1 AND grid(3) = 1 THEN winflag = 1
                IF grid(4) = 1 AND grid(5) = 1 AND grid(6) = 1 THEN winflag = 1
                IF grid(7) = 1 AND grid(8) = 1 AND grid(9) = 1 THEN winflag = 1
                IF grid(1) = 1 AND grid(4) = 1 AND grid(7) = 1 THEN winflag = 1
                IF grid(2) = 1 AND grid(5) = 1 AND grid(8) = 1 THEN winflag = 1
                IF grid(3) = 1 AND grid(6) = 1 AND grid(9) = 1 THEN winflag = 1
                IF grid(1) = 1 AND grid(5) = 1 AND grid(9) = 1 THEN winflag = 1
                IF grid(3) = 1 AND grid(5) = 1 AND grid(7) = 1 THEN winflag = 1

                REM cpu win cases

                IF grid(1) = 2 AND grid(2) = 2 AND grid(3) = 2 THEN winflag = 2
                IF grid(4) = 2 AND grid(5) = 2 AND grid(6) = 2 THEN winflag = 2
                IF grid(7) = 2 AND grid(8) = 2 AND grid(9) = 2 THEN winflag = 2
                IF grid(1) = 2 AND grid(4) = 2 AND grid(7) = 2 THEN winflag = 2
                IF grid(2) = 2 AND grid(5) = 2 AND grid(8) = 2 THEN winflag = 2
                IF grid(3) = 2 AND grid(6) = 2 AND grid(9) = 2 THEN winflag = 2
                IF grid(1) = 2 AND grid(5) = 2 AND grid(9) = 2 THEN winflag = 2
                IF grid(3) = 2 AND grid(5) = 2 AND grid(7) = 2 THEN winflag = 2

                REM in case of a draw - need to add ifs for draw possibles


                IF winflag = 0 AND playcnt = 9 THEN EXIT DO

        LOOP UNTIL winflag >= 1 'user and cpu input loop

        IF winflag = 1 THEN
                LOCATE 16, 37: PRINT "You Win"
        ELSEIF winflag = 2 THEN
                LOCATE 16, 37: PRINT "You Lose"
        END IF

        REM clean up the screen, reset array and start the next game

        SLEEP 3

        CLS
        cnt = 1
        DO
                grid(cnt) = 0
                cnt = cnt + 1
        LOOP UNTIL cnt = 10
        IF rndplayer = 1 THEN rndplayer = 2 ELSE rndplayer = 1
        IF rndplayer = 1 THEN player = 2 ELSE player = 1
LOOP 'master game loop

 

My First QBasic Programme - Shoot the light...

I based this on a LED game i made when I was 15. The aim of the game is to shoot the light...Sounds simple, well it is...But in essence, it is the basics of a Space Invaders game, a moving target, and a bullet.

 

'SHOOT THE LIGHT V.01 - THANKS TO THOSE AT QBASIC.COM FORUM FOR ALL THEIR HELP
DIM OLDY2 AS INTEGER, OLDY AS INTEGER, X AS INTEGER, YC AS INTEGER, Y AS INTEGER, Y2 AS INTEGER, SHOT AS INTEGER, LVL AS INTEGER
DIM TM AS SINGLE
SCREEN 0
LVL = 0
TM = .5: X = 33: Y2 = 10:
IF LVL < 4 THEN Y = 38 ELSE Y = 66
DO
        DO
                DO

                        IF LVL = 9 THEN END
                        COLOR 10, 0
                        CLS: LOCATE 1, 1: PRINT "LEVEL : "; LVL
                        LOCATE 20, 1: COLOR 12, 0
                        PRINT "         ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° ° °"
                        LOCATE 33, Y - 1: PRINT "ܲÜ"
                        LOCATE 20, Y2: COLOR 14, 0: PRINT "±"
                        COLOR 2, 0
                        IF Y2 = 10 THEN YC = -2
                        IF Y2 = 66 THEN YC = 2
                        OLDY2 = Y2: Y2 = Y2 - YC: OLDY = Y
                        IF LVL >= 4 THEN Y = Y + YC


                        T = TIMER
                        DO WHILE TIMER - T < TM
                                IF TIMER < T THEN T = T - 86400
                        LOOP


                LOOP UNTIL INKEY$ > ""
                BEEP
                DO
                        IF LVL >= 4 THEN LOCATE X, OLDY ELSE LOCATE X - 1, Y
                        COLOR 9, 0: PRINT "þ": X = X - 1
                LOOP UNTIL X < 21
                X = 33: SHOT = SHOT + 1
                COLOR 14, 0
                IF OLDY = (Y2 - 2) OR OLDY2 = OLDY THEN
                        LOCATE 15, 15
                        PRINT "YOU SHOT ME DOWN DAMMIT!!!! IT TOOK YOU "; SHOT; "SHOTS"
                        LVL = LVL + 1: SHOT = 0
                END IF
                IF OLDY <> (Y2 - 2) AND OLDY2 <> OLDY THEN
                        LOCATE 15, 30: PRINT "YOU MISSED ME!! HA!"
                END IF
                DO UNTIL INKEY$ > ""
                        LOCATE 17, 27: PRINT "PRESS ANY KEY TO CONTINUE"
                LOOP
        LOOP UNTIL Y = (Y2 - 2)
        TM = TM - .1: SHOT = 0
        IF TM = .1 THEN TM = .5
LOOP UNTIL INKEY$ > ""
END

 

Pure Mp3 - v.01

This is my QB64 mp3 player. Only plays mp3's, a few bugs here and there, but other than that it works. I will continue to work on this project as it is one of my favorites, so check back from time to time for updates.

REM PureMp3 - Version .01 - By Unseen Machine

DIM SHARED tracknum AS INTEGER, mp3cnt AS INTEGER, updateflag AS INTEGER, arl AS INTEGER, btnval AS INTEGER, h AS LONG
DIM ltrcnt AS INTEGER, bckspcval AS INTEGER
DIM SHARED cnt AS INTEGER, mastervol AS DOUBLE, clr AS INTEGER
DIM SHARED fnt AS LONG

_TITLE "PURE Mp3 Version.01"
fnt = _LOADFONT("C:\windows\fonts\comic.ttf", 16)

mastervol = .4
CALL createMp3
CALL drawscreen
CALL mp3count
CALL volpaint
updateflag = 1: arl = 4
tracknum = 0

OPEN "c:\mp3list.txt" FOR INPUT AS #1
DO
        REDIM SHARED track(1 TO 10) AS STRING
        REDIM SHARED trackname(1 TO 10) AS STRING
        CALL loadlist
        CALL userinput
LOOP


REM SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS SUBS

SUB volpaint

DIM lcnt AS INTEGER, vlx AS INTEGER, vcomp AS DOUBLE, bclr AS INTEGER
vcomp = 0: lcnt = 0: vlx = 240
DO
        vcomp = vcomp + .1
        IF lcnt <= 4 THEN clr = 2
        IF lcnt >= 5 AND lcnt <= 7 THEN clr = 6
        IF lcnt >= 8 THEN clr = 4
        IF vcomp <= mastervol THEN
                PAINT (vlx, 250), clr, 7
        ELSEIF vcomp > mastervol THEN
                PAINT (vlx, 250), 0, 7
        END IF
        lcnt = lcnt + 1
        vlx = vlx + 16
LOOP UNTIL lcnt = 10
END SUB

 


SUB loadlist
DIM ucnt AS INTEGER

_FONT fnt

IF updateflag = 2 THEN

        CLOSE #1
        tracknum = tracknum - 20
        IF tracknum <= 1 THEN tracknum = mp3cnt - 10
        OPEN "c:\mp3list.txt" FOR INPUT AS #1
        ucnt = 0
        DO
                LINE INPUT #1, mp3file$
                ucnt = ucnt + 1
        LOOP UNTIL ucnt = tracknum
        updateflag = 1
END IF

IF updateflag = 1 THEN
        cnt = 0

        DO
                IF EOF(1) THEN
                        CLOSE #1
                        OPEN "c:\mp3list.txt" FOR INPUT AS #1
                        tracknum = 0
                        cnt = 0
                END IF

                cnt = cnt + 1
                LINE INPUT #1, mp3file$
                trackname(cnt) = mp3file$

                IF tracknum < mp3cnt THEN tracknum = tracknum + 1

                ltrcnt = LEN(trackname(cnt))
                DO
                        ltrcnt = ltrcnt - 1
                        ltr$ = MID$(trackname(cnt), ltrcnt, 1)
                        IF ltr$ = "\" THEN
                                bckspcval = ltrcnt
                                EXIT DO
                        END IF
                LOOP UNTIL ltrcnt = 0

                track(cnt) = RIGHT$(mp3file$, (LEN(mp3file$) - ltrcnt))
                LOCATE 3 + cnt, 120: PRINT SPACE$(120)
                LOCATE 3 + cnt, 120: PRINT LEFT$(track(cnt), 55)
        LOOP UNTIL cnt = 10


END IF
updateflag = 0
END SUB

 

 

 


SUB userinput
DIM btnl AS INTEGER, btnr AS INTEGER, oldvol AS DOUBLE
DO
        btnl = 90: btnr = 170
        cnt = 0: btnval = 0
        oldvol = mastervol

        DO WHILE _MOUSEINPUT

                'LOCATE 1, 1: PRINT _MOUSEX; _MOUSEY
                REM minus and plus volume buttons
                IF _MOUSEBUTTON(1) = -1 THEN

                        IF _MOUSEY >= 234 AND _MOUSEY <= 276 THEN

                                IF _MOUSEX >= 164 AND _MOUSEX <= 223 THEN

                                        IF mastervol > 0 THEN mastervol = mastervol - .1

                                ELSEIF _MOUSEX >= 400 AND _MOUSEX <= 459 THEN

                                        IF mastervol < 1 THEN mastervol = mastervol + .1

                                END IF

                        END IF

                        IF mastervol >= 0 AND mastervol <= 1 AND mastervol <> oldvol THEN
                                _SNDVOL h&, mastervol
                                CALL volpaint
                        END IF

                        REM standard buttons
                        IF _MOUSEY >= 300 AND _MOUSEY <= 340 THEN

                                DO
                                        cnt = cnt + 1
                                        IF _MOUSEX >= btnl AND _MOUSEX <= btnr THEN
                                                btnval = cnt
                                                EXIT DO
                                        ELSE
                                                btnl = btnl + 90: btnr = btnr + 90
                                        END IF
                                LOOP UNTIL cnt = 5
                        END IF
                END IF


                IF btnval > 0 THEN CALL buttonhandler

        LOOP


        kb$ = INKEY$

        SELECT CASE kb$

                CASE CHR$(0) + CHR$(72)

                        LOCATE arl, 100: PRINT "  "
                        IF arl > 4 THEN
                                arl = arl - 1
                        ELSE
                                arl = 13
                                updateflag = 2
                                EXIT DO
                        END IF

                CASE CHR$(0) + CHR$(80)

                        LOCATE arl, 100: PRINT "  "
                        IF arl < 13 THEN
                                arl = arl + 1
                        ELSE
                                arl = 4
                                updateflag = 1
                                EXIT DO
                        END IF


                CASE CHR$(0) + CHR$(77)

                        updateflag = 1
                        EXIT DO

                CASE CHR$(0) + CHR$(75)

                        updateflag = 2
                        EXIT DO

                CASE CHR$(27)

                        SYSTEM

        END SELECT

        LOCATE arl, 100: PRINT CHR$(175)

LOOP

END SUB


SUB createMp3
SCREEN 0
CLS

REM check for music list file if none exist create one from mp3 search

OPEN "C:\mp3list.txt" FOR RANDOM AS #1

IF LOF(1) > 1 THEN

        CLOSE #1

ELSE
        CLOSE #1
        OPEN "C:\mp3crt.bat" FOR OUTPUT AS #1
        PRINT #1, "ECHO OFF"
        PRINT #1, "CLS"
        PRINT #1, "ECHO Creating mp3 file list"
        PRINT #1, "cd\"
        PRINT #1, "cmd /c dir *.mp3 /b /s > C:\mp3list.txt"
        CLOSE #1
        PRINT "Searching for Mp3 files..."
        SHELL _HIDE "c:\mp3crt.bat"
        KILL "c:\mp3crt.bat"
END IF

END SUB

 

SUB playmp3

_SNDSTOP h&
_SNDCLOSE h&
h& = _SNDOPEN(trackname(arl - 3), "vol,pause")
_SNDVOL h&, mastervol
_SNDPLAY h&

END SUB


SUB buttonhandler

IF btnval = 1 THEN 'pause

        IF _SNDPAUSED(h&) = -1 THEN
                _SNDPLAY h&
        ELSE
                _SNDPAUSE h&
        END IF

ELSEIF btnval = 2 THEN 'play

        _SNDSTOP h&
        CALL playmp3

ELSEIF btnval = 3 THEN 'stop

        _SNDSTOP h&

ELSEIF btnval = 4 THEN 'previous

        LOCATE arl, 100: PRINT "  "

        IF arl > 4 THEN

                arl = arl - 1

        ELSE

                arl = 13
                updateflag = 2
                CALL loadlist

        END IF

        IF _SNDPLAYING(h&) = -1 THEN CALL playmp3

ELSEIF btnval = 5 THEN 'next

        LOCATE arl, 100: PRINT "  "

        IF arl < 13 THEN

                arl = arl + 1

        ELSE arl = 4

                updateflag = 1
                CALL loadlist

        END IF

        IF _SNDPLAYING(h&) = -1 THEN CALL playmp3

END IF

END SUB

SUB drawscreen

SCREEN 9: CLS

DIM cnt AS INTEGER, btnx AS INTEGER, vcnt AS INTEGER, vx AS INTEGER
button$ = "l40 u40 r80 d40 l40"
btnx = 130: vx = 240


COLOR 7
DO

        PSET (vx, 267): DRAW "l6u24r12d24l6"
        vx = vx + 16
        vcnt = vcnt + 1
LOOP UNTIL vcnt = 10
PSET (194, 276), 15: DRAW "L30u40r60d40l30 bu20 nl10nr10"
PSET (430, 276), 15: DRAW "L30u40r60d40l30bu20 nl10nr10nu10d10"

DO

        IF cnt = 0 THEN

                PSET (btnx, 340), 2: DRAW "Bu10bl8 u20r5d20l5 br15 l5u20r5d20"

        ELSEIF cnt = 1 THEN

                PSET (btnx, 340), 2: DRAW "Bu10bl5 u20f10g10"

        ELSEIF cnt = 2 THEN

                PSET (btnx, 340), 4: DRAW "Bu10bl10 u20r20d20l20 ": PAINT STEP(0, -4), 4, 4

        ELSEIF cnt = 3 THEN

                PSET (btnx, 340), 2: DRAW "Bu10br8 u20g10u10g10f10u10f10"

        ELSEIF cnt = 4 THEN

                PSET (btnx, 340), 2: DRAW "Bu10bl8 u20f10u10f10g10u10g10"

        END IF

        PSET (btnx, 340), 15: DRAW button$

        btnx = btnx + 90
        cnt = cnt + 1

LOOP UNTIL cnt = 5

END SUB


SUB mp3count
REM count mp3 files
mp3cnt = 0
OPEN "c:\mp3list.txt" FOR INPUT AS #1
DO
        LINE INPUT #1, mp3file$
        mp3cnt = mp3cnt + 1
LOOP UNTIL EOF(1)
CLOSE #1

END SUB