Voir règles du Yams Yahtzee sur le net ou Wikipédia
A partir d'une procédure dessin d'un "Dés créé par NicTheQuick"
qui se trouve dans les exemples de Code Archive
j'ai ajouté la possibilité d'avoir un nombre de Dés au choix
et jusqu' a 5 dés pour le Yam's avec 3 essais par joueurs.
Cordialement
Code : Tout sélectionner
;(Yams, Yahtzee PB 573 kernadec Mai 2021)
; mode 1,2,3,4,5,6 Dés...
UsePNGImageDecoder()
EnableExplicit
Enumeration
#Window_Des
EndEnumeration
Global EventID.l, Cube_Size.l, Cube_Points_r.l,ndes.l, i, a.l, c.l
Global Cube_Img.l, numero.l = 6, essai = 1, Joueurs.l, Jco.l, total$
Global Dim Resultat(6), Dim XPosition(6)
Cube_Size = 105
Cube_Points_r = Cube_Size / 10
CreateImage(1, Cube_Size, Cube_Size, 24 , $FFFFFF)
CreateImage(2, Cube_Size, Cube_Size, 24 , $FFFFFF)
CreateImage(3, Cube_Size, Cube_Size, 24 , $FFFFFF)
CreateImage(4, Cube_Size, Cube_Size, 24 , $FFFFFF)
CreateImage(5, Cube_Size, Cube_Size, 24 , $FFFFFF)
CreateImage(6, Cube_Size, Cube_Size, 24 , $FFFFFF)
XPosition(1) = 10
XPosition(2) = 130
XPosition(3) = 250
XPosition(4) = 370
XPosition(5) = 490
XPosition(6) = 610
Procedure Col_Joueur(c)
If c = 1 : Jco = #Cyan : EndIf
If c = 2 : Jco = #Red : EndIf
If c = 3 : Jco = #Green : EndIf
If c = 4 : Jco = #Blue : EndIf
If c = 5 : Jco = #Yellow : EndIf
If c = 6 : Jco = #Black : EndIf
SetWindowColor(#Window_Des, Jco)
EndProcedure
Procedure CacheBouton()
For i = 11 To 16 : HideGadget(i, #True) : Next i
EndProcedure
Procedure StateMenu(a)
If a = 0 : For i = 1 To 6 : SetMenuItemState(0,i,0) : Next i : EndIf
If a = 1 : For i = 8 To 16 : SetMenuItemState(0,i,0) : Next i : EndIf
EndProcedure
Procedure NewMenuIcon(Nimg.l,co.l)
CreateImage(Nimg, 16, 16, 32)
StartDrawing(ImageOutput(Nimg))
DrawingMode(#PB_2DDrawing_Default )
Box(0,0,15,15,co)
DrawingMode(#PB_2DDrawing_Outlined )
Box(0,0,16,16,RGBA(127,127,127,255))
StopDrawing()
ProcedureReturn ImageID(Nimg)
EndProcedure
Procedure efface_des(numero)
StartDrawing(ImageOutput(numero))
DrawingMode(0)
Box(0, 0, Cube_Size - 1, Cube_Size - 1, $FFFFFF)
StopDrawing()
SetGadgetState(numero, ImageID(numero))
SetWindowTitle(0,"Lance " + Str(numero) + " Des " + "ESSAI= 0" + "" )
SetGadgetText(10 + numero, "Lance " + Str(numero) + " Dés")
EndProcedure
Procedure DrawCube(numero, Nr.l)
; Procedure cube Autheur: NicTheQuick (updated for PB 4.00 by Andre)
Protected a.l, x.l, y.l, drhx.l, drhy.l
If Nr < 0 And Nr > 6 : ProcedureReturn #False : EndIf
If numero > 0
Restore Cube_Pos
a = Nr * (Nr - 1) / 2
While a : Read.l x : Read.l y : a - 1 : Wend
StartDrawing(ImageOutput(numero))
DrawingMode(0)
RoundBox(0, 0, Cube_Size - 1, Cube_Size - 1, 20, 20, $FFFFFF)
drhx = Random(1)
drhy = Random(1)
For a = 1 To Nr
Read.l x : If drhx : x = 100 - x : EndIf
Read.l y : If drhy : y = 100 - y : EndIf
x = x * Cube_Size / 100
y = y * Cube_Size / 100
Circle(x, y, Cube_Points_r, $000000)
Next
StopDrawing()
ProcedureReturn numero
Else
ProcedureReturn #False
EndIf
DataSection
Cube_Pos:
Data.l 50, 50
Data.l 25, 25, 75, 75
Data.l 25, 25, 50, 50, 75, 75
Data.l 25, 25, 75, 25, 25, 75, 75, 75
Data.l 25, 25, 75, 25, 50, 50, 25, 75, 75, 75
Data.l 25, 25, 75, 25, 25, 50, 75, 50, 25, 75, 75, 75
EndDataSection
EndProcedure
Procedure des(numero)
If numero = 1
ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(numero) + 15, 60 + Cube_Size)
Resultat(1) = Random(5) + 1
total$ = Str(Resultat(1))
DrawCube(numero, Resultat(1))
SetGadgetState(numero, ImageID(numero))
EndIf
If numero = 2
ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(numero) + 15, 60 + Cube_Size)
Resultat(2) = Random(5) + 1
total$ = Str(Resultat(1) + Resultat(2))
DrawCube(numero, Resultat(2))
SetGadgetState(numero, ImageID(numero))
EndIf
If numero = 3
ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(numero) + 15, 60 + Cube_Size)
Resultat(3) = Random(5) + 1
total$ = Str(Resultat(1) + Resultat(2) + Resultat(3))
DrawCube(numero, Resultat(3))
SetGadgetState(numero, ImageID(numero))
EndIf
If numero = 4
ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(numero) + 15, 60 + Cube_Size)
Resultat(4) = Random(5) + 1
total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4))
DrawCube(numero, Resultat(4))
SetGadgetState(numero, ImageID(numero))
EndIf
If numero = 5
ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(numero) + 15, 60 + Cube_Size)
Resultat(5) = Random(5) + 1
total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5))
DrawCube(numero, Resultat(5))
SetGadgetState(numero, ImageID(numero))
EndIf
If numero = 6
ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(numero) + 15, 60 + Cube_Size)
Resultat(6) = Random(5) + 1
total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5) + Resultat(6))
DrawCube(numero, Resultat(6))
SetGadgetState(numero, ImageID(numero))
EndIf
EndProcedure
;-- Début Prg
If OpenWindow(#Window_Des, 0, 0, (Cube_Size + 10) + 615, 60 + Cube_Size, "Lancer de Des" , #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
If CreateMenu(0, WindowID(#Window_Des))
MenuTitle("Edition")
MenuItem(1, "1 Des")
MenuItem(2, "2 Des")
MenuItem(3, "3 Des")
MenuItem(4, "4 Des")
MenuItem(5, "5 Des")
MenuItem(6, "6 Des")
MenuBar()
MenuItem(7, "Quit")
MenuTitle("N° Joueur")
MenuItem(8, "Joueur n°1") ;Blanc
MenuItem(9, "Joueur n°2") ;Rouge
MenuItem(10, "Joueur n°3") ;Vert
MenuItem(11, "Joueur n°4") ;Blue
MenuItem(12, "Joueur n°5") ;Jaune
MenuItem(13, "Joueur n°6") ;Noir
EndIf
SetMenuItemState(0,6,GetMenuItemState(0,6)!1)
SetMenuItemState(0,8,GetMenuItemState(0,8)!1)
SetMenuItemBitmaps_(MenuID(0), 8 , #MF_BYCOMMAND, NewMenuIcon( 8,#Cyan) , 0)
SetMenuItemBitmaps_(MenuID(0), 9 , #MF_BYCOMMAND, NewMenuIcon( 9,#Red) , 0)
SetMenuItemBitmaps_(MenuID(0), 10 , #MF_BYCOMMAND, NewMenuIcon(10,#Green) , 0)
SetMenuItemBitmaps_(MenuID(0), 11 , #MF_BYCOMMAND, NewMenuIcon(11,#Blue) , 0)
SetMenuItemBitmaps_(MenuID(0), 12 , #MF_BYCOMMAND, NewMenuIcon(12,#Yellow), 0)
SetMenuItemBitmaps_(MenuID(0), 13 , #MF_BYCOMMAND, NewMenuIcon(13,#Black) , 0)
ImageGadget(1, XPosition(1), 5, Cube_Size, Cube_Size + 20, ImageID(1), #PB_Image_Border)
ImageGadget(2, XPosition(2), 5, Cube_Size, Cube_Size + 20, ImageID(2), #PB_Image_Border)
ImageGadget(3, XPosition(3), 5, Cube_Size, Cube_Size + 20, ImageID(3), #PB_Image_Border)
ImageGadget(4, XPosition(4), 5, Cube_Size, Cube_Size + 20, ImageID(4), #PB_Image_Border)
ImageGadget(5, XPosition(5), 5, Cube_Size, Cube_Size + 20, ImageID(5), #PB_Image_Border)
ImageGadget(6, XPosition(6), 5, Cube_Size, Cube_Size + 20, ImageID(6), #PB_Image_Border)
ButtonGadget(11, XPosition(1), 120, Cube_Size + 5 , 20, "Lancer 1 Dés") : HideGadget(11, #True)
ButtonGadget(12, XPosition(1), 120, Cube_Size + 5 + 120, 20, "Lancer 2 Dés") : HideGadget(12, #True)
ButtonGadget(13, XPosition(1), 120, Cube_Size + 5 + 240, 20, "Lancer 3 Dés") : HideGadget(13, #True)
ButtonGadget(14, XPosition(1), 120, Cube_Size + 5 + 360, 20, "Lancer 4 Dés") : HideGadget(14, #True)
ButtonGadget(15, XPosition(1), 120, Cube_Size + 5 + 480, 20, "Lancer 5 Dés") : HideGadget(15, #True)
ButtonGadget(16, XPosition(1), 120, Cube_Size + 5 + 600, 20, "Lancer 6 Dés") ; defaut
SetWindowColor(#Window_Des, #Cyan)
SetWindowTitle(0,"Lance " + Str(numero) + " Des " + "ESSAI= 0" + "" )
Repeat
EventID = WaitWindowEvent()
Select EventID
Case #PB_Event_Menu ; Un élément du menu a été sélectionné
Select EventMenu() ; On recupère le numéro de cet élement...
Case 1 : numero = 1 : ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(1) + 15, 60 + Cube_Size)
StateMenu(0) : SetMenuItemState(0,1,GetMenuItemState(0,1)!1) : CacheBouton() : HideGadget(11, #False)
For i =1 To 6 : efface_des(i) : Next i : SetWindowTitle(0," 1 Des = " + "")
Case 2 : numero = 2 : ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(2) + 15, 60 + Cube_Size)
StateMenu(0) : SetMenuItemState(0,2,GetMenuItemState(0,2)!1) : CacheBouton() : HideGadget(12, #False)
For i =1 To 6 : efface_des(i) : Next i : SetWindowTitle(0,"Lancer de 2 Des ...Total = " + "")
Case 3 : numero = 3 : ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(3) + 15, 60 + Cube_Size)
StateMenu(0) : SetMenuItemState(0,3,GetMenuItemState(0,3)!1) : CacheBouton() : HideGadget(13, #False)
For i =1 To 6 : efface_des(i) : Next i : SetWindowTitle(0,"Lancer de 3 Des ...Total = " + "")
Case 4 : numero = 4 : ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(4) + 15, 60 + Cube_Size)
StateMenu(0) : SetMenuItemState(0,4,GetMenuItemState(0,4)!1) : CacheBouton() : HideGadget(14, #False)
For i =1 To 6 : efface_des(i) : Next i : SetWindowTitle(0,"Lancer de 4 Des ...Total = " + "")
Case 5 : numero = 5 : ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(5) + 15, 60 + Cube_Size)
StateMenu(0) : SetMenuItemState(0,5,GetMenuItemState(0,5)!1) : CacheBouton() : HideGadget(15, #False)
For i =1 To 6 : efface_des(i) : Next i : SetWindowTitle(0,"Lancer de 5 Des ...Total = " + "")
Case 6 : numero = 6 : ResizeWindow(#Window_Des, #PB_Ignore, #PB_Ignore, Cube_Size + XPosition(6) + 15, 60 + Cube_Size)
StateMenu(0) : SetMenuItemState(0,6,GetMenuItemState(0,6)!1) : CacheBouton() : HideGadget(16, #False)
For i =1 To 6 : efface_des(i) : Next i : SetWindowTitle(0,"Lancer de 6 Des ...Total = " + "")
Case 7 : End
Case 8 : StateMenu(1) : SetMenuItemState(0, 8,GetMenuItemState(0, 8)!1) : Col_Joueur(1)
For i = 1 To 6 : efface_des(i) : Next i : essai = 1
Case 9 : StateMenu(1) : SetMenuItemState(0, 9,GetMenuItemState(0, 9)!1) : Col_Joueur(2)
For i = 1 To 6 : efface_des(i) : Next i : essai = 1
Case 10 : StateMenu(1) : SetMenuItemState(0,10,GetMenuItemState(0,10)!1) : Col_Joueur(3)
For i = 1 To 6 : efface_des(i) : Next i : essai = 1
Case 11 : StateMenu(1) : SetMenuItemState(0,11,GetMenuItemState(0,11)!1) : Col_Joueur(4)
For i = 1 To 6 : efface_des(i) : Next i : essai = 1
Case 12 : StateMenu(1) : SetMenuItemState(0,12,GetMenuItemState(0,12)!1) : Col_Joueur(5)
For i = 1 To 6 : efface_des(i) : Next i : essai = 1
Case 13 : StateMenu(1) : SetMenuItemState(0,13,GetMenuItemState(0,13)!1) : Col_Joueur(6)
For i = 1 To 6 : efface_des(i) : Next i : essai = 1
EndSelect
Case #PB_Event_CloseWindow
Break
Case #PB_Event_Gadget
Select EventGadget()
Case 11
If essai <= 3
For i =1 To 6 : efface_des(i) : Next i
des(1)
SetWindowTitle(0,"1 Des " + "Es=" + Str(essai) + " =" + total$ )
StateMenu(0) : SetMenuItemState(0,1,GetMenuItemState(0,1)!1)
CacheBouton() : HideGadget(11, #False)
essai = essai + 1
Else
SetGadgetText(11, "3 Essai = Terminé")
EndIf
Case 12
If essai <= 3
For i =1 To 6 : efface_des(i) : Next i
des(1) : des(2)
SetWindowTitle(0,"Lance 2 Des " + "ESSAI=" + Str(essai) + " Total=" + total$ )
StateMenu(0) : SetMenuItemState(0,2,GetMenuItemState(0,2)!1)
CacheBouton() : HideGadget(12, #False)
essai = essai + 1
Else
SetGadgetText(12, "3 Essai = Terminé")
EndIf
Case 13
If essai <= 3
For i =1 To 6 : efface_des(i) : Next i
des(1) : des(2) : des(3)
SetWindowTitle(0,"Lance 3 Des " + "ESSAI=" + Str(essai) + " Total=" + total$ )
StateMenu(0) : SetMenuItemState(0,3,GetMenuItemState(0,3)!1)
CacheBouton() : HideGadget(13, #False)
essai = essai + 1
Else
SetGadgetText(13, "3 Essai = Terminé")
EndIf
Case 14
If essai <= 3
For i =1 To 6 : efface_des(i) : Next i
des(1) : des(2) : des(3) : des(4)
SetWindowTitle(0,"Lance 4 Des " + "ESSAI=" + Str(essai) + " Total=" + total$ )
StateMenu(0) : SetMenuItemState(0,4,GetMenuItemState(0,4)!1)
CacheBouton() : HideGadget(14, #False)
essai = essai + 1
Else
SetGadgetText(14, "3 Essai = Terminé")
EndIf
Case 15
If essai <= 3
For i =1 To 6 : efface_des(i) : Next i
des(1) : des(2) : des(3) : des(4) : des(5)
SetWindowTitle(0,"Lance 5 Des " + "ESSAI=" + Str(essai) + " Total=" + total$ )
StateMenu(0) : SetMenuItemState(0,5,GetMenuItemState(0,5)!1)
CacheBouton() : HideGadget(15, #False)
essai = essai + 1
Else
SetGadgetText(15, "3 Essai = Terminé")
EndIf
Case 16
If essai <= 3
For i =1 To 6 : efface_des(i) : Next i
des(1) : des(2) : des(3) : des(4) : des(5) : des(6)
SetWindowTitle(0,"Lance 6 Des " + "ESSAI=" + Str(essai) + " Total=" + total$ )
StateMenu(0) : SetMenuItemState(0,6,GetMenuItemState(0,6)!1)
CacheBouton() : HideGadget(16, #False)
essai = essai + 1
Else
SetGadgetText(16, "3 Essai = Terminé")
EndIf
EndSelect
EndSelect
ForEver
CloseWindow(0)
EndIf