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

PBWin Slot Machine

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin Slot Machine

    www.bervini.net/raffaello/
    Code:
    'Bervini Raffaello Switzerland
    'PowerBasic PBWin
    'www.bervini.net/raffaello/     for all the bmp
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "win32api.inc"
    '------------------------------------------------------------------------------
     %id_fondo  = 100
     %id_info   = 110
     %id_rullo  = 110
     %id_start  = 120
     %id_quick  = 130
     %id_timer1 = 200
     $radice="carta"
    '$radice="dado"
     GLOBAL hDlg AS DWORD
    '------------------------------------------------------------------------------
     GLOBAL iter,larghezza_finestra,altezza_finestra,id_bmp(),id_tmp,id_cil(),continuo AS LONG
     GLOBAL fondo_bmp AS STRING
     GLOBAL figure,rulli AS LONG
    '------------------------------------------------------------------------------
    FUNCTION PBMAIN () AS LONG
     LOCAL ff,j,Count,px,py,la,al AS LONG
     RANDOMIZE TIMER
     IF COMMAND$<>"" THEN figure=VAL(PARSE$(COMMAND$," ",2)):rulli=VAL(PARSE$(COMMAND$," ",1))
     IF figure=0 THEN figure=3
     IF rulli=0 THEN rulli=3
     ff=FREEFILE:OPEN $radice+"1.bmp" FOR BINARY AS ff:GET #ff,19,larghezza_finestra:GET #ff,23,altezza_finestra:CLOSE ff
     IF larghezza_finestra=0 THEN larghezza_finestra=150
     IF altezza_finestra=0 THEN altezza_finestra=98
     px=10:py=50:la=larghezza_finestra*rulli+px*2:al=altezza_finestra*3+py*2
     DIALOG NEW PIXELS,0,"Versione 0.1 Bervini Soft",,,la,al,%WS_CAPTION OR %WS_SYSMENU,0*%WS_EX_TOOLWINDOW OR %WS_EX_TOPMOST TO hDlg
     CONTROL ADD GRAPHIC,hDlg,%id_fondo,"",0,0,la,al
     GRAPHIC ATTACH hDlg,%id_fondo,REDRAW
     GRAPHIC RENDER "slot.bmp",(0,0)-(la,al)
     GRAPHIC GET BITS TO fondo_bmp
     CONTROL ADD GRAPHIC,hDlg,%id_info,"",10,10,la-20,py-20
     FOR j=1 TO rulli
      CONTROL ADD GRAPHIC,hDlg,%id_rullo+j,"x",px+(j-1)*larghezza_finestra,py,larghezza_finestra,altezza_finestra*3,%ss_notify
     NEXT
    
     px=10:la=(la-2*px)/2
     CONTROL ADD GRAPHIC,hDlg,%id_start,"play" ,px,al-py/2-10,la,30,%ss_notify:px=px+la
     GRAPHIC ATTACH hDlg,%id_start:GRAPHIC SET BITS fondo_bmp
     CALL scrivi(%id_start,"PLAY","arial",3,%YELLOW)
     CONTROL ADD GRAPHIC,hDlg,%id_quick,"quick",px,al-py/2-10,la,30,%ss_notify:px=px+la
     CALL scrivi(%id_quick,"QUICK","arial",3,%YELLOW)
     DIALOG SHOW MODAL hDlg,CALL DlgProc
    
    END FUNCTION
    '------------------------------------------------------------------------------
    CALLBACK FUNCTION DlgProc () AS LONG
     LOCAL j AS LONG
     STATIC idEvent AS LONG
    
     SELECT CASE CBMSG
      CASE %WM_INITDIALOG
       idEvent=SetTimer(CBHNDL,%ID_TIMER1,10,BYVAL %NULL)
       CALL inizializza
      CASE %WM_TIMER
       IF CBWPARAM = %ID_TIMER1 THEN
        IF continuo=1 THEN CALL quick(altezza_finestra)
       END IF
    
      CASE %WM_DESTROY
       IF idEvent THEN KillTimer CBHNDL,idEvent
    
      CASE %WM_COMMAND
       SELECT CASE CBCTL
        CASE %id_start:continuo=0:CALL playwave("cashtill.wav",%SND_aSYNC):SLEEP 100:CALL slot(altezza_finestra):SLEEP 1000
        CASE %id_quick:IF continuo=0 THEN continuo=1 ELSE continuo=0
        CASE %IDCANCEL
         DIALOG END CBHNDL,0
       END SELECT
     END SELECT
    END FUNCTION
    '-----------------------------------------------------------------------------
    SUB PlayWave(BYVAL File AS STRING,modo AS LONG)
     LOCAL zWav AS ASCIIZ*256
     zWav = File$
     PlaySound zWav,BYVAL %NULL,modo
    END SUB
    '------------------------------------------------------------------------------
    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,id AS LONG,py AS SINGLE)
     LOCAL la_win,al_win,id_tmp,j AS LONG
     STATIC al_bmp,la_bmp AS LONG
     GRAPHIC ATTACH hDlg,id,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,id,REDRAW
     GRAPHIC COPY id_mem,id,(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
    
    'scurisce parte sopra
     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 .04*xsize*ysize:INCR PixelPtr:NEXT
     FOR j=.04*xsize*ysize TO xsize*ysize/3:soglia=soglia+.00009:CALL color2rgb(BYCOPY @PixelPtr,red,green,blue):@PixelPtr=RGB(red*soglia,green*soglia,blue*soglia):INCR PixelPtr:NEXT
     FOR j=xsize*ysize/3 TO xsize*ysize:INCR PixelPtr:NEXT
    
    'scurisce parte sotto
     PixelPtr=STRPTR(bmp)+8:soglia=1
     FOR j=1 TO 2*xsize*ysize/3:INCR PixelPtr:NEXT
     FOR j=2*xsize*ysize/3 TO .96*xsize*ysize:soglia=soglia-.0001:CALL color2rgb(BYCOPY @PixelPtr,red,green,blue):@PixelPtr=RGB(red*soglia,green*soglia,blue*soglia):INCR PixelPtr:NEXT
     FOR j=.96*xsize*ysize TO xsize*ysize: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 .04*al_win      :GRAPHIC LINE (0,j)-(la_win,j),RGB(2255/(j+6),1255/(j+6),1255/(j+60)):NEXT
     FOR j=0.96*al_win TO al_win:GRAPHIC LINE (0,j)-(la_win,j),RGB(2255/(j-.96*al_win+6),1255/(j-.96*al_win+6),1255/(j-.96*al_win+60)):NEXT
    
     GRAPHIC REDRAW
    END SUB
    '------------------------------------------------------------------------------
    SUB caricaimmagine(nomefile AS STRING,id_bmp AS LONG)
     LOCAL ff,la,al,id_bmp_tmp AS LONG
     IF DIR$(nomefile)="" THEN
      GRAPHIC BITMAP NEW larghezza_finestra,altezza_finestra 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_tmp
      GRAPHIC BITMAP NEW larghezza_finestra,altezza_finestra TO id_bmp
      GRAPHIC ATTACH id_bmp,0,REDRAW
    ' GRAPHIC COPY id_bmp_tmp,0
      GRAPHIC STRETCH id_bmp_tmp,0,(0,0)-(la,al) TO (0,0)-(larghezza_finestra,altezza_finestra)
      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 y() AS SINGLE
     LOCAL i,j,maxk,k(),finale(),colore_tmp,tot AS LONG,colore AS STRING
     DIM k(0 TO rulli),y(0 TO rulli),finale(0 TO rulli)
     %velocita=24'12
     INCR iter
    'randomizza la posizione iniziale del cilindro
     FOR j=1 TO rulli:CALL muovi(id_cil(j),%id_rullo+j,RND(1,figure)*af):NEXT
    
     FOR j=1 TO rulli
      k(j)=RND(5,figure*12)*af:IF maxk<k(j) THEN maxk=k(j)
     NEXT
    
     FOR j=1 TO maxk
      FOR i=1 TO rulli
       IF k(i)=>1 THEN y(i)=1+k(i)\%velocita:CALL muovi(id_cil(i),%id_rullo+i,MIN(af,y(i))):k(i)=k(i)-MIN(af,y(i)) ELSE finale(i)=1
      NEXT
      tot=0:FOR i=1 TO rulli:tot=tot+finale(i):NEXT
      IF tot=rulli THEN playwave("Whop.wav",%SND_aSYNC):EXIT FOR
     NEXT
    
     FOR j=1 TO rulli
      GRAPHIC ATTACH hDlg,%id_rullo+j,REDRAW:GRAPHIC GET PIXEL (1,1+af) TO colore_tmp
      colore=colore+CHR$(64+colore_tmp)
     NEXT
    
     CALL esaminavincite(colore)
    END SUB
    '------------------------------------------------------------------------------
    SUB esaminavincite(c AS STRING)
     LOCAL j,colore AS LONG
     STATIC vincita AS LONG
     vincita=vincita-1
     FOR j=1 TO LEN(c)
      IF TALLY(c,CHR$(64+j))=rulli   THEN vincita=vincita+10:EXIT FOR
    ' IF TALLY(c,CHR$(64+j))=rulli-1 THEN vincita=vincita+2:EXIT FOR
     NEXT
     IF vincita>=0 THEN colore=%GREEN ELSE colore=%RED
     CALL scrivi(%id_info,STR$(iter)+" giocate"+" : "+c+"  Saldo "+STR$(vincita)+" fr","times new roman",3,colore)
    END SUB
    '------------------------------------------------------------------------------
    SUB scrivi(id AS LONG,testo AS STRING,fonte AS STRING,posizione AS LONG,colore AS LONG)
     LOCAL la,al,l,a AS LONG
     GRAPHIC ATTACH hDlg,id,REDRAW
     GRAPHIC GET CLIENT TO la,al
     GRAPHIC CLEAR RGB(80,20,20)
     GRAPHIC SET BITS fondo_bmp
     GRAPHIC FONT fonte,18,0
     GRAPHIC TEXT SIZE testo TO l,a
     IF posizione<0 THEN posizione=al+posizione
     GRAPHIC SET POS((la-l)/2+1,posizione+1):GRAPHIC COLOR %BLACK,-2:GRAPHIC PRINT testo
     GRAPHIC SET POS((la-l)/2,posizione):GRAPHIC COLOR colore,-2:GRAPHIC PRINT testo
     GRAPHIC REDRAW
    END SUB
    '------------------------------------------------------------------------------
    SUB quick(af AS LONG)
     LOCAL i,j,colore_tmp AS LONG,colore AS STRING
     INCR iter
    'randomizza la posizione iniziale del cilindro
     FOR j=1 TO rulli:CALL muovi(id_cil(j),%id_rullo+j,RND(1,figure)*af):NEXT
     FOR j=1 TO rulli
      GRAPHIC ATTACH hDlg,%id_rullo+j,REDRAW:GRAPHIC GET PIXEL (1,1+af) TO colore_tmp
      colore=colore+CHR$(64+colore_tmp)
     NEXT
     CALL esaminavincite(colore)
    END SUB
    '------------------------------------------------------------------------------
    SUB inizializza
     LOCAL j AS LONG
     GRAPHIC ATTACH hDlg,%id_fondo,REDRAW
     GRAPHIC SET BITS fondo_bmp
     DIM id_bmp(0 TO figure),id_cil(0 TO rulli)
     FOR j=1 TO figure:CALL caricaimmagine($radice+TRIM$(STR$(j))+".bmp",id_tmp):id_bmp(j)=id_tmp:NEXT
     FOR j=1 TO rulli:CALL creacilindro(id_bmp(),figure,id_cil(j)):NEXT
     FOR j=1 TO rulli:CALL muovi(id_cil(j),%id_rullo+j,BYCOPY altezza_finestra):NEXT
     CALL scrivi(%id_info,"Slot Machine ("+STR$(rulli)+" rulli e"+STR$(figure)+" figure)"+STR$(figure^rulli),"times new roman",3,%MAGENTA)
    END SUB
    '------------------------------------------------------------------------------
Working...
X