Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

pbcc slot machine

Collapse
X
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    pbcc slot machine

    http://www.bervini.net/raffaello/



    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
'------------------------------------------------------------------------------
    Last edited by Raffaello Bervini; 24 Apr 2008, 12:55 AM.
    Tags: None
Previous template Next
Working...
X

We process personal data about users of our site, through the use of cookies and other technologies, to deliver our services, and to analyze site activity. For additional details, refer to our Privacy Policy.

By clicking "I AGREE" below, you agree to our Privacy Policy and our personal data processing and cookie practices as described therein. You also acknowledge that this forum may be hosted outside your country and you consent to the collection, storage, and processing of your data in the country where this forum is hosted.

I Agree