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
Collapse
 
  • Page of 1
  • Filter
  • Time
  • Show
Clear All
new posts
Previous template Next
  • #1

    PBWin Slot Machine

    https://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
'------------------------------------------------------------------------------
    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