Code:
'Bervini Raffaello Switzerland
'PowerBasic PBCC
'www.bervini.net/raffaello/ for all the bmp
#COMPILE EXE
#DIM ALL
'------------------------------------------------------------------------------
GLOBAL hDlg1,hDlg2,hDlg3,id_cil1,id_cil2,id_cil3,iter AS LONG
'%figure=37
'%figure=27
%figure=9
'%figure=13
'%figure=14
'%figure=4
'%figure=3
'------------------------------------------------------------------------------
FUNCTION PBMAIN () AS LONG
LOCAL larghezza_finestra,altezza_finestra AS LONG,i AS STRING
IF larghezza_finestra=0 THEN larghezza_finestra=150
IF altezza_finestra=0 THEN altezza_finestra=98
GRAPHIC WINDOW "",200+0*larghezza_finestra,200,larghezza_finestra,altezza_finestra*3 TO hDlg1
GRAPHIC WINDOW "",200+1*larghezza_finestra,200,larghezza_finestra,altezza_finestra*3 TO hDlg2
GRAPHIC WINDOW "",200+2*larghezza_finestra,200,larghezza_finestra,altezza_finestra*3 TO hDlg3
CONSOLE SET FOCUS:CONSOLE SET SCREEN 2,80:CONSOLE SET LOC 0,0
PRINT "Studio slot machine ..."
PRINT "<Spazio> per giocare, <c> continuo, <esc> per finire"
'----
LOCAL j,id_bmp(),id_tmp AS LONG
DIM id_bmp(0 TO %figure)
FOR j=1 TO %figure:CALL caricaimmagine("carta"+TRIM$(STR$(j))+".bmp",id_tmp):id_bmp(j)=id_tmp:NEXT
'----
CALL creacilindro(id_bmp(),%figure,id_cil1)
CALL creacilindro(id_bmp(),%figure,id_cil2)
CALL creacilindro(id_bmp(),%figure,id_cil3)
CALL slot(altezza_finestra)
DO:
i=INKEY$
SLEEP 100
IF i=CHR$(27) THEN EXIT LOOP
SELECT CASE i
CASE "c":DO:CALL slot(altezza_finestra):SLEEP 1000:LOOP WHILE NOT INSTAT
CASE " ":CALL slot(altezza_finestra)
END SELECT
LOOP
END FUNCTION
'------------------------------------------------------------------------------
SUB color2rgb(colore AS LONG,red AS LONG,green AS LONG,blue AS LONG)
Red=colore AND &H000000FF
SHIFT RIGHT colore,8
Green=colore AND &H000000FF
SHIFT RIGHT colore,8
Blue=colore AND &H000000FF
END SUB
'------------------------------------------------------------------------------
SUB muovi(id_mem AS LONG,hDlg AS LONG,py AS LONG)
LOCAL la_win,al_win,id_tmp,j AS LONG
STATIC al_bmp,la_bmp AS LONG
GRAPHIC ATTACH hDlg,0,REDRAW
GRAPHIC GET CLIENT TO la_win,al_win
IF la_bmp=0 OR al_bmp=0 THEN GRAPHIC ATTACH id_mem,0,REDRAW:GRAPHIC GET CLIENT TO la_bmp,al_bmp
GRAPHIC BITMAP NEW la_bmp,al_bmp TO id_tmp:GRAPHIC ATTACH id_tmp,0,REDRAW
IF py>0 THEN
GRAPHIC COPY id_mem,0,(0,0)-(la_bmp-1,al_bmp-py) TO (0,py)
GRAPHIC COPY id_mem,0,(0,al_bmp-py)-(la_bmp,al_bmp) TO (0,0)
GRAPHIC ATTACH id_mem,0,REDRAW:GRAPHIC COPY id_tmp,0,(0,0)-(la_bmp-0,al_bmp-0) TO (0,0):GRAPHIC ATTACH id_tmp,0,REDRAW
END IF
GRAPHIC BITMAP END
GRAPHIC ATTACH hDlg,0,REDRAW
GRAPHIC COPY id_mem,0,(0,0)-(la_win,al_win) TO (0,0)
FOR j=3 TO 1 STEP -1
GRAPHIC LINE (0,al_win/2+j)-(la_win/6,al_win/2+j),RGB(255-j*20,25,25)
GRAPHIC LINE (5*la_win/6,al_win/2+j)-(la_win,al_win/2+j),RGB(255-j*20,25,25)
NEXT
'zigrinatura
FOR j=al_win/3 TO 0 STEP -2
' GRAPHIC LINE (0,j-1)-(la_win,j-1),RGB(j*6-al_win/3,j*6-al_win/3,j*6-al_win/3)
GRAPHIC LINE (0,al_win-j)-(la_win,al_win-j),RGB(j*6-al_win/3,j*6-al_win/3,j*6-al_win/3)
NEXT
'scurisce
LOCAL PixelPtr AS LONG PTR,xsize,ysize,red,green,blue AS LONG,bmp AS STRING,soglia AS SINGLE
GRAPHIC GET BITS TO bmp:xsize=CVL(bmp,1):ysize=CVL(bmp,5)
PixelPtr=STRPTR(bmp)+8:soglia=0
FOR j=1 TO xsize*ysize/3:soglia=soglia+.000069:CALL color2rgb(BYCOPY @PixelPtr,red,green,blue):@PixelPtr=RGB(red*soglia,green*soglia,blue*soglia):INCR PixelPtr:NEXT
FOR j=2*xsize*ysize/3 TO xsize*ysize:INCR PixelPtr:NEXT
PixelPtr=STRPTR(bmp)+8:soglia=1
FOR j=1 TO 2*xsize*ysize/3:INCR PixelPtr:NEXT
FOR j=2*xsize*ysize/3 TO xsize*ysize:soglia=soglia-.00008:CALL color2rgb(BYCOPY @PixelPtr,red,green,blue):@PixelPtr=RGB(red*soglia,green*soglia,blue*soglia):INCR PixelPtr:NEXT
GRAPHIC SET BITS bmp
'linee orizzontali
GRAPHIC LINE (0,al_win/3-1)-(la_win,al_win/3-1),RGB(255,205,205)
GRAPHIC LINE (0,2*al_win/3)-(la_win,2*al_win/3),RGB(255,205,205)
'bordi in alto e basso
FOR j=0 TO al_win/12:GRAPHIC LINE (0,j)-(la_win,j),RGB(2255/(j+6),1255/(j+6),1255/(j+6)):NEXT
FOR j=11*al_win/12 TO al_win:GRAPHIC LINE (0,j)-(la_win,j),RGB(2255/(j-11*al_win/12+6),1255/(j-11*al_win/12+6),1255/(j-11*al_win/12+6)):NEXT
GRAPHIC REDRAW
END SUB
'------------------------------------------------------------------------------
SUB caricaimmagine(nomefile AS STRING,id_bmp AS LONG)
LOCAL ff,la,al AS LONG
IF DIR$(nomefile)="" THEN
GRAPHIC BITMAP NEW 150,98 TO id_bmp
GRAPHIC ATTACH id_bmp,0,REDRAW
GRAPHIC CLEAR RGB(RND*255,RND*255,RND*255)
GRAPHIC COLOR RGB(RND*255,RND*255,RND*255),-2
GRAPHIC PRINT "qui ci va bmp 150x98"
GRAPHIC COLOR RGB(RND*255,RND*255,RND*255),-2
GRAPHIC FONT "arial",16,1
GRAPHIC PRINT nomefile
GRAPHIC COPY id_bmp,0
GRAPHIC WINDOW END
ELSE
ff=FREEFILE:OPEN nomefile FOR BINARY AS ff:GET #ff,19,la:GET #ff,23,al:CLOSE ff
GRAPHIC BITMAP LOAD nomefile,la,al TO id_bmp
GRAPHIC ATTACH id_bmp,0,REDRAW
GRAPHIC COPY id_bmp,0
GRAPHIC WINDOW END
END IF
END SUB
'------------------------------------------------------------------------------
SUB creacilindro(id() AS LONG,item AS LONG,id_cil AS LONG)
LOCAL j,la,al,r AS LONG
IF id_cil<>0 THEN GRAPHIC ATTACH id_cil,0:GRAPHIC WINDOW END
GRAPHIC ATTACH id(1),0,REDRAW:GRAPHIC GET CLIENT TO la,al
GRAPHIC BITMAP NEW la,al*item TO id_cil
GRAPHIC ATTACH id_cil,0,REDRAW
FOR j=0 TO item-1
GRAPHIC COPY id(j+1),0 TO (0,al*j)
GRAPHIC COLOR %GREEN,-2:GRAPHIC SET POS(0,al*j):GRAPHIC PRINT j+1
GRAPHIC SET PIXEL (1,1+al*j),RGB(j+1,0,0)
NEXT
GRAPHIC REDRAW
'salva l'immagine del rullo
'GRAPHIC SAVE "cil"+TRIM$(STR$(%figure))+".bmp"
END SUB
'------------------------------------------------------------------------------
SUB slot(af AS LONG)
LOCAL j,k,k1,k2,k3,ok1,ok2,ok3,y1,y2,y3,finale1,finale2,finale3,colore1,colore2,colore3 AS LONG
%velocita=12
INCR iter
RANDOMIZE TIMER
'randomizza la posizione iniziale del cilindro
CALL muovi(id_cil1,hDlg1,RND(1,%figure)*af):CALL muovi(id_cil2,hDlg2,RND(1,%figure)*af):CALL muovi(id_cil3,hDlg3,RND(1,%figure)*af)
'questo crea errori
'k1=RND(1,%figure)*af*%figure:k2=RND(1,%figure)*af*%figure:k3=RND(1,%figure)*af*%figure
'questo non crea errori
k1=RND(5,%figure)*af:k2=RND(5,%figure)*af:k3=RND(5,%figure)*af
k=MAX(k1,k2,k3)
FOR j=1 TO k
IF k1=>1 THEN y1=1+k1\%velocita:CALL muovi(id_cil1,hDlg1,y1):ok1=ok1+y1:k1=k1-y1 ELSE finale1=1
IF k2=>1 THEN y2=1+k2\%velocita:CALL muovi(id_cil2,hDlg2,y2):ok2=ok2+y2:k2=k2-y2 ELSE finale2=1
IF k3=>1 THEN y3=1+k3\%velocita:CALL muovi(id_cil3,hDlg3,y3):ok3=ok3+y3:k3=k3-y3 ELSE finale3=1
'removed IF INKEY$>"" THEN EXIT SUB
SLEEP 10
IF finale1+finale2+finale3=3 THEN EXIT FOR
NEXT
GRAPHIC ATTACH hDlg1,0,REDRAW:GRAPHIC GET PIXEL (1,1+af) TO colore1
GRAPHIC ATTACH hDlg2,0,REDRAW:GRAPHIC GET PIXEL (1,1+af) TO colore2
GRAPHIC ATTACH hDlg3,0,REDRAW:GRAPHIC GET PIXEL (1,1+af) TO colore3
CALL esaminavincite(colore1,colore2,colore3)
'scrive nei bordi
CALL scrivi(hDlg1,"<space> play",-20)
CALL scrivi(hDlg2,"<c> continuo",-20)
CALL scrivi(hDlg3,"<esc> end",-20)
CALL scrivi(hDlg2,"Giocate"+STR$(iter)+"",5)
CALL scrivi(hDlg3,USING$("## ",colore1,colore2,colore3)+" (rullo"+STR$(%figure)+")",5)
END SUB
'------------------------------------------------------------------------------
SUB esaminavincite(c1 AS LONG,c2 AS LONG,c3 AS LONG)
STATIC vincita AS LONG
IF c1=c2 AND c2=c3 THEN vincita=vincita+10:CALL scrivi(hDlg1,"Saldo "+STR$(vincita)+"$",5):EXIT SUB
IF c1=c2 THEN vincita=vincita+2:CALL scrivi(hDlg1,"Saldo "+STR$(vincita)+"$",5):EXIT SUB
IF c1=c3 THEN vincita=vincita+2:CALL scrivi(hDlg1,"Saldo "+STR$(vincita)+"$",5):EXIT SUB
IF c2=c3 THEN vincita=vincita+2:CALL scrivi(hDlg1,"Saldo "+STR$(vincita)+"$",5):EXIT SUB
vincita=vincita-1
CALL scrivi(hDlg1,"Saldo "+STR$(vincita)+"$",5)
END SUB
'------------------------------------------------------------------------------
SUB scrivi(hDlg AS LONG,testo AS STRING,posizione AS LONG)
LOCAL la,al,l,a AS LONG
GRAPHIC ATTACH hDlg,0,REDRAW
GRAPHIC GET CLIENT TO la,al
GRAPHIC TEXT SIZE testo TO l,a
IF posizione<0 THEN posizione=al+posizione
GRAPHIC SET POS((la-l)/2,posizione)
GRAPHIC COLOR %WHITE,-2
GRAPHIC FONT "arial",10,1
GRAPHIC PRINT testo
GRAPHIC REDRAW
END SUB
'------------------------------------------------------------------------------