Petit Jeu YAM's ou Yahtzee

Programmation avancée de jeux en PureBasic
Répondre
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Petit Jeu YAM's ou Yahtzee

Message par kernadec »

bjr à tous
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.


PS; Voici la version 2,1 pour PureBasic 6.30 et supérieur
Mise à jours du code ci-dessous en juillet 2026

je précise que ce code fonctionne sur la version demo de PureBasic 6.40
puisqu'il n'utilise aucun API windows.

Cordialement

Code : Tout sélectionner

; German forum: http://www.purebasic.fr/german/viewtopic.php?t=3249&start=10
; Autheur de procedure DrawCube: NicTheQuick (updated for PB 4.00 by Andre) 
; (YAMS Auteur kernadec  PB 630 et supérieur par kernadec le 25 Juin 2026) 
; Version corrigée pour la selection de Dé avec la souris on/off  la 28 juin 2026
; version 2.1

UsePNGImageDecoder()

EnableExplicit

Enumeration 
  #Window_Des
EndEnumeration

Structure yams
  Num.l
  Tours.l
  Points.l
EndStructure

Global NewList Ranglist.yams()

Global Event, Cube_Size.l, Cube_Points_r.l,Cube_Img.l, Cube_alpha.l
Global numero.l, Lancer.l = 1, Joueur.l, Jco, Jcolor.l, i, u, a.l, n.l, ne.l, ns.l,m$
Global Total, Total$, Total1$, Total2$, Total3$, Score$, result1.l
Global Calcul1$, Calcul2$, Calcul3$, Calcul4$, Calcul5$, Calcul6$ 
Global FtArial,ni,txi,tyi,xt,yt,T$,Cf,Cb,Ht,col,bcol,xb,yb
Global Dim Resultat(6), Dim  Resultat2(6), Dim XPosition(6), Dim Des_Fixe(6)
Global Dim TourJoueur(6), Dim RangJoueur$(6), Dim Filtre(6) 
Global Dim ScoreJoueur(6), Dim ScoreChance(6)

#PB_Image_Transparentx = 255

bcol = RGBA(173,173,173,0)  ; couleur selection boutons

numero = 5   ; Mode 5 Dés
Joueur = 1
Cube_Size = 105 
Cube_Points_r = Cube_Size / 10 

;#################################################################
;Cube_alpha = 0 pour les versions de PureBasic 6.21 et inférieur
Cube_alpha = #PB_Image_Transparentx 
;#################################################################

For i = 0 To 6
  CreateImage(i, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
Next i

Cube_alpha = 30
For i = 21 To 26
  CreateImage(21, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
Next i

Cube_alpha = 0

CreateImage(11, 15, 15, 24 , RGBA(0, 255, 255, 0)); #Cyan) ;
CreateImage(12, 15, 15, 24 , #Red)
CreateImage(13, 15, 15, 24 , #Green)
CreateImage(14, 15, 15, 24 , #Blue) 
CreateImage(15, 15, 15, 24 , #Yellow)
CreateImage(16, 15, 15, 24 , #Magenta)

CreateImage(21, 50, 20, 24 , RGBA(0, 255, 255, 0)); #Cyan) ;
CreateImage(22, 50, 20, 24 , #Red)
CreateImage(23, 50, 20, 24 , #Green)
CreateImage(24, 50, 20, 24 , #Blue) 
CreateImage(25, 50, 20, 24 , #Yellow)
CreateImage(26, 50, 20, 24 , #Magenta)



XPosition(1) =  10
XPosition(2) = 130
XPosition(3) = 250
XPosition(4) = 370
XPosition(5) = 490
XPosition(6) = 610

Procedure carre(col,xb)   ; affiche carre autour du bouton selecte
  StartDrawing(WindowOutput(#Window_Des)) 
  
  LineXY(xb + 7 , 0 + 7 , xb + Cube_Size + 17, 0 + 7 ,col)
  LineXY(xb + 7 , 1 + 7 , xb + Cube_Size + 17, 1 + 7 ,col)
  LineXY(xb + 7 , 2 + 7 , xb + Cube_Size + 17, 2 + 7 ,col)
  LineXY(xb + 7 , 3 + 7 , xb + Cube_Size + 17, 3 + 7 ,col)
  ;ligne bas
  LineXY(xb + 1 + 7, Cube_Size-3 + 18, xb + Cube_Size + 17, Cube_Size-3 + 18,col)
  LineXY(xb + 1 + 7, Cube_Size-2 + 18, xb + Cube_Size + 17, Cube_Size-2 + 18,col)
  LineXY(xb + 1 + 7, Cube_Size-1 + 18, xb + Cube_Size + 17, Cube_Size-1 + 18,col)
  LineXY(xb + 1 + 7, Cube_Size   + 18, xb + Cube_Size + 17, Cube_Size   + 18,col)
  ;ligne gauche
  LineXY(xb + 3 + 7, 7,xb +  3 + 7, Cube_Size + 17 ,col) 
  LineXY(xb + 2 + 7, 7,xb +  2 + 7, Cube_Size + 17 ,col)  
  LineXY(xb + 1 + 7, 7,xb +  1 + 7, Cube_Size + 17 ,col)
  LineXY(xb + 0 + 7, 7,xb +  0 + 7, Cube_Size + 17 ,col)
  ;ligne droite
  LineXY(xb + Cube_Size-3 + 17 , 7,xb + Cube_Size-3 + 17, Cube_Size + 17 ,col)
  LineXY(xb + Cube_Size-2 + 17 , 7,xb + Cube_Size-2 + 17, Cube_Size + 17 ,col)
  LineXY(xb + Cube_Size-1 + 17 , 7,xb + Cube_Size-1 + 17, Cube_Size + 17 ,col)
  LineXY(xb + Cube_Size   + 17 , 7,xb + Cube_Size   + 17, Cube_Size + 17 ,col)
  StopDrawing()
EndProcedure

Procedure ButtonTextColor(ni,txi,tyi,xt,yt,T$,Cf,Cb,Ht)
  If IsImage(ni):FreeImage(ni):EndIf
  If CreateImage(ni, txi, tyi, 32, Cb)
    FtArial = LoadFont(1,"Arial",Ht,#PB_Font_Bold )
    StartDrawing(ImageOutput(ni))
    DrawingFont(FtArial)
    DrawingMode(1)
    DrawText(xt+2,yt-1,T$,RGB(80,80,80),RGBA(80,80,80,#PB_Image_Transparentx))
    DrawText(xt,yt,T$,Cf,Cb)
    DrawingFont(GetStockObject_(#SYSTEM_FONT) )
    StopDrawing()
  EndIf
EndProcedure 

Procedure Col_Joueur(Jco)
  
  If Jco = 1 : Jcolor = RGBA(0, 255, 255, 0)   : EndIf 
  If Jco = 2 : Jcolor = #Red    : EndIf 
  If Jco = 3 : Jcolor = #Green  : EndIf 
  If Jco = 4 : Jcolor = #Blue   : EndIf 
  If Jco = 5 : Jcolor = #Yellow : EndIf 
  If Jco = 6 : Jcolor = #Magenta  : EndIf
  SetWindowColor(#Window_Des, Jcolor)
EndProcedure

Procedure CheckBox_0()
  For i = 1 To 6 : SetGadgetState(20 + i, 0) : Des_Fixe(i) = 0: Next i
  ;For i = 1 To 6 : SetGadgetState(40 + i, 0) : Des_Fixe(i) = 0: Next i
  For i = 1 To 6
    ButtonImageGadget(i, XPosition(i), 10, Cube_Size + 5, Cube_Size + 5, ImageID(0), #PB_Image_Border | #PB_Button_Toggle)
  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 = 11 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(ne)
  StartDrawing(ImageOutput(ne))  
  DrawingMode(0) 
  Box(0, 0, Cube_Size - 1, Cube_Size - 1, RGB(255, 255, 255)) 
  StopDrawing()  
  SetGadgetState(ne, ImageID(ne))
  SetWindowTitle(0," Y A M S 2 " + Space(40) + "JOUEUR  N° " + Str(Joueur))
  SetGadgetText(15, "( Espace )...  Lance " + Str(5) + " Dés") 
  ButtonTextColor(105, 83, 28, -1, 6,"",RGB(255,0,0),RGB(220,220,220),12)
  ButtonImageGadget(105, 263, 146, 83, 28, ImageID(105))
EndProcedure

Procedure Score_des_Joueur_Btitre(ns, Joueur)
  
  If Lancer <= 3
    ; copie Resultat en Resultat2 pour le tri et garde position origine DES dans Resultat
    CopyArray(Resultat(), Resultat2()) 
    
    Total1$ = "" : Total2$ = ""
    For i = 1 To  ns : Total1$ = Total1$ + Str(Resultat2(i)) : Next i ; stock Resultat2 en Total1
    
    SortArray(Resultat2(),#PB_Sort_Ascending  ,1 , ns)
    For i = 1 To  ns : Total2$ = Total2$ + Str(Resultat2(i)) : Next i ; stock Resultat2 tri en Total2
    
    ; recherche des repetitions de chiffres dans Total2 trié en croissance
    Calcul1$ = Str(CountString(Total2$, "1"))
    Calcul2$ = Str(CountString(Total2$, "2"))   
    Calcul3$ = Str(CountString(Total2$, "3"))
    Calcul4$ = Str(CountString(Total2$, "4"))
    Calcul5$ = Str(CountString(Total2$, "5"))
    Calcul6$ = Str(CountString(Total2$, "6"))
    
    ; Total3 = Second Rangement Croissant
    Total3$ = Calcul1$ + Calcul2$ + Calcul3$ + Calcul4$ + Calcul5$ + Calcul6$
    
    ; Recherche des Combinaisons selon les règles du YAMS standard
    If CountString(Total3$, "3")     = #True : Score$ = "Brelan20" : EndIf 
    If CountString(Total3$, "3")     = #True
    If CountString(Total3$, "2")     = #True : Score$ = "Full  25" : EndIf : EndIf
    If CountString(Total3$, "4")     = #True : Score$ = "Carré 30" : EndIf
    If CountString(Total2$, "12345") = #True : Score$ = "Psuit 30" : EndIf
    If CountString(Total2$, "23456") = #True : Score$ = "Gsuit 40" : EndIf
    If CountString(Total3$, "5")     = #True : Score$ = "YAMS  50" : EndIf
    
    
    SetWindowTitle(0," Y A M S 2" + Space(40) + "JOUEUR  N° " + Str(Joueur)+Space(10) + Score$)
    ;
    ButtonTextColor(105, 83, 28, -1, 6,"  "+Score$,RGB(0,225,0),RGBA(220,220,220,#PB_Image_Transparentx),12)
    ButtonImageGadget(105, 263, 146, 83, 28, ImageID(105))
    
  EndIf
  
EndProcedure


Procedure Score_des_Joueur(ns, Joueur)
  
  If Lancer <= 3
    ; copie Resultat en Resultat2 pour le tri et garde position origine DES dans Resultat
    CopyArray(Resultat(), Resultat2()) 
    
    Total1$ = "" : Total2$ = ""
    For i = 1 To  ns : Total1$ = Total1$ + Str(Resultat2(i)) : Next i ; stock Resultat2 en Total1
    
    SortArray(Resultat2(),#PB_Sort_Ascending  ,1 , ns)
    For i = 1 To  ns : Total2$ = Total2$ + Str(Resultat2(i)) : Next i ; stock Resultat2 tri en Total2
    
    ; recherche des repetitions de chiffres dans Total2 trié en croissance
    Calcul1$ = Str(CountString(Total2$, "1"))
    Calcul2$ = Str(CountString(Total2$, "2"))   
    Calcul3$ = Str(CountString(Total2$, "3"))
    Calcul4$ = Str(CountString(Total2$, "4"))
    Calcul5$ = Str(CountString(Total2$, "5"))
    Calcul6$ = Str(CountString(Total2$, "6"))
    
    ; Total3 = Second Rangement Croissant
    Total3$ = Calcul1$ + Calcul2$ + Calcul3$ + Calcul4$ + Calcul5$ + Calcul6$
    
    ; Recherche des Combinaisons selon les règles du YAMS standard
    If CountString(Total3$, "3")     = #True : Score$ = "Brelan20" : EndIf 
    If CountString(Total3$, "3")     = #True
    If CountString(Total3$, "2")     = #True : Score$ = "Full  25" : EndIf : EndIf
    If CountString(Total3$, "4")     = #True : Score$ = "Carré 30" : EndIf
    If CountString(Total2$, "12345") = #True : Score$ = "Psuit 30" : EndIf
    If CountString(Total2$, "23456") = #True : Score$ = "Gsuit 40" : EndIf
    If CountString(Total3$, "5")     = #True : Score$ = "YAMS  50" : EndIf
    
    
    ScoreJoueur(Joueur) = ScoreJoueur(Joueur) + Val(Right(Score$,2))
    ScoreChance(Joueur) = ScoreChance(Joueur) + Total
    TourJoueur(Joueur) = TourJoueur(Joueur) + 1
    
    AddGadgetItem (40, -1," n°"+ Str(Joueur)+Chr(10)+Str(ScoreJoueur(Joueur))+Chr(10)+Score$+Chr(10)+Str(TourJoueur(Joueur))+Chr(10)+Str(ScoreChance(Joueur))+Chr(10)+Total1$,ImageID(Joueur+10)) 
    
    ;Affiche le dernier coup visible avec scoll ascenseur mis en bas
    SetGadgetState(40,CountGadgetItems(40)-1) 
    
    AddElement(Ranglist())
    Ranglist()\Num = Joueur
    Ranglist()\Tours = TourJoueur(Joueur)
    Ranglist()\Points = ScoreJoueur(Joueur) 
    
    SortStructuredList(Ranglist(), #PB_Sort_Descending, OffsetOf(yams\tours), TypeOf(yams\tours))
    SortStructuredList(Ranglist(), #PB_Sort_Descending, OffsetOf(yams\Points), TypeOf(yams\Points))
    
    ClearGadgetItems(42)
    
    For i = 1 To 6          
      Filtre(i) = 1
    Next i 
    
    ForEach  Ranglist()
      If Filtre(Ranglist()\Num) = 1      ; Filtre 
        Filtre(Ranglist()\Num) = 0       ; Filtre pas plus de 6 résultats dans le ListIconGadget()
        AddGadgetItem(42, -1,"" +Ranglist()\Num+Chr(10)+""+Ranglist()\Tours+Chr(10)+""+Ranglist()\Points,ImageID(Ranglist()\Num + 10))  
        Lancer = 4
      EndIf
    Next
    
  EndIf
  If Lancer = 4 
    SetGadgetText(15, " [Joueur suivant]   RESULTAT = " + Score$+"  -->")
    
    Score$ = ""
  EndIf 
  
EndProcedure   

Procedure DrawCube(numero, Nr.l) 
  ;Author Procedure : NicTheQuick
  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)
    Box(0, 0, Cube_Size - 1, Cube_Size - 1, RGB(255, 255, 255)) 
    
    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
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1))
  EndIf
  
  If numero = 2
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero))
    EndIf
    total$ = Str(Resultat(1) + Resultat(2))
  EndIf
  
  If numero = 3
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero))  
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3))
  EndIf
  
  If numero = 4
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1 
      DrawCube(numero, Resultat(numero))  
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4))
  EndIf
  
  If numero = 5
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero))
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5))
  EndIf
  
EndProcedure

Procedure Partie_Lancer(n)
  If Lancer <= 3 
    For i =1 To 5 : If Des_Fixe(i) = 0 : efface_des(i) : EndIf : Next i
    For i = 1 To n : If Des_Fixe(i) = 0 : des(i) : EndIf :  Next i   
    SetWindowTitle(0," Y A M S 2" + Space(40) + "JOUEUR  N° " + Str(Joueur))
    StateMenu(0) : SetMenuItemState(0,5,GetMenuItemState(0,5)!1)
    ; CacheBouton() : HideGadget(15, #False) 
    Total = Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5)
    If Lancer = 1 
      SetGadgetText(15, "[ Espace ]...Résultat du 1er Coup ")
      Score_des_Joueur_Btitre(n, Joueur)
    EndIf
    If Lancer = 2 
      SetGadgetText(15, "[ Espace ]...Résultat du 2ème Coup")
      Score_des_Joueur_Btitre(n, Joueur)
    EndIf
    If Lancer = 3 
      SetGadgetText(15, "[ Espace ]...3ème Coup = RESULTAT")
      Score_des_Joueur_Btitre(n, Joueur)
      Score_des_Joueur(n, Joueur)
    EndIf
    Lancer = Lancer + 1
  EndIf
EndProcedure 


;-- Début Prg

If OpenWindow(#Window_Des, 0, 0, Cube_Size + XPosition(numero) + 15, 285 + Cube_Size, " Y A M S 2" , #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
  
  
  If CreateMenu(0, WindowID(#Window_Des))    
    MenuTitle("N° Joueur")
    MenuItem(11, "Joueur n°1  " + Chr(9) + "/ Key 1")  ;Cyan
    MenuItem(12, "Joueur n°2  " + Chr(9) + "/ Key 2")  ;Rouge
    MenuItem(13, "Joueur n°3  " + Chr(9) + "/ Key 3")  ;Vert 
    MenuItem(14, "Joueur n°4  " + Chr(9) + "/ Key 4")  ;Blue 
    MenuItem(15, "Joueur n°5  " + Chr(9) + "/ Key 5")  ;Jaune
    MenuItem(16, "Joueur n°6  " + Chr(9) + "/ Key 6")  ;violet
    MenuBar()
    MenuItem(17, "Quit")
    MenuTitle( "Cliquer sur les Dés qui doivent conserver leurs valeurs     Pour choisir un joueur > Clavier de 1 à 6"  )
  EndIf
  
  SetMenuItemState(0,5,GetMenuItemState(0,5)!1)
  SetMenuItemState(0,11,GetMenuItemState(0,11)!1)
  
  SetMenuItemBitmaps_(MenuID(0), 11  , #MF_BYCOMMAND, NewMenuIcon(11,RGBA(0, 255, 255, 0))  , 0) 
  SetMenuItemBitmaps_(MenuID(0), 12  , #MF_BYCOMMAND, NewMenuIcon(12,#Red)   , 0) 
  SetMenuItemBitmaps_(MenuID(0), 13  , #MF_BYCOMMAND, NewMenuIcon(13,#Green) , 0) 
  SetMenuItemBitmaps_(MenuID(0), 14  , #MF_BYCOMMAND, NewMenuIcon(14,#Blue)  , 0) 
  SetMenuItemBitmaps_(MenuID(0), 15  , #MF_BYCOMMAND, NewMenuIcon(15,#Yellow), 0) 
  SetMenuItemBitmaps_(MenuID(0), 16  , #MF_BYCOMMAND, NewMenuIcon(16,#Magenta) , 0)
  
  
  ;// Sélection du Joueur
  ButtonTextColor(51, 180, 40, 46, 11,"Joueur n°1",RGB(0,255,255),RGBA(220,220,220,#PB_Image_Transparentx),12)
  ButtonImageGadget(51, 10,333,90,30, ImageID(51),#PB_Button_Toggle)
  
  ButtonTextColor(52, 180, 40, 46,11,"Joueur n°2",RGB(255,0,0),RGBA(220,220,220,#PB_Image_Transparentx),12)
  ButtonImageGadget(52,110,333,90,30, ImageID(52),#PB_Button_Toggle)
  
  ButtonTextColor(53, 180, 40, 46,11,"Joueur n°3",RGB(0,255,0),RGBA(220,220,220,#PB_Image_Transparentx),12)
  ButtonImageGadget(53,210,333,90,30, ImageID(53),#PB_Button_Toggle)
  
  ButtonTextColor(54, 180, 40, 46,11,"Joueur n°4",RGB(0,0,255),RGBA(220,220,220,#PB_Image_Transparentx),12)
  ButtonImageGadget(54,310,333,90,30, ImageID(54),#PB_Button_Toggle)
  
  ButtonTextColor(55, 180, 40, 46,11,"Joueur n°5",RGB(255,255,0),RGBA(220,220,220,#PB_Image_Transparentx),12)
  ButtonImageGadget(55,410,333,90,30, ImageID(55),#PB_Button_Toggle)
  
  ButtonTextColor(56, 180, 40, 46,11,"Joueur n°6",RGB(255,0,255),RGBA(220,220,220,#PB_Image_Transparentx),12)
  ButtonImageGadget(56,510,333,90,30, ImageID(56),#PB_Button_Toggle)
  
  
  ButtonImageGadget(1, XPosition(1), 10, Cube_Size + 5, Cube_Size + 5, ImageID(1), #PB_Image_Border | #PB_Button_Toggle)
  ButtonImageGadget(2, XPosition(2), 10, Cube_Size + 5, Cube_Size + 5, ImageID(2), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(3, XPosition(3), 10, Cube_Size + 5, Cube_Size + 5, ImageID(3), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(4, XPosition(4), 10, Cube_Size + 5, Cube_Size + 5, ImageID(4), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(5, XPosition(5), 10, Cube_Size + 5, Cube_Size + 5, ImageID(5), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(6, XPosition(6), 10, Cube_Size + 5, Cube_Size + 5, ImageID(6), #PB_Image_Border | #PB_Button_Toggle)  
  
  
  ButtonGadget(15, XPosition(1), 145, Cube_Size + 145, 30, "[ Espace ]...  Lance 5 Dés") ; defaut
  
  ButtonGadget(17, 350, 145, Cube_Size + 145, 30, "[ Return ]  =  PASSER et VALIDER LE RESULTAT") 
  
  CheckBoxGadget(21, XPosition(1) + 50 ,  125, 30, 12, "F1") 
  CheckBoxGadget(22, XPosition(2) + 50 ,  125, 30, 12, "F2") 
  CheckBoxGadget(23, XPosition(3) + 50 ,  125, 30, 12, "F3") 
  CheckBoxGadget(24, XPosition(4) + 50 ,  125, 30, 12, "F4") 
  CheckBoxGadget(25, XPosition(5) + 50 ,  125, 30, 12, "F5") 
  CheckBoxGadget(26, XPosition(6) + 50 ,  125, 12, 12, "")   ; non key 
  
  ListIconGadget(40, 10, 180, WindowWidth(#Window_Des) - 169, 145,"Joueur",48,#PB_ListIcon_GridLines)
  AddGadgetColumn(40, 1, " Score  ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 2, " Points ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 3, " Tours ",  (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 4, " Chance ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 5, " Tirage ", (WindowWidth(#Window_Des) - 12) / 8)
  
  ListIconGadget(42, 450, 180, 150, 145, "Joueur", 49, #PB_ListIcon_GridLines) 
  AddGadgetColumn(42, 1, "Tours", 49)
  AddGadgetColumn(42, 2, "Rang", 48)
  
  Col_Joueur(Joueur)
  SetWindowTitle(0," Y A M S 2" + Space(40) + "JOUEUR  N° " + Str(Joueur))
  Joueur = 1
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Escape, 27)  ;  27 = Valeur Touche Escape
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Space, 32)   ;  32 = Valeur Touche Espace
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_1, 101)      ; 1 = Valeur Touche 1
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad1, 111)   ; 1 = Valeur Touche 1
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_2, 102)      ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad2, 112)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_3, 103)      ; 3 = Valeur Touche 3
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad3, 113)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_4, 104)      ; 4 = Valeur Touche 4
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad4, 114)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_5, 105)      ; 5 = Valeur Touche 5
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad5, 115)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_6, 106)      ; 6 = Valeur Touche 6
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad6, 116)   ; 2 = Valeur Touche 2
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F1, 121)       ; 2 = Valeur Touche 121
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F2, 122)       ; 2 = Valeur Touche 122
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F3, 123)       ; 2 = Valeur Touche 123
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F4, 124)       ; 2 = Valeur Touche 124
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F5, 125)       ; 2 = Valeur Touche 125
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Return, 130)   ;  32 = Valeur Touche Espace
  
  Repeat 
    
    Event = WaitWindowEvent() 
    
    Select Event 
        
      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 7 : End
            
          Case 11, 101, 111 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 11,GetMenuItemState(0, 11)!1) : Col_Joueur(1) : Joueur = 1
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 12, 102, 112 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 12,GetMenuItemState(0, 12)!1) : Col_Joueur(2) : Joueur = 2 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 13, 103, 113 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 13,GetMenuItemState(0, 13)!1) : Col_Joueur(3) : Joueur = 3 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 14, 104, 114 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 14,GetMenuItemState(0, 14)!1) : Col_Joueur(4) : Joueur = 4 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 15, 105, 115 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 15,GetMenuItemState(0, 15)!1) : Col_Joueur(5) : Joueur = 5 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 16, 106, 116 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 16,GetMenuItemState(0, 16)!1) : Col_Joueur(6) : Joueur = 6 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1 
            
          Case 21 
            If GetGadgetState(21) = 0 : SetGadgetState(21, 1):   EndIf
            
          Case 17 : End
            
          Case 32 : Partie_Lancer(5)  ;Yams
            
            ; ####################### touche F1 à F5
            Case 121 : If Des_Fixe(1) = 0 : Des_Fixe(1) = 1 : SetGadgetState(21,1) : carre(bcol,0)   : Else : Des_Fixe(1) = 0 : SetGadgetState(21,0) : carre(Jcolor,0)   : EndIf
            
            Case 122 : If Des_Fixe(2) = 0 : Des_Fixe(2) = 1 : SetGadgetState(22,1) : carre(bcol,120) : Else : Des_Fixe(2) = 0 : SetGadgetState(22,0) : carre(Jcolor,120) : EndIf
            
            Case 123 : If Des_Fixe(3) = 0 : Des_Fixe(3) = 1 : SetGadgetState(23,1) : carre(bcol,240) : Else : Des_Fixe(3) = 0 : SetGadgetState(23,0) : carre(Jcolor,240) : EndIf
            
            Case 124 : If Des_Fixe(4) = 0 : Des_Fixe(4) = 1 : SetGadgetState(24,1) : carre(bcol,360) : Else : Des_Fixe(4) = 0 : SetGadgetState(24,0) : carre(Jcolor,360) : EndIf
            
            Case 125 : If Des_Fixe(5) = 0 : Des_Fixe(5) = 1 : SetGadgetState(25,1) : carre(bcol,480) : Else : Des_Fixe(5) = 0 : SetGadgetState(25,0) : carre(Jcolor,480) : EndIf
            
            ;Return Passer Valider
            
            
          Case 130
            
            If Lancer < = 3
              Score_des_Joueur(numero, Joueur)
            EndIf
            Lancer = 4
            
            
            
        EndSelect 
        
      Case #PB_Event_CloseWindow 
        
        Break 
        
      Case #PB_Event_Gadget 
        Select EventGadget() 
            
          Case 15 : Partie_Lancer(5)  ;Yams
            
          Case 17 ; Passe = termine ce tour
            
            If Lancer < = 3
              Score_des_Joueur(numero, Joueur)
            EndIf
            Lancer = 4
            
            
            
          Case 1
            
            If GetGadgetState(1) = 1
              carre(Jcolor,0)
              Des_Fixe(1) = 0
              SetGadgetState(21, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,0)
              Des_Fixe(1) = 1
              SetGadgetState(21, 1) 
            EndIf 
            
          Case 2
            
            If GetGadgetState(2) = 1
              carre(Jcolor,120) 
              Des_Fixe(2) = 0
              SetGadgetState(22, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,120)
              Des_Fixe(2) = 1
              SetGadgetState(22, 1)
            EndIf
            
          Case 3
            
            If GetGadgetState(3) = 1
              carre(Jcolor,240) 
              Des_Fixe(3) = 0
              SetGadgetState(23, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,240)
              Des_Fixe(3) = 1
              SetGadgetState(23, 1)
            EndIf
            
          Case 4
            
            If GetGadgetState(4) = 1
              carre(Jcolor,360) 
              Des_Fixe(4) = 0
              SetGadgetState(24, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,360)
              Des_Fixe(4) = 1
              SetGadgetState(24, 1)
            EndIf
            
          Case 5
            
            If GetGadgetState(5) = 1 
              carre(Jcolor,480) 
              Des_Fixe(5) = 0
              SetGadgetState(25, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,480)
              Des_Fixe(5) = 1
              SetGadgetState(25, 1)
            EndIf
            
            
          Case 21  ;Tests CheckBox
            
            If GetGadgetState(21) = 0 
              carre(Jcolor,0)
              Des_Fixe(1) = 0
              SetGadgetState(21, 0)
              SetGadgetState(1, ImageID(1))
            Else
              carre(bcol,0)
              Des_Fixe(1) = 1
              SetGadgetState(21, 1)
            EndIf 
            
          Case 22
            
            If GetGadgetState(22) = 0
              carre(Jcolor,120)
              Des_Fixe(2) = 0
              SetGadgetState(22, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,120)
              Des_Fixe(2) = 1
              SetGadgetState(22, 1)
            EndIf
            
          Case 23
            
            If GetGadgetState(23) = 0
              carre(Jcolor,240)
              Des_Fixe(3) = 0
              SetGadgetState(23, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,240)
              Des_Fixe(3) = 1
              SetGadgetState(23, 1)
            EndIf
            
          Case 24
            
            If GetGadgetState(24) = 0
              carre(Jcolor,360)
              Des_Fixe(4) = 0
              SetGadgetState(24, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,360)
              Des_Fixe(4) = 1
              SetGadgetState(24, 1)
            EndIf
            
          Case 25
            
            If GetGadgetState(25) = 0 
              carre(Jcolor,480)
              Des_Fixe(5) = 0
              SetGadgetState(25, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              carre(bcol,480)
              Des_Fixe(5) = 1
              SetGadgetState(25, 1)
            EndIf     
            
          Case 51 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 11,GetMenuItemState(0, 11)!1) : Col_Joueur(1) : Joueur = 1
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
            
          Case 52 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 12,GetMenuItemState(0, 12)!1) : Col_Joueur(2) : Joueur = 2 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
            
          Case 53 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 13,GetMenuItemState(0, 13)!1) : Col_Joueur(3) : Joueur = 3 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
            
          Case 54 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 14,GetMenuItemState(0, 14)!1) : Col_Joueur(4) : Joueur = 4 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
            
          Case 55 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 15,GetMenuItemState(0, 15)!1) : Col_Joueur(5) : Joueur = 5 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
            
          Case 56: CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 16,GetMenuItemState(0, 16)!1) : Col_Joueur(6) : Joueur = 6 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1 
            
        EndSelect 
    EndSelect 
    
  ForEver 
  CloseWindow(0)
EndIf
Dernière modification par kernadec le dim. 05/juil./2026 13:29, modifié 15 fois.
Haut
Avatar de l’utilisateur
Ar-S
Messages : 9588
Inscription : dim. 09/oct./2005 16:51
Contact :
Contacter Ar-S

Re: Petits jeux de Dés YAMS Etc..

Message par Ar-S »

Salut,
ça plante des que je lance les dés...

[ERREUR] Ligne: 87
[ERREUR] Erreur de lecture des données: plus de données à lire.
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petits jeux de Dés YAMS Etc..

Message par kernadec »

bjr Ar-S
code mis à jours
Merci du retour, oops , je ne l'avais pas essayé en PB 573 64bits
Les read.l avaient besoin du type de données Data.l
avec PB 573 32bits je n'avait pas eu ce soucis :?
A l'occasion, je mettrais une Listview pour afficher les données
de chaque joueurs pour permettre de visualiser la partie..
Cordialement
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petits jeux de Dés YAMS Etc..

Message par kernadec »

bsr à tous
j'ai revisité mon code pour ajouter un ListIconGadget() les scores pour chaque joueurs jusqu'a 6
à partir de ce code on peut faire pleins de jeux de Dés :mrgreen:
ça amuseras probablement les enfants :mrgreen:
Cordialement

ps: Remis à jour car il y avait une différence dans la taille de fenêtre et des Gadgets entre Seven et XP :?

Code : Tout sélectionner

; German forum: http://www.purebasic.fr/german/viewtopic.php?t=3249&start=10
; Author: NicTheQuick (updated for PB 4.00 by Andre) 
;(YAMS PB 573 kernadec Mai 2021) 
;avec procedure des de NicTheQuickn  
; mode   Y A M S

UsePNGImageDecoder()

EnableExplicit

Enumeration 
  #Window_Des
EndEnumeration

Structure yams
  Num.l
  Tours.l
  Points.l
EndStructure

Global NewList Ranglist.yams()

Global Event, Cube_Size.l, Cube_Points_r.l,Cube_Img.l, Cube_alpha.l
Global numero.l, Lancer.l = 1, Joueur.l, Jco, Jcolor.l, i, u, a.l, n.l, ne.l, ns.l,m$
Global Total, Total$, Total1$, Total2$, Total3$, Score$, result1.l
Global Calcul1$, Calcul2$, Calcul3$, Calcul4$, Calcul5$, Calcul6$ 
Global Dim Resultat(6), Dim  Resultat2(6), Dim XPosition(6), Dim Des_Fixe(6)
Global Dim TourJoueur(6), Dim RangJoueur$(6), Dim Filtre(6) 
Global Dim ScoreJoueur(6), Dim ScoreChance(6)


numero = 5   ; Mode 5 Dés
Joueur = 1
Cube_Size = 105 
Cube_Points_r = Cube_Size / 10 

Cube_alpha = 0  
CreateImage(0, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(1, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(2, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(3, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(4, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha)) 
CreateImage(5, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(6, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))

Cube_alpha = 30
CreateImage(21, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(22, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(23, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(24, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha)) 
CreateImage(25, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
CreateImage(26, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))

Cube_alpha = 0

CreateImage(11, 15, 15, 24 , RGBA(0, 255, 255, 0)); #Cyan) ;
CreateImage(12, 15, 15, 24 , #Red)
CreateImage(13, 15, 15, 24 , #Green)
CreateImage(14, 15, 15, 24 , #Blue) 
CreateImage(15, 15, 15, 24 , #Yellow)
CreateImage(16, 15, 15, 24 , #Magenta)

XPosition(1) =  10
XPosition(2) = 130
XPosition(3) = 250
XPosition(4) = 370
XPosition(5) = 490
XPosition(6) = 610

Procedure Col_Joueur(Jco)
  
  If Jco = 1 : Jcolor = RGBA(0, 255, 255, 0)   : EndIf 
  If Jco = 2 : Jcolor = #Red    : EndIf 
  If Jco = 3 : Jcolor = #Green  : EndIf 
  If Jco = 4 : Jcolor = #Blue   : EndIf 
  If Jco = 5 : Jcolor = #Yellow : EndIf 
  If Jco = 6 : Jcolor = #Magenta  : EndIf
  SetWindowColor(#Window_Des, Jcolor)
EndProcedure

Procedure CheckBox_0()
  For i = 1 To 6 : SetGadgetState(20 + i, 0) : Des_Fixe(i) = 0: Next i
  ;For i = 1 To 6 : SetGadgetState(40 + i, 0) : Des_Fixe(i) = 0: Next i
  For i = 1 To 6
    ButtonImageGadget(i, XPosition(i), 10, Cube_Size + 5, Cube_Size + 5, ImageID(0), #PB_Image_Border | #PB_Button_Toggle)
  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 = 11 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(ne)
  StartDrawing(ImageOutput(ne))  
  DrawingMode(0) 
  Box(0, 0, Cube_Size - 1, Cube_Size - 1, RGB(255, 255, 255)) 
  StopDrawing()  
  SetGadgetState(ne, ImageID(ne))
  SetWindowTitle(0," Y A M S " + Space(40) + "JOUEUR  N° " + Str(Joueur))
  SetGadgetText(15, "( Espace )...  Lance " + Str(5) + " Dés") 
EndProcedure

Procedure Score_des_Joueur(ns, Joueur)
  
  If Lancer <= 3
    ; copie Resultat en Resultat2 pour le tri et garde position origine DES dans Resultat
    CopyArray(Resultat(), Resultat2()) 
    
    Total1$ = "" : Total2$ = ""
    For i = 1 To  ns : Total1$ = Total1$ + Str(Resultat2(i)) : Next i ; stock Resultat2 en Total1
    
    SortArray(Resultat2(),#PB_Sort_Ascending  ,1 , ns)
    For i = 1 To  ns : Total2$ = Total2$ + Str(Resultat2(i)) : Next i ; stock Resultat2 tri en Total2
    
    ; recherche des repetitions de chiffres dans Total2 trié en croissance
    Calcul1$ = Str(CountString(Total2$, "1"))
    Calcul2$ = Str(CountString(Total2$, "2"))   
    Calcul3$ = Str(CountString(Total2$, "3"))
    Calcul4$ = Str(CountString(Total2$, "4"))
    Calcul5$ = Str(CountString(Total2$, "5"))
    Calcul6$ = Str(CountString(Total2$, "6"))
    
    ; Total3 = Second Rangement Croissant
    Total3$ = Calcul1$ + Calcul2$ + Calcul3$ + Calcul4$ + Calcul5$ + Calcul6$
    
    ; Recherche des Combinaisons selon les règles du YAMS standard
    If CountString(Total3$, "3")     = #True : Score$ = "Brelan20" : EndIf 
    If CountString(Total3$, "3")     = #True
    If CountString(Total3$, "2")     = #True : Score$ = "Full  25" : EndIf : EndIf
    If CountString(Total3$, "4")     = #True : Score$ = "Carré 30" : EndIf
    If CountString(Total2$, "12345") = #True : Score$ = "Psuit 30" : EndIf
    If CountString(Total2$, "23456") = #True : Score$ = "Gsuit 40" : EndIf
    If CountString(Total3$, "5")     = #True : Score$ = "YAMS  50" : EndIf
    
    
    ScoreJoueur(Joueur) = ScoreJoueur(Joueur) + Val(Right(Score$,2))
    ScoreChance(Joueur) = ScoreChance(Joueur) + Total
    TourJoueur(Joueur) = TourJoueur(Joueur) + 1
    
    AddGadgetItem (40, -1," n°"+ Str(Joueur)+Chr(10)+Str(ScoreJoueur(Joueur))+Chr(10)+Score$+Chr(10)+Str(TourJoueur(Joueur))+Chr(10)+Str(ScoreChance(Joueur))+Chr(10)+Total1$,ImageID(Joueur+10)) 
    
    ;Affiche le dernier coup visible avec scoll ascenseur mis en bas
    SetGadgetState(40,CountGadgetItems(40)-1) 
    
    AddElement(Ranglist())
    Ranglist()\Num = Joueur
    Ranglist()\Tours = TourJoueur(Joueur)
    Ranglist()\Points = ScoreJoueur(Joueur) 
    
    SortStructuredList(Ranglist(), #PB_Sort_Descending, OffsetOf(yams\tours), TypeOf(yams\tours))
    SortStructuredList(Ranglist(), #PB_Sort_Descending, OffsetOf(yams\Points), TypeOf(yams\Points))
    
    ClearGadgetItems(42)
    
    For i = 1 To 6          
      Filtre(i) = 1
    Next i 
    
    ForEach  Ranglist()
      If Filtre(Ranglist()\Num) = 1      ; Filtre 
        Filtre(Ranglist()\Num) = 0       ; Filtre pas plus de 6 résultats dans le ListIconGadget()
        AddGadgetItem(42, -1,"" +Ranglist()\Num+Chr(10)+""+Ranglist()\Tours+Chr(10)+""+Ranglist()\Points,ImageID(Ranglist()\Num + 10))  
        Lancer = 4
      EndIf
    Next
    
  EndIf
  If Lancer = 4 
    SetGadgetText(15, "RESULTAT")
    
    Score$ = ""
  EndIf 
  
EndProcedure   

Procedure DrawCube(numero, Nr.l) 
  ;Author Procedure : NicTheQuick
  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)
    Box(0, 0, Cube_Size - 1, Cube_Size - 1, RGB(255, 255, 255)) 
    
    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
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1))
  EndIf
  
  If numero = 2
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero))
    EndIf
    total$ = Str(Resultat(1) + Resultat(2))
  EndIf
  
  If numero = 3
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero))  
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3))
  EndIf
  
  If numero = 4
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1 
      DrawCube(numero, Resultat(numero))  
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4))
  EndIf
  
  If numero = 5
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero))
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5))
  EndIf
  
EndProcedure

Procedure Partie_Lancer(n)
  If Lancer <= 3 
    For i =1 To 5 : If Des_Fixe(i) = 0 : efface_des(i) : EndIf : Next i
    For i = 1 To n : If Des_Fixe(i) = 0 : des(i) : EndIf :  Next i   
    SetWindowTitle(0," Y A M S " + Space(40) + "JOUEUR  N° " + Str(Joueur))
    StateMenu(0) : SetMenuItemState(0,5,GetMenuItemState(0,5)!1)
    ; CacheBouton() : HideGadget(15, #False) 
    Total = Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5)
    If Lancer = 1 
      SetGadgetText(15, "( Espace )...Résultat du 1er Coup ")
    EndIf
    If Lancer = 2 
      SetGadgetText(15, "( Espace )...Résultat du 2ème Coup")
    EndIf
    If Lancer = 3 
      SetGadgetText(15, "( Espace )...3ème Coup = RESULTAT")
      Score_des_Joueur(n, Joueur)
    EndIf
    Lancer = Lancer + 1
  EndIf
EndProcedure 


;-- Début Prg

If OpenWindow(#Window_Des, 0, 0, Cube_Size + XPosition(numero) + 15, 250 + Cube_Size, " Y A M S " , #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
  
  If CreateMenu(0, WindowID(#Window_Des))    
    MenuTitle("N° Joueur")
    MenuItem(11, "Joueur n°1  " + Chr(9) + "/ Key 1")  ;Cyan
    MenuItem(12, "Joueur n°2  " + Chr(9) + "/ Key 2")  ;Rouge
    MenuItem(13, "Joueur n°3  " + Chr(9) + "/ Key 3")  ;Vert 
    MenuItem(14, "Joueur n°4  " + Chr(9) + "/ Key 4")  ;Blue 
    MenuItem(15, "Joueur n°5  " + Chr(9) + "/ Key 5")  ;Jaune
    MenuItem(16, "Joueur n°6  " + Chr(9) + "/ Key 6")  ;violet
    MenuBar()
    MenuItem(17, "Quit")
    MenuTitle( "Cliquer sur les Dés qui doivent conserver leurs valeurs     Pour choisir un joueur > Clavier de 1 à 6"  )
  EndIf
  
  SetMenuItemState(0,5,GetMenuItemState(0,5)!1)
  SetMenuItemState(0,11,GetMenuItemState(0,11)!1)
  
  SetMenuItemBitmaps_(MenuID(0), 11  , #MF_BYCOMMAND, NewMenuIcon(11,RGBA(0, 255, 255, 0))  , 0) 
  SetMenuItemBitmaps_(MenuID(0), 12  , #MF_BYCOMMAND, NewMenuIcon(12,#Red)   , 0) 
  SetMenuItemBitmaps_(MenuID(0), 13  , #MF_BYCOMMAND, NewMenuIcon(13,#Green) , 0) 
  SetMenuItemBitmaps_(MenuID(0), 14  , #MF_BYCOMMAND, NewMenuIcon(14,#Blue)  , 0) 
  SetMenuItemBitmaps_(MenuID(0), 15  , #MF_BYCOMMAND, NewMenuIcon(15,#Yellow), 0) 
  SetMenuItemBitmaps_(MenuID(0), 16  , #MF_BYCOMMAND, NewMenuIcon(16,#Magenta) , 0)
  
  
  ButtonImageGadget(1, XPosition(1), 10, Cube_Size + 5, Cube_Size + 5, ImageID(1), #PB_Image_Border | #PB_Button_Toggle)
  ButtonImageGadget(2, XPosition(2), 10, Cube_Size + 5, Cube_Size + 5, ImageID(2), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(3, XPosition(3), 10, Cube_Size + 5, Cube_Size + 5, ImageID(3), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(4, XPosition(4), 10, Cube_Size + 5, Cube_Size + 5, ImageID(4), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(5, XPosition(5), 10, Cube_Size + 5, Cube_Size + 5, ImageID(5), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(6, XPosition(6), 10, Cube_Size + 5, Cube_Size + 5, ImageID(6), #PB_Image_Border | #PB_Button_Toggle)  
  
  ButtonGadget(15, XPosition(1), 145, Cube_Size + 185, 30, "( Espace )...  Lance 5 Dés") ; defaut
  
  ButtonGadget(17, 320, 145, Cube_Size + 175, 30, "( Return )... PASSER  =  VALIDER  LE  RESULTAT") 
  
  CheckBoxGadget(21, XPosition(1) + 50 ,  125, 30, 12, "F1") 
  CheckBoxGadget(22, XPosition(2) + 50 ,  125, 30, 12, "F2") 
  CheckBoxGadget(23, XPosition(3) + 50 ,  125, 30, 12, "F3") 
  CheckBoxGadget(24, XPosition(4) + 50 ,  125, 30, 12, "f4") 
  CheckBoxGadget(25, XPosition(5) + 50 ,  125, 30, 12, "F5") 
  CheckBoxGadget(26, XPosition(6) + 50 ,  125, 12, 12, "")   ; non key 
  
  ListIconGadget(40, 10, 180, WindowWidth(#Window_Des) - 169, 145,"Joueur",48,#PB_ListIcon_GridLines)
  AddGadgetColumn(40, 1, " Score  ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 2, " Points ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 3, " Tours ",  (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 4, " Chance ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 5, " Tirage ", (WindowWidth(#Window_Des) - 12) / 8)
  
  ListIconGadget(42, 450, 180, 150, 145, "Joueur", 49, #PB_ListIcon_GridLines) 
  AddGadgetColumn(42, 1, "Tours", 49)
  AddGadgetColumn(42, 2, "Rang", 48)
  
  Col_Joueur(Joueur)
  SetWindowTitle(0," Y A M S " + Space(40) + "JOUEUR  N° " + Str(Joueur))
  Joueur = 1
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Escape, 27)  ;  27 = Valeur Touche Escape
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Space, 32)   ;  32 = Valeur Touche Espace
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_1, 101)      ; 1 = Valeur Touche 1
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad1, 111)   ; 1 = Valeur Touche 1
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_2, 102)      ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad2, 112)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_3, 103)      ; 3 = Valeur Touche 3
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad3, 113)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_4, 104)      ; 4 = Valeur Touche 4
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad4, 114)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_5, 105)      ; 5 = Valeur Touche 5
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad5, 115)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_6, 106)      ; 6 = Valeur Touche 6
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad6, 116)   ; 2 = Valeur Touche 2
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F1, 121)       ; 2 = Valeur Touche 121
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F2, 122)       ; 2 = Valeur Touche 122
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F3, 123)       ; 2 = Valeur Touche 123
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F4, 124)       ; 2 = Valeur Touche 124
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F5, 125)       ; 2 = Valeur Touche 125
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Return, 130)   ;  32 = Valeur Touche Espace
  
  Repeat 
    
    Event = WaitWindowEvent() 
    
    Select Event 
        
      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 7 : End
            
          Case 11, 101, 111 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 11,GetMenuItemState(0, 11)!1) : Col_Joueur(1) : Joueur = 1
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 12, 102, 112 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 12,GetMenuItemState(0, 12)!1) : Col_Joueur(2) : Joueur = 2 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 13, 103, 113 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 13,GetMenuItemState(0, 13)!1) : Col_Joueur(3) : Joueur = 3 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 14, 104, 114 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 14,GetMenuItemState(0, 14)!1) : Col_Joueur(4) : Joueur = 4 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 15, 105, 115 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 15,GetMenuItemState(0, 15)!1) : Col_Joueur(5) : Joueur = 5 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 16, 106, 116 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 16,GetMenuItemState(0, 16)!1) : Col_Joueur(6) : Joueur = 6 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1 
            
          Case 21 
            If GetGadgetState(21) = 0 : SetGadgetState(21, 1):   EndIf
            
          Case 17 : End
            
          Case 32 : Partie_Lancer(5)  ;Yams
            
            ; ####################### touche F1 à F5
            Case 121 : If Des_Fixe(1) = 0 : Des_Fixe(1) = 1 : SetGadgetState(21,1) : Else : Des_Fixe(1) = 0 : SetGadgetState(21,0) : EndIf
            
            Case 122 : If Des_Fixe(2) = 0 : Des_Fixe(2) = 1 : SetGadgetState(22,1) : Else : Des_Fixe(2) = 0 : SetGadgetState(22,0) : EndIf
            
            Case 123 : If Des_Fixe(3) = 0 : Des_Fixe(3) = 1 : SetGadgetState(23,1) : Else : Des_Fixe(3) = 0 : SetGadgetState(23,0) : EndIf
            
            Case 124 : If Des_Fixe(4) = 0 : Des_Fixe(4) = 1 : SetGadgetState(24,1) : Else : Des_Fixe(4) = 0 : SetGadgetState(24,0) : EndIf
            
            Case 125 : If Des_Fixe(5) = 0 : Des_Fixe(5) = 1 : SetGadgetState(25,1) : Else : Des_Fixe(5) = 0 : SetGadgetState(25,0) : EndIf
            
            ;Return Passer Valider
          Case 130
            
            If Lancer < = 3
              Score_des_Joueur(numero, Joueur)
            EndIf
            Lancer = 4
            
        EndSelect 
        
      Case #PB_Event_CloseWindow 
        
        Break 
        
      Case #PB_Event_Gadget 
        Select EventGadget() 
            
          Case 15 : Partie_Lancer(5)  ;Yams
            
          Case 17 ; Passe = termine ce tour
            
            If Lancer < = 3
              Score_des_Joueur(numero, Joueur)
            EndIf
            Lancer = 4
            
          Case 1
            
            If GetGadgetState(1) = 1 
              Des_Fixe(1) = 0
              SetGadgetState(21, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(1) = 1
              SetGadgetState(21, 1) 
            EndIf 
            
          Case 2
            
            If GetGadgetState(2) = 1
              Des_Fixe(2) = 0
              SetGadgetState(22, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(2) = 1
              SetGadgetState(22, 1)
            EndIf
            
          Case 3
            
            If GetGadgetState(3) = 1
              Des_Fixe(3) = 0
              SetGadgetState(23, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(3) = 1
              SetGadgetState(23, 1)
            EndIf
            
          Case 4
            
            If GetGadgetState(4) = 1
              Des_Fixe(4) = 0
              SetGadgetState(24, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(4) = 1
              SetGadgetState(24, 1)
            EndIf
            
          Case 5
            
            If GetGadgetState(5) = 1 
              Des_Fixe(5) = 0
              SetGadgetState(25, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(5) = 1
              SetGadgetState(25, 1)
            EndIf
            
            
            Select EventType() 
                
              Case 21
                
                If GetGadgetState(21) = 1 
                  Des_Fixe(1) = 0
                  SetGadgetState(21, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(1) = 1
                  SetGadgetState(21, 1) 
                EndIf
                
              Case 22
                
                If GetGadgetState(22) = 1
                  Des_Fixe(2) = 0
                  SetGadgetState(22, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(2) = 1
                  SetGadgetState(22, 1)
                EndIf
                
              Case 23
                
                If GetGadgetState(23) = 1
                  Des_Fixe(3) = 0
                  SetGadgetState(23, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(3) = 1
                  SetGadgetState(23, 1)
                EndIf
                
              Case 24
                
                If GetGadgetState(24) = 1
                  Des_Fixe(4) = 0
                  SetGadgetState(24, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(4) = 1
                  SetGadgetState(24, 1)
                EndIf
                
              Case 25
                
                If GetGadgetState(25) = 1 
                  Des_Fixe(5) = 1
                  SetGadgetState(25, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(5) = 1
                  SetGadgetState(25, 1)
                EndIf     
                
            EndSelect 
        EndSelect 
    EndSelect 
    
  ForEver 
  CloseWindow(0)
EndIf
Dernière modification par kernadec le dim. 28/juin/2026 11:19, modifié 11 fois.
Haut
Marc56
Messages : 2201
Inscription : sam. 08/févr./2014 15:19

Re: Petits jeux de Dés YAMS Etc..

Message par Marc56 »

comment faire pour éviter le doublons dans le ListIconGadget() classement des joueurs..merci
Tu charges les noms dans une map et tu vérifies que AddMapElement() retourne une valeur différente de zéro.
:wink:
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petits jeux de Dés YAMS Etc..

Message par kernadec »

bjr Marc56
j 'ai mis à jour le 2ème code
Autant, je maitrise les newlists avec les listIconGadget() etc.. j' avais jamais rencontré un truc pareil
mais avec les Newmaps, j'ai pas compris comment avoir plusieurs index.
Donc pour le moment, j'explore cette idée, mais avec les tests du YAMS
je commence a saturer les yeux avec ce jeux.

j'ai un tour de passe passe dans le second listIconGadget()
au moment ou j'ai les 6 résultats croissants au deuxième tour très souvent il
me fait disparaitre un résultat et repasse à 5 résultats voir 4 et puis ça revient à 6
le mystère demeure dans la commande SortStructuredArray()
je pense que c 'est elle mon soucis

ps: si tu as un exemple Newmap avec deux index, merci

Cordialement
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petits jeux de Dés YAMS Etc..

Message par kernadec »

bsr à tous
Code précédent mis à jour :wink:
Aujourd'hui Je me suis remis au Yams, car j'en avais fait une overdose :mrgreen:
j'ai réglé tous les problèmes comme j'avais lâché un peu le codage
depuis un moment, alors pas mal de d'astuces avaient été oubliées :?

la seule chose que je n'ai pas définie, c'est de compté le nombre tour
au Yams normalement c'est 13.
Mais on peut visualiser cela dans le ListIconGadget() de droite.
Cordialement
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petit Jeu YAM's ou Yahtzee

Message par kernadec »

bjr à tous
suite aux modification des options de creatImage()
à partir de la version 6.30 de PureBasic

Voici les Nouvelles options de CreateImage()
(Si l'image est en 32 bits, utilisez RGBA() pour obtenir une couleur valide.
Pour les images 32 bits, des constantes spéciales peuvent également être utilisées :
- #PB_Image_Transparent, similaire à RGBA(255,255,255,0),
un fond blanc peut être utilisé pour un anticrénelage clair.
- #PB_Image_TransparentBlack, similaire à RGBA(0,0,0,0),
un fond noir peut être utilisé pour un anticrénelage foncé.)

Code : Tout sélectionner

ligne 37 Cube_alpha = 0 doit passer à 255 pour les versions supérieures àPB 6.21
;ou utiliser la constante spéciale : #PB_Image_Transparent 
ligne 37 Cube_alpha = #PB_Image_Transparent
code mis à jour: pour les versions supérieures a PB 6.21
Cordialement

Code : Tout sélectionner

; German forum: http://www.purebasic.fr/german/viewtopic.php?t=3249&start=10
; Autheur de procedure DrawCube: NicTheQuick (updated for PB 4.00 by Andre) 
;(YAMS Auteur kernadec  PB 630 et supérieur par kernadec le 25 Juin 2026) 
;Version corrigée pour la selection de Dé avec la souris on/off  la 28 juin 2026

UsePNGImageDecoder()

EnableExplicit

Enumeration 
  #Window_Des
EndEnumeration

Structure yams
  Num.l
  Tours.l
  Points.l
EndStructure

Global NewList Ranglist.yams()

Global Event, Cube_Size.l, Cube_Points_r.l,Cube_Img.l, Cube_alpha.l
Global numero.l, Lancer.l = 1, Joueur.l, Jco, Jcolor.l, i, u, a.l, n.l, ne.l, ns.l,m$
Global Total, Total$, Total1$, Total2$, Total3$, Score$, result1.l
Global Calcul1$, Calcul2$, Calcul3$, Calcul4$, Calcul5$, Calcul6$ 
Global Dim Resultat(6), Dim  Resultat2(6), Dim XPosition(6), Dim Des_Fixe(6)
Global Dim TourJoueur(6), Dim RangJoueur$(6), Dim Filtre(6) 
Global Dim ScoreJoueur(6), Dim ScoreChance(6)


numero = 5   ; Mode 5 Dés
Joueur = 1
Cube_Size = 105 
Cube_Points_r = Cube_Size / 10 

;#################################################################
;Cube_alpha = 0 pour les versions de PureBasic 6.21 et inférieur
Cube_alpha = #PB_Image_Transparent 
;#################################################################

For i = 0 To 6
  CreateImage(i, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
Next i

Cube_alpha = 30
For i = 21 To 26
CreateImage(21, Cube_Size, Cube_Size, 32 , RGBA(255, 255, 255, Cube_alpha))
Next i

Cube_alpha = 0

CreateImage(11, 15, 15, 24 , RGBA(0, 255, 255, 0)); #Cyan) ;
CreateImage(12, 15, 15, 24 , #Red)
CreateImage(13, 15, 15, 24 , #Green)
CreateImage(14, 15, 15, 24 , #Blue) 
CreateImage(15, 15, 15, 24 , #Yellow)
CreateImage(16, 15, 15, 24 , #Magenta)

XPosition(1) =  10
XPosition(2) = 130
XPosition(3) = 250
XPosition(4) = 370
XPosition(5) = 490
XPosition(6) = 610

Procedure Col_Joueur(Jco)
  
  If Jco = 1 : Jcolor = RGBA(0, 255, 255, 0)   : EndIf 
  If Jco = 2 : Jcolor = #Red    : EndIf 
  If Jco = 3 : Jcolor = #Green  : EndIf 
  If Jco = 4 : Jcolor = #Blue   : EndIf 
  If Jco = 5 : Jcolor = #Yellow : EndIf 
  If Jco = 6 : Jcolor = #Magenta  : EndIf
  SetWindowColor(#Window_Des, Jcolor)
EndProcedure

Procedure CheckBox_0()
  For i = 1 To 6 : SetGadgetState(20 + i, 0) : Des_Fixe(i) = 0: Next i
  ;For i = 1 To 6 : SetGadgetState(40 + i, 0) : Des_Fixe(i) = 0: Next i
  For i = 1 To 6
    ButtonImageGadget(i, XPosition(i), 10, Cube_Size + 5, Cube_Size + 5, ImageID(0), #PB_Image_Border | #PB_Button_Toggle)
  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 = 11 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(ne)
  StartDrawing(ImageOutput(ne))  
  DrawingMode(0) 
  Box(0, 0, Cube_Size - 1, Cube_Size - 1, RGB(255, 255, 255)) 
  StopDrawing()  
  SetGadgetState(ne, ImageID(ne))
  SetWindowTitle(0," Y A M S " + Space(40) + "JOUEUR  N° " + Str(Joueur))
  SetGadgetText(15, "( Espace )...  Lance " + Str(5) + " Dés") 
EndProcedure

Procedure Score_des_Joueur(ns, Joueur)
  
  If Lancer <= 3
    ; copie Resultat en Resultat2 pour le tri et garde position origine DES dans Resultat
    CopyArray(Resultat(), Resultat2()) 
    
    Total1$ = "" : Total2$ = ""
    For i = 1 To  ns : Total1$ = Total1$ + Str(Resultat2(i)) : Next i ; stock Resultat2 en Total1
    
    SortArray(Resultat2(),#PB_Sort_Ascending  ,1 , ns)
    For i = 1 To  ns : Total2$ = Total2$ + Str(Resultat2(i)) : Next i ; stock Resultat2 tri en Total2
    
    ; recherche des repetitions de chiffres dans Total2 trié en croissance
    Calcul1$ = Str(CountString(Total2$, "1"))
    Calcul2$ = Str(CountString(Total2$, "2"))   
    Calcul3$ = Str(CountString(Total2$, "3"))
    Calcul4$ = Str(CountString(Total2$, "4"))
    Calcul5$ = Str(CountString(Total2$, "5"))
    Calcul6$ = Str(CountString(Total2$, "6"))
    
    ; Total3 = Second Rangement Croissant
    Total3$ = Calcul1$ + Calcul2$ + Calcul3$ + Calcul4$ + Calcul5$ + Calcul6$
    
    ; Recherche des Combinaisons selon les règles du YAMS standard
    If CountString(Total3$, "3")     = #True : Score$ = "Brelan20" : EndIf 
    If CountString(Total3$, "3")     = #True
    If CountString(Total3$, "2")     = #True : Score$ = "Full  25" : EndIf : EndIf
    If CountString(Total3$, "4")     = #True : Score$ = "Carré 30" : EndIf
    If CountString(Total2$, "12345") = #True : Score$ = "Psuit 30" : EndIf
    If CountString(Total2$, "23456") = #True : Score$ = "Gsuit 40" : EndIf
    If CountString(Total3$, "5")     = #True : Score$ = "YAMS  50" : EndIf
    
    
    ScoreJoueur(Joueur) = ScoreJoueur(Joueur) + Val(Right(Score$,2))
    ScoreChance(Joueur) = ScoreChance(Joueur) + Total
    TourJoueur(Joueur) = TourJoueur(Joueur) + 1
    
    AddGadgetItem (40, -1," n°"+ Str(Joueur)+Chr(10)+Str(ScoreJoueur(Joueur))+Chr(10)+Score$+Chr(10)+Str(TourJoueur(Joueur))+Chr(10)+Str(ScoreChance(Joueur))+Chr(10)+Total1$,ImageID(Joueur+10)) 
    
    ;Affiche le dernier coup visible avec scoll ascenseur mis en bas
    SetGadgetState(40,CountGadgetItems(40)-1) 
    
    AddElement(Ranglist())
    Ranglist()\Num = Joueur
    Ranglist()\Tours = TourJoueur(Joueur)
    Ranglist()\Points = ScoreJoueur(Joueur) 
    
    SortStructuredList(Ranglist(), #PB_Sort_Descending, OffsetOf(yams\tours), TypeOf(yams\tours))
    SortStructuredList(Ranglist(), #PB_Sort_Descending, OffsetOf(yams\Points), TypeOf(yams\Points))
    
    ClearGadgetItems(42)
    
    For i = 1 To 6          
      Filtre(i) = 1
    Next i 
    
    ForEach  Ranglist()
      If Filtre(Ranglist()\Num) = 1      ; Filtre 
        Filtre(Ranglist()\Num) = 0       ; Filtre pas plus de 6 résultats dans le ListIconGadget()
        AddGadgetItem(42, -1,"" +Ranglist()\Num+Chr(10)+""+Ranglist()\Tours+Chr(10)+""+Ranglist()\Points,ImageID(Ranglist()\Num + 10))  
        Lancer = 4
      EndIf
    Next
    
  EndIf
  If Lancer = 4 
    SetGadgetText(15, "RESULTAT")
    
    Score$ = ""
  EndIf 
  
EndProcedure   

Procedure DrawCube(numero, Nr.l) 
  ;Author Procedure : NicTheQuick
  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)
    Box(0, 0, Cube_Size - 1, Cube_Size - 1, RGB(255, 255, 255)) 
    
    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
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1))
  EndIf
  
  If numero = 2
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero))
    EndIf
    total$ = Str(Resultat(1) + Resultat(2))
  EndIf
  
  If numero = 3
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero))  
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3))
  EndIf
  
  If numero = 4
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1 
      DrawCube(numero, Resultat(numero))  
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero)) 
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4))
  EndIf
  
  If numero = 5
    If GetGadgetState(20 + numero) = 0
      Resultat(numero) = Random(5) + 1
      DrawCube(numero, Resultat(numero)) 
      ButtonImageGadget(numero, XPosition(numero), 10, Cube_Size + 5, Cube_Size + 5, ImageID(numero), #PB_Image_Border | #PB_Button_Toggle)
      SetGadgetState(numero, ImageID(numero))
    EndIf
    total$ = Str(Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5))
  EndIf
  
EndProcedure

Procedure Partie_Lancer(n)
  If Lancer <= 3 
    For i =1 To 5 : If Des_Fixe(i) = 0 : efface_des(i) : EndIf : Next i
    For i = 1 To n : If Des_Fixe(i) = 0 : des(i) : EndIf :  Next i   
    SetWindowTitle(0," Y A M S " + Space(40) + "JOUEUR  N° " + Str(Joueur))
    StateMenu(0) : SetMenuItemState(0,5,GetMenuItemState(0,5)!1)
    ; CacheBouton() : HideGadget(15, #False) 
    Total = Resultat(1) + Resultat(2) + Resultat(3) + Resultat(4) + Resultat(5)
    If Lancer = 1 
      SetGadgetText(15, "( Espace )...Résultat du 1er Coup ")
    EndIf
    If Lancer = 2 
      SetGadgetText(15, "( Espace )...Résultat du 2ème Coup")
    EndIf
    If Lancer = 3 
      SetGadgetText(15, "( Espace )...3ème Coup = RESULTAT")
      Score_des_Joueur(n, Joueur)
    EndIf
    Lancer = Lancer + 1
  EndIf
EndProcedure 


;-- Début Prg

If OpenWindow(#Window_Des, 0, 0, Cube_Size + XPosition(numero) + 15, 250 + Cube_Size, " Y A M S " , #PB_Window_SystemMenu | #PB_Window_ScreenCentered) 
  
  If CreateMenu(0, WindowID(#Window_Des))    
    MenuTitle("N° Joueur")
    MenuItem(11, "Joueur n°1  " + Chr(9) + "/ Key 1")  ;Cyan
    MenuItem(12, "Joueur n°2  " + Chr(9) + "/ Key 2")  ;Rouge
    MenuItem(13, "Joueur n°3  " + Chr(9) + "/ Key 3")  ;Vert 
    MenuItem(14, "Joueur n°4  " + Chr(9) + "/ Key 4")  ;Blue 
    MenuItem(15, "Joueur n°5  " + Chr(9) + "/ Key 5")  ;Jaune
    MenuItem(16, "Joueur n°6  " + Chr(9) + "/ Key 6")  ;violet
    MenuBar()
    MenuItem(17, "Quit")
    MenuTitle( "Cliquer sur les Dés qui doivent conserver leurs valeurs     Pour choisir un joueur > Clavier de 1 à 6"  )
  EndIf
  
  SetMenuItemState(0,5,GetMenuItemState(0,5)!1)
  SetMenuItemState(0,11,GetMenuItemState(0,11)!1)
  
  SetMenuItemBitmaps_(MenuID(0), 11  , #MF_BYCOMMAND, NewMenuIcon(11,RGBA(0, 255, 255, 0))  , 0) 
  SetMenuItemBitmaps_(MenuID(0), 12  , #MF_BYCOMMAND, NewMenuIcon(12,#Red)   , 0) 
  SetMenuItemBitmaps_(MenuID(0), 13  , #MF_BYCOMMAND, NewMenuIcon(13,#Green) , 0) 
  SetMenuItemBitmaps_(MenuID(0), 14  , #MF_BYCOMMAND, NewMenuIcon(14,#Blue)  , 0) 
  SetMenuItemBitmaps_(MenuID(0), 15  , #MF_BYCOMMAND, NewMenuIcon(15,#Yellow), 0) 
  SetMenuItemBitmaps_(MenuID(0), 16  , #MF_BYCOMMAND, NewMenuIcon(16,#Magenta) , 0)
  
  
  ButtonImageGadget(1, XPosition(1), 10, Cube_Size + 5, Cube_Size + 5, ImageID(1), #PB_Image_Border | #PB_Button_Toggle)
  ButtonImageGadget(2, XPosition(2), 10, Cube_Size + 5, Cube_Size + 5, ImageID(2), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(3, XPosition(3), 10, Cube_Size + 5, Cube_Size + 5, ImageID(3), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(4, XPosition(4), 10, Cube_Size + 5, Cube_Size + 5, ImageID(4), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(5, XPosition(5), 10, Cube_Size + 5, Cube_Size + 5, ImageID(5), #PB_Image_Border | #PB_Button_Toggle) 
  ButtonImageGadget(6, XPosition(6), 10, Cube_Size + 5, Cube_Size + 5, ImageID(6), #PB_Image_Border | #PB_Button_Toggle)  
  
  ButtonGadget(15, XPosition(1), 145, Cube_Size + 185, 30, "( Espace )...  Lance 5 Dés") ; defaut
  
  ButtonGadget(17, 320, 145, Cube_Size + 175, 30, "( Return )... PASSER  =  VALIDER  LE  RESULTAT") 
  
  CheckBoxGadget(21, XPosition(1) + 50 ,  125, 30, 12, "F1") 
  CheckBoxGadget(22, XPosition(2) + 50 ,  125, 30, 12, "F2") 
  CheckBoxGadget(23, XPosition(3) + 50 ,  125, 30, 12, "F3") 
  CheckBoxGadget(24, XPosition(4) + 50 ,  125, 30, 12, "f4") 
  CheckBoxGadget(25, XPosition(5) + 50 ,  125, 30, 12, "F5") 
  CheckBoxGadget(26, XPosition(6) + 50 ,  125, 12, 12, "")   ; non key 
  
  ListIconGadget(40, 10, 180, WindowWidth(#Window_Des) - 169, 145,"Joueur",48,#PB_ListIcon_GridLines)
  AddGadgetColumn(40, 1, " Score  ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 2, " Points ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 3, " Tours ",  (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 4, " Chance ", (WindowWidth(#Window_Des) - 12) / 8)
  AddGadgetColumn(40, 5, " Tirage ", (WindowWidth(#Window_Des) - 12) / 8)
  
  ListIconGadget(42, 450, 180, 150, 145, "Joueur", 49, #PB_ListIcon_GridLines) 
  AddGadgetColumn(42, 1, "Tours", 49)
  AddGadgetColumn(42, 2, "Rang", 48)
  
  Col_Joueur(Joueur)
  SetWindowTitle(0," Y A M S " + Space(40) + "JOUEUR  N° " + Str(Joueur))
  Joueur = 1
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Escape, 27)  ;  27 = Valeur Touche Escape
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Space, 32)   ;  32 = Valeur Touche Espace
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_1, 101)      ; 1 = Valeur Touche 1
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad1, 111)   ; 1 = Valeur Touche 1
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_2, 102)      ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad2, 112)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_3, 103)      ; 3 = Valeur Touche 3
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad3, 113)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_4, 104)      ; 4 = Valeur Touche 4
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad4, 114)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_5, 105)      ; 5 = Valeur Touche 5
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad5, 115)   ; 2 = Valeur Touche 2
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_6, 106)      ; 6 = Valeur Touche 6
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Pad6, 116)   ; 2 = Valeur Touche 2
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F1, 121)       ; 2 = Valeur Touche 121
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F2, 122)       ; 2 = Valeur Touche 122
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F3, 123)       ; 2 = Valeur Touche 123
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F4, 124)       ; 2 = Valeur Touche 124
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_F5, 125)       ; 2 = Valeur Touche 125
  
  AddKeyboardShortcut(#Window_Des, #PB_Shortcut_Return, 130)   ;  32 = Valeur Touche Espace
  
  Repeat 
    
    Event = WaitWindowEvent() 
    
    Select Event 
        
      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 7 : End
            
          Case 11, 101, 111 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 11,GetMenuItemState(0, 11)!1) : Col_Joueur(1) : Joueur = 1
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 12, 102, 112 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 12,GetMenuItemState(0, 12)!1) : Col_Joueur(2) : Joueur = 2 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 13, 103, 113 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 13,GetMenuItemState(0, 13)!1) : Col_Joueur(3) : Joueur = 3 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 14, 104, 114 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 14,GetMenuItemState(0, 14)!1) : Col_Joueur(4) : Joueur = 4 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 15, 105, 115 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 15,GetMenuItemState(0, 15)!1) : Col_Joueur(5) : Joueur = 5 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1
          Case 16, 106, 116 : CheckBox_0() : StateMenu(1) : SetMenuItemState(0, 16,GetMenuItemState(0, 16)!1) : Col_Joueur(6) : Joueur = 6 
            For i = 1 To 6  : efface_des(i) : Next i : Lancer = 1 
            
          Case 21 
            If GetGadgetState(21) = 0 : SetGadgetState(21, 1):   EndIf
            
          Case 17 : End
            
          Case 32 : Partie_Lancer(5)  ;Yams
            
            ; ####################### touche F1 à F5
            Case 121 : If Des_Fixe(1) = 0 : Des_Fixe(1) = 1 : SetGadgetState(21,1) : Else : Des_Fixe(1) = 0 : SetGadgetState(21,0) : EndIf
            
            Case 122 : If Des_Fixe(2) = 0 : Des_Fixe(2) = 1 : SetGadgetState(22,1) : Else : Des_Fixe(2) = 0 : SetGadgetState(22,0) : EndIf
            
            Case 123 : If Des_Fixe(3) = 0 : Des_Fixe(3) = 1 : SetGadgetState(23,1) : Else : Des_Fixe(3) = 0 : SetGadgetState(23,0) : EndIf
            
            Case 124 : If Des_Fixe(4) = 0 : Des_Fixe(4) = 1 : SetGadgetState(24,1) : Else : Des_Fixe(4) = 0 : SetGadgetState(24,0) : EndIf
            
            Case 125 : If Des_Fixe(5) = 0 : Des_Fixe(5) = 1 : SetGadgetState(25,1) : Else : Des_Fixe(5) = 0 : SetGadgetState(25,0) : EndIf
            
            ;Return Passer Valider
          Case 130
            
            If Lancer < = 3
              Score_des_Joueur(numero, Joueur)
            EndIf
            Lancer = 4
            
        EndSelect 
        
      Case #PB_Event_CloseWindow 
        
        Break 
        
      Case #PB_Event_Gadget 
        Select EventGadget() 
            
          Case 15 : Partie_Lancer(5)  ;Yams
            
          Case 17 ; Passe = termine ce tour
            
            If Lancer < = 3
              Score_des_Joueur(numero, Joueur)
            EndIf
            Lancer = 4
            
          Case 1
            
            If GetGadgetState(1) = 1 
              Des_Fixe(1) = 0
              SetGadgetState(21, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(1) = 1
              SetGadgetState(21, 1) 
            EndIf 
            
          Case 2
            
            If GetGadgetState(2) = 1
              Des_Fixe(2) = 0
              SetGadgetState(22, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(2) = 1
              SetGadgetState(22, 1)
            EndIf
            
          Case 3
            
            If GetGadgetState(3) = 1
              Des_Fixe(3) = 0
              SetGadgetState(23, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(3) = 1
              SetGadgetState(23, 1)
            EndIf
            
          Case 4
            
            If GetGadgetState(4) = 1
              Des_Fixe(4) = 0
              SetGadgetState(24, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(4) = 1
              SetGadgetState(24, 1)
            EndIf
            
          Case 5
            
            If GetGadgetState(5) = 1 
              Des_Fixe(5) = 0
              SetGadgetState(25, 0)
              SetGadgetState(1, ImageID(1)) 
            Else
              Des_Fixe(5) = 1
              SetGadgetState(25, 1)
            EndIf
            
            
            Select EventType() 
                
              Case 21
                
                If GetGadgetState(21) = 1 
                  Des_Fixe(1) = 0
                  SetGadgetState(21, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(1) = 1
                  SetGadgetState(21, 1) 
                EndIf
                
              Case 22
                
                If GetGadgetState(22) = 1
                  Des_Fixe(2) = 0
                  SetGadgetState(22, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(2) = 1
                  SetGadgetState(22, 1)
                EndIf
                
              Case 23
                
                If GetGadgetState(23) = 1
                  Des_Fixe(3) = 0
                  SetGadgetState(23, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(3) = 1
                  SetGadgetState(23, 1)
                EndIf
                
              Case 24
                
                If GetGadgetState(24) = 1
                  Des_Fixe(4) = 0
                  SetGadgetState(24, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(4) = 1
                  SetGadgetState(24, 1)
                EndIf
                
              Case 25
                
                If GetGadgetState(25) = 1 
                  Des_Fixe(5) = 0
                  SetGadgetState(25, 0)
                  SetGadgetState(1, ImageID(1)) 
                Else
                  Des_Fixe(5) = 1
                  SetGadgetState(25, 1)
                EndIf     
                
            EndSelect 
        EndSelect 
    EndSelect 
    
  ForEver 
  CloseWindow(0)
EndIf
Dernière modification par kernadec le dim. 28/juin/2026 11:17, modifié 1 fois.
Haut
Avatar de l’utilisateur
venom
Messages : 3221
Inscription : jeu. 29/juil./2004 16:33
Localisation : Klyntar
Contact :
Contacter venom

Re: Petit Jeu YAM's ou Yahtzee

Message par venom »

Bonjour kernadec.

Merci pour la partage de ton travail, même si je n'ai pas encore compilé et que je connais ce jeu que de nom. C'est toujours sympa le partage de ce type de code 8)






@++
Windows 10 x64, PureBasic 6.30 x86 & x64
GPU : radeon HD6370M, CPU : p6200 2.13Ghz
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petit Jeu YAM's ou Yahtzee

Message par kernadec »

bjr venon eh ben merci :D
je suis content que cela te plaise :wink:
en utilisant des icones cartes ca pourrait devenir un poker :idea:
Cordialement
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petit Jeu YAM's ou Yahtzee

Message par kernadec »

bjr à tous
Je n'avais plus utilsé ce jeu depuis un moment
et ce matin en faisant quelques partie de yam's
je me suis apercu d'une erreur discrète.... 8O
qui se manifeste avec la selection souris sur un " dé "
le fait de selecter et déselecter le " dé " avec la souris le checkbox changeait d'état
mais le " dé " rester bloqué dans sa valeur :oops:
Donc une correction à été éffectuée dans la boucle EventGadget()
par une permutation de valeur dans la variable: " Des_Fixe(1) "
ligne 472 Des_Fixe(1) = 0
ligne 476 Des_Fixe(1) = 1
etc... pour les autres tests
le code du post précédent est Corrigé

Cordialement
Haut
Avatar de l’utilisateur
kernadec
Messages : 1623
Inscription : ven. 25/avr./2008 11:14

Re: Petit Jeu YAM's ou Yahtzee

Message par kernadec »

bjr à tous
mise à jour du code Y A M S en version 2
accessible depuis le 1er post
j'ai ajouter des boutons joueurs :idea:
pour un mode souris complet :wink:
Cordialement
Haut
Répondre

Revenir à « Jeux »