fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
jetz noch besser xD

Uploader:	The_Muh
Datum/Zeit:	02.10.2008 01:01:05
screenres 1024, 756 ,,,&H01



dim shared new_round as integer

dim shared term as integer

dim shared clean as integer

dim shared xm as any ptr

xm = mutexcreate



SETMOUSE 1,1,0



randomize timer



sub watch()

    dim key as string

    dim mx as integer

    dim my as integer

    dim new_x as integer

    dim new_y as integer



    getmouse my, mx

    do

        draw string (1,1),str( clean)

        sleep 10

        draw string (1,1),chr(219) + chr(219),0

        getmouse new_y, new_x

        if new_x <> mx then exit do

        if new_y <> my then exit do

        key = inkey

    loop until key <> ""

    mutexlock(XM)

    term = 1

    mutexunlock(XM)

end sub



sub text()

    do

    draw string (1,1),str( clean)

    draw string (51*8 , 40*8),"#   # ##### ##### ##### #   #"

    draw string (51*8 , 41*8),"#   # #   # #   # #   #  # #"

    draw string (51*8 , 42*8),"##### ##### ##### #####   #"

    draw string (51*8 , 43*8),"#   # #   # #     #       #"

    draw string (51*8 , 44*8),"#   # #   # #     #       #"



    draw string (43*8 , 46*8),"####  # ####  ##### #   # ###   ##### #   #"

    draw string (43*8 , 47*8),"#   # # #   #   #   #   # #  #  #   #  # #"

    draw string (43*8 , 48*8),"####  # ####    #   ##### #   # #####   #"

    draw string (43*8 , 49*8),"#   # # #  #    #   #   # #  #  #   #   #"

    draw string (43*8 , 50*8),"####  # #   #   #   #   # ###   #   #   #"



    sleep 250

    draw string (1,1),chr(219) + chr(219),0

    mutexlock(XM)

    if clean >= 21 then

        cls

        clean = 0

    end if

    mutexunlock(XM)

    loop until term = 1

end sub



sub feuerwerk()

    dim x as integer

    dim boden as integer

    dim y as integer

    dim abw_x as integer

    dim abw_y as integer

    dim col as integer



    do

        col = rnd * 4 + 1

        x = rnd * 923 + 50

        y = rnd * 656 + 50

        boden = x + rnd*50 - rnd*50

        for i2 as integer = 756 to y step -1

            circle (x, i2 +1), 1.5,0,,,,f

            circle (x, i2), 1.5,col,,,,f

            sleep 1

            if term = 1 then exit do

        next i2

        for i2 as integer = 1 to 75

            abw_x = rnd*i2 +1 - i2/2

            abw_y = rnd*i2 +1 - i2/2

            pset(x + abw_x, y + abw_y),col

            sleep 1

            if term = 1 then exit do

        next i2

        sleep 10

    mutexlock(XM)

    clean += 1

    mutexunlock(XM)

    loop until term = 1

end sub



dim feuer(1 to 6) as any ptr



Dim TH1 as Any Ptr = ThreadCreate(Cast(Any Ptr, @watch))

Dim TH2 as Any Ptr = ThreadCreate(Cast(Any Ptr, @text))

for i as integer = 1 to 6

    feuer(i) = threadcreate(cast(any ptr, @feuerwerk))

    sleep rnd*(i * 20 * (rnd*100)) +1

next i



threadwait(th2)

end