| Mai 2024 | | Lun | Mar | Mer | Jeu | Ven | Sam | Dim |
|---|
| | | 1 | 2 | 3 | 4 | 5 | | 6 | 7 | 8 | 9 | 10 | 11 | 12 | | 13 | 14 | 15 | 16 | 17 | 18 | 19 | | 20 | 21 | 22 | 23 | 24 | 25 | 26 | | 27 | 28 | 29 | 30 | 31 | | |  Calendrier |
|
| | | Démonstration de CARDS.DLL |  |
|
+3Ouf_ca_passe Klaus papydall 7 participants | |
| Auteur | Message |
|---|
Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Jeu 24 Nov 2016 - 1:44 | |
| Nouvelle version: - chaque pile a maintenant une "image de pile" Celle image de pile est affichée comme un dos de carte normal, en toute première position de la pile. Mais c'est une carte "fictive" qui est non déplaçable et non cliquable, et qui sera recouverte par la première carte "réelle" placée dans la pile. Pour le moment, 6images de pile sont disponibles: une place "vide", une "corbeille à papier" et les As de chaque couleur. D'autres suivront. La fonction CreateMyCardsStack passe du coup de 5 à 6 paramètres, en ajoutant 0 ou 1 comme sixième paramètre. Voici le programme de démo adapté à cela, avec la définition des constantes symboliques pour cela: - Code:
-
' test_MyCards.bas
label creer, supprimer, ramasser, distribuer, event, test
dim PG%, ST1%, ST2%, ST3%, CD%(13,3), CDdos%(11)
dim ncd%(3), fond$
dim res%, i%, k%, n%, s$, xcd%, nom$
dim debug% : debug% = 0
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
full_space 0
dll_on "KGF.dll"
button 1 : top 1,10 : left 1,10 : caption 1,"Créer" : on_click 1,creer
button 2 : top 2,10 : left 2,90 : caption 2,"Supprimer" : on_click 2,supprimer : inactive 2
button 6 : top 6,10 : left 6,410 : caption 6,"Ramasser" : on_click 6,ramasser : inactive 6
button 7 : top 7,10 : left 7,490 : caption 7,"Distribuer" : on_click 7,distribuer : inactive 7
button 8 : top 8,10 : left 8,570 : caption 8,"Test" : on_click 8,test : ' hide 8
open_dialog 97
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : ' hide 99
end
creer:
' créer le terrain de jeu
filter 97,"Fchiers *.BMP |*.bmp"
fond$ = file_name$(97)
if fond$="_"
fond$ = ""
else
if file_exists(fond$)=0 then fond$ = ""
end_if
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(fond$))
if debug%=1 then message "CreateMyCardsPlayground="+hex$(PG%)
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
res% = dll_call3("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
if debug%=1 then message "MyCardsPlaygroundGeometry="+str$(res%)
' créer les 3 piles - une de gauche à droite
' - une empilée les unes sur les autres
' - une à gauche avec cartes détachées
' pile 1:
ST1% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,15,siNone%)
' <========== dans la ligne précédente, essayez scHearts% à la place de scAll% !!!!!
if debug%=1 then message "CreateMyCardsStack="+str$(ST1%)
res% = dll_call3("LocateMyCardsStack",ST1%,10,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
' on ne peut "accrocher" que la dernière carte de stack 1
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
nom$ = "Jeu complet mélangé"
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 2:
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siWaste%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST2%,1100,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
' par défaut, on ne peut pas "accrocher" une carte
' par défaut, on ne peut déposer aucune carte
' pile 3:
ST3% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,85,siNone%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST3%,10,200)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
nom$ = "Dos de cartes"
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropNone%,adr(nom$))
' res% = dll_call6("CreateMyCardsDeckOnStack",ST1%,sClubs%,7,13,1,7)
' message "CreateMyCardsDeckOnStack="+str$(res%)
' créer les 52 cartes et les envoyer dans la pile horizontale
ncd%(1)= 0
for i%=0 to 3
for k%=1 to 13
CD%(k%,i%) = dll_call4("CreateMyCardsCard",PG%,i%,k%,4)
if CD%(k%,i%)=0 then message "oups - carte "+str$(k%)+","+str$(i%)
if CD%(k%,i%)<>0 then ncd%(1) = ncd%(1) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CD%(k%,i%))
res% = dll_call2("MoveMyCardsCardToStack",CD%(k%,i%),ST1%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
next k%
next i%
message str$(ncd%(1))+" cartes ont été créées."
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
' créer les 12 dos de cartes et les envoyer dans l'autre pile horizontale
ncd%(3)= 0
for i%=0 to 11
CDdos%(i%) = dll_call4("CreateMyCardsCard",PG%,0,1,i%)
if CDdos%(i%)=0 then message "oups - dos "+str$(i%)
if CDdos%(i%)<>0 then ncd%(3) = ncd%(3) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CDdos%(i%))
res% = dll_call2("MoveMyCardsCardToStack",CDdos%(i%),ST3%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
res% = dll_call2("ManageMyCardsCard",CDdos%(i%),3) : ' retourner la carte !
next i%
message str$(ncd%(3))+" dos de cartes ont été créées."
inactive 1
active 2
active 6
return
supprimer:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
if debug%=1 then message "DeleteMyCardsPlayground="+str$(PG%)
active 1
inactive 2
inactive 6
inactive 7
return
ramasser:
res% = dll_call2("MoveMyCardsStackToStack",ST1%,ST2%)
ncd%(1) = ncd%(1) - res%
ncd%(2) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(2))+" cartes ont été ramassées."
inactive 6
active 7
return
distribuer:
res% = dll_call2("MoveMyCardsStackToStack",ST2%,ST1%)
ncd%(2) = ncd%(2) - res%
ncd%(1) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(1))+" cartes ont été distribuées."
inactive 7
active 6
return
event:
s$ = trim$(text$(99))
if left$(s$,2)="CC" : ' clic sur carte
message "clic - "+text$(99)
if instr(s$,"Trèfle")>0 : ' carte de trèfle ?
xcd% = hex(mid$(s$,3,8))
res% = dll_call2("ManageMyCardsCard",xcd%,3) : ' retourner la carte !
end_if
end_if
if left$(s$,2)="CP" : ' clic sur terrain de jeu
message "clic - "+text$(99)
end_if
return
test:
return
Actuellement, les piles 1 et 3 ont la "place vide", et la pile 2 la "corbeille". Mais vous pouvez mettre une des couleurs siClub%, siDiamond%, siSpade% ou siHeart% pour voir l'effet de ces 4 as, légèrement ternies. Elles sont en principe prévues pour marquer la place d'une pile recevant les cartes d'une seule couleur, en ordre ascendant. | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Jeu 24 Nov 2016 - 14:06 | |
| Nouvelle version: - lorsqu'on "tire" une carte d'une pile pour la déposer ailleurs, la pile se retasse automatiquement. Démonstration: tirez une des cartes de la pile 1 en haut (cartes découvertes) un une des cartes couvertes en bas. - Code:
-
' test_MyCards.bas
label creer, supprimer, ramasser, distribuer, event, test
dim PG%, ST1%, ST2%, ST3%, CD%(13,3), CDdos%(11)
dim ncd%(3), fond$
dim res%, i%, k%, n%, s$, xcd%, nom$
dim debug% : debug% = 0
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
full_space 0
dll_on "KGF.dll"
button 1 : top 1,10 : left 1,10 : caption 1,"Créer" : on_click 1,creer
button 2 : top 2,10 : left 2,90 : caption 2,"Supprimer" : on_click 2,supprimer : inactive 2
button 6 : top 6,10 : left 6,410 : caption 6,"Ramasser" : on_click 6,ramasser : inactive 6
button 7 : top 7,10 : left 7,490 : caption 7,"Distribuer" : on_click 7,distribuer : inactive 7
button 8 : top 8,10 : left 8,570 : caption 8,"Test" : on_click 8,test : ' hide 8
open_dialog 97
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : ' hide 99
end
creer:
' créer le terrain de jeu
filter 97,"Fchiers *.BMP |*.bmp"
fond$ = file_name$(97)
if fond$="_"
fond$ = ""
else
if file_exists(fond$)=0 then fond$ = ""
end_if
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(fond$))
if debug%=1 then message "CreateMyCardsPlayground="+hex$(PG%)
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
res% = dll_call3("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
if debug%=1 then message "MyCardsPlaygroundGeometry="+str$(res%)
' créer les 3 piles - une de gauche à droite
' - une empilée les unes sur les autres
' - une à gauche avec cartes détachées
' pile 1:
ST1% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,15,siNone%)
' <========== dans la ligne précédente, essayez scHearts% à la place de scAll% !!!!!
if debug%=1 then message "CreateMyCardsStack="+str$(ST1%)
res% = dll_call3("LocateMyCardsStack",ST1%,10,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Jeu complet mélangé"
' première option:
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' seconde option:
' on peut "accrocher"toutes les cartes de stack 1
' peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragAll%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 2:
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siHeart%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST2%,1100,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST2%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 3:
ST3% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,85,siNone%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST3%,10,200)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Dos de cartes"
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropNone%,adr(nom$))
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
' res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropLast%,adr(nom$))
' créer les 52 cartes et les envoyer dans la pile horizontale
ncd%(1)= 0
for i%=0 to 3
for k%=1 to 13
CD%(k%,i%) = dll_call4("CreateMyCardsCard",PG%,i%,k%,4)
if CD%(k%,i%)=0 then message "oups - carte "+str$(k%)+","+str$(i%)
if CD%(k%,i%)<>0 then ncd%(1) = ncd%(1) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CD%(k%,i%))
res% = dll_call2("MoveMyCardsCardToStack",CD%(k%,i%),ST1%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
next k%
next i%
message str$(ncd%(1))+" cartes ont été créées."
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
' créer les 12 dos de cartes et les envoyer dans l'autre pile horizontale
ncd%(3)= 0
for i%=0 to 11
CDdos%(i%) = dll_call4("CreateMyCardsCard",PG%,0,1,i%)
if CDdos%(i%)=0 then message "oups - dos "+str$(i%)
if CDdos%(i%)<>0 then ncd%(3) = ncd%(3) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CDdos%(i%))
res% = dll_call2("MoveMyCardsCardToStack",CDdos%(i%),ST3%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
res% = dll_call2("ManageMyCardsCard",CDdos%(i%),3) : ' retourner la carte !
next i%
message str$(ncd%(3))+" dos de cartes ont été créées."
inactive 1
active 2
active 6
return
supprimer:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
if debug%=1 then message "DeleteMyCardsPlayground="+str$(PG%)
active 1
inactive 2
inactive 6
inactive 7
return
ramasser:
res% = dll_call2("MoveMyCardsStackToStack",ST1%,ST2%)
ncd%(1) = ncd%(1) - res%
ncd%(2) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(2))+" cartes ont été ramassées."
inactive 6
active 7
return
distribuer:
res% = dll_call2("MoveMyCardsStackToStack",ST2%,ST1%)
ncd%(2) = ncd%(2) - res%
ncd%(1) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(1))+" cartes ont été distribuées."
inactive 7
active 6
return
event:
s$ = trim$(text$(99))
if left$(s$,2)="CC" : ' clic sur carte
message "clic - "+text$(99)
if instr(s$,"Trèfle")>0 : ' carte de trèfle ?
xcd% = hex(mid$(s$,3,8))
res% = dll_call2("ManageMyCardsCard",xcd%,3) : ' retourner la carte !
end_if
end_if
if left$(s$,2)="CP" : ' clic sur terrain de jeu
message "clic - "+text$(99)
end_if
return
test:
return
Dernière édition par Klaus le Jeu 24 Nov 2016 - 20:41, édité 1 fois | |
| | | | papydall
Nombre de messages : 7009
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012
| | Sujet: Re: Démonstration de CARDS.DLL Jeu 24 Nov 2016 - 15:51 | |
| Tu as oublié de poster le code  | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Jeu 24 Nov 2016 - 20:42 | |
| Oups... voilà qui est corrigé ! | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Ven 25 Nov 2016 - 2:09 | |
| Nouvelle version: - nouvelle fonction SortMyCardsStack Cette fonction permet de trier une pile selon un critère. Pour le moment, deux critères sont prévus: tri par valeur (les As ensemble, suivis des Deux, suivis des Trois etc), ou par couleur et valeur (de As à Roi d'une couleur, suivi de As à roi de la couleur suivante etc). Ceci peut être défait par la fonction ShuffleMyCardsStack. Dans le programme de démo, la séquence est maintenant la suivante: 1. création initiale des cartes dans l'ordre 2. mélange des cartes par ShuffleMyCardsStack 3. tri des cartes par SortMyCardsStack en triant par valeur 4. tri des cartes par SortMyCardsStack en triant par couleur et valeur 5. mélange des cartes par ShuffleMyCardsStack Là encore, on constate l'extrème rapidité du système. Voici le code: - Code:
-
' test_MyCards.bas
label creer, supprimer, ramasser, distribuer, event, test
dim PG%, ST1%, ST2%, ST3%, CD%(13,3), CDdos%(11)
dim ncd%(3), fond$
dim res%, i%, k%, n%, s$, xcd%, nom$
dim debug% : debug% = 0
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
full_space 0
dll_on "KGF.dll"
button 1 : top 1,10 : left 1,10 : caption 1,"Créer" : on_click 1,creer
button 2 : top 2,10 : left 2,90 : caption 2,"Supprimer" : on_click 2,supprimer : inactive 2
button 6 : top 6,10 : left 6,410 : caption 6,"Ramasser" : on_click 6,ramasser : inactive 6
button 7 : top 7,10 : left 7,490 : caption 7,"Distribuer" : on_click 7,distribuer : inactive 7
button 8 : top 8,10 : left 8,570 : caption 8,"Test" : on_click 8,test : ' hide 8
open_dialog 97
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : ' hide 99
end
creer:
' créer le terrain de jeu
filter 97,"Fchiers *.BMP |*.bmp"
fond$ = file_name$(97)
if fond$="_"
fond$ = ""
else
if file_exists(fond$)=0 then fond$ = ""
end_if
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(fond$))
if debug%=1 then message "CreateMyCardsPlayground="+hex$(PG%)
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
res% = dll_call3("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
if debug%=1 then message "MyCardsPlaygroundGeometry="+str$(res%)
' créer les 3 piles - une de gauche à droite
' - une empilée les unes sur les autres
' - une à gauche avec cartes détachées
' pile 1:
ST1% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,15,siNone%)
' <========== dans la ligne précédente, essayez scHearts% à la place de scAll% !!!!!
if debug%=1 then message "CreateMyCardsStack="+str$(ST1%)
res% = dll_call3("LocateMyCardsStack",ST1%,10,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Jeu complet mélangé"
' première option:
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' seconde option:
' on peut "accrocher"toutes les cartes de stack 1
' peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragAll%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 2:
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siHeart%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST2%,1100,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST2%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 3:
ST3% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,85,siNone%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST3%,10,200)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Dos de cartes"
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropNone%,adr(nom$))
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
' res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropLast%,adr(nom$))
' créer les 52 cartes et les envoyer dans la pile horizontale
ncd%(1)= 0
for i%=0 to 3
for k%=1 to 13
CD%(k%,i%) = dll_call4("CreateMyCardsCard",PG%,i%,k%,4)
if CD%(k%,i%)=0 then message "oups - carte "+str$(k%)+","+str$(i%)
if CD%(k%,i%)<>0 then ncd%(1) = ncd%(1) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CD%(k%,i%))
res% = dll_call2("MoveMyCardsCardToStack",CD%(k%,i%),ST1%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
next k%
next i%
message str$(ncd%(1))+" cartes ont été créées."
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
res% = dll_call2("SortMyCardsStack",ST1%,saByValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par valeur"
res% = dll_call2("SortMyCardsStack",ST1%,saByColorValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par couleur et valeur"
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
' créer les 12 dos de cartes et les envoyer dans l'autre pile horizontale
ncd%(3)= 0
for i%=0 to 11
CDdos%(i%) = dll_call4("CreateMyCardsCard",PG%,0,1,i%)
if CDdos%(i%)=0 then message "oups - dos "+str$(i%)
if CDdos%(i%)<>0 then ncd%(3) = ncd%(3) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CDdos%(i%))
res% = dll_call2("MoveMyCardsCardToStack",CDdos%(i%),ST3%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
res% = dll_call2("ManageMyCardsCard",CDdos%(i%),3) : ' retourner la carte !
next i%
message str$(ncd%(3))+" dos de cartes ont été créées."
inactive 1
active 2
active 6
return
supprimer:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
if debug%=1 then message "DeleteMyCardsPlayground="+str$(PG%)
active 1
inactive 2
inactive 6
inactive 7
return
ramasser:
res% = dll_call2("MoveMyCardsStackToStack",ST1%,ST2%)
ncd%(1) = ncd%(1) - res%
ncd%(2) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(2))+" cartes ont été ramassées."
inactive 6
active 7
return
distribuer:
res% = dll_call2("MoveMyCardsStackToStack",ST2%,ST1%)
ncd%(2) = ncd%(2) - res%
ncd%(1) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(1))+" cartes ont été distribuées."
inactive 7
active 6
return
event:
s$ = trim$(text$(99))
if left$(s$,2)="CC" : ' clic sur carte
message "clic - "+text$(99)
if instr(s$,"Trèfle")>0 : ' carte de trèfle ?
xcd% = hex(mid$(s$,3,8))
res% = dll_call2("ManageMyCardsCard",xcd%,3) : ' retourner la carte !
end_if
end_if
if left$(s$,2)="CP" : ' clic sur terrain de jeu
message "clic - "+text$(99)
end_if
return
test:
return
| |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Ven 25 Nov 2016 - 19:32 | |
| Nouvelle version: - correction de (toutes) les anomalies connues dans la gestion des piles Cette version est plus saine et plus stable. On peut faire glisser des cartes d'une pile à l'autre, d'une pile sur le terrain de jeu et du terrain de jeu sur une pile. On peut utiliser en particulier la pile en haut à droite qui s'appelle "Défausse" (la deucième pile) pour y glisser des cartes de la première, les y empiler, puis de les glisser de la défausse vers le bureau ou à nouveau vers la première pile. Rappelons qu'on ne peut "accrocher" que les cartes sur le bureau qui sont face visible. Ce n'est pas un principe fixe, mais paramétré dans le programme de démo ligne 85, et on peut le changer, bien sûr. Voici la démo adapté à cela: - Code:
-
' test_MyCards.bas
label creer, supprimer, ramasser, distribuer, event, test
dim PG%, ST1%, ST2%, ST3%, CD%(13,3), CDdos%(11)
dim ncd%(3), fond$
dim res%, i%, k%, n%, s$, xcd%, nom$
dim debug% : debug% = 0
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
full_space 0
dll_on "KGF.dll"
button 1 : top 1,10 : left 1,10 : caption 1,"Créer" : on_click 1,creer
button 2 : top 2,10 : left 2,90 : caption 2,"Supprimer" : on_click 2,supprimer : inactive 2
button 6 : top 6,10 : left 6,410 : caption 6,"Ramasser" : on_click 6,ramasser : inactive 6
button 7 : top 7,10 : left 7,490 : caption 7,"Distribuer" : on_click 7,distribuer : inactive 7
button 8 : top 8,10 : left 8,570 : caption 8,"Test" : on_click 8,test : ' hide 8
open_dialog 97
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : ' hide 99
end
creer:
' créer le terrain de jeu
filter 97,"Fchiers *.BMP |*.bmp"
fond$ = file_name$(97)
if fond$="_"
fond$ = ""
else
if file_exists(fond$)=0 then fond$ = ""
end_if
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(fond$))
if debug%=1 then message "CreateMyCardsPlayground="+hex$(PG%)
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
res% = dll_call3("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
if debug%=1 then message "MyCardsPlaygroundGeometry="+str$(res%)
' créer les 3 piles - une de gauche à droite
' - une empilée les unes sur les autres
' - une à gauche avec cartes détachées
' pile 1:
ST1% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,15,siNone%)
' <========== dans la ligne précédente, essayez scHearts% à la place de scAll% !!!!!
if debug%=1 then message "CreateMyCardsStack="+str$(ST1%)
res% = dll_call3("LocateMyCardsStack",ST1%,10,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Jeu complet mélangé"
' première option:
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' seconde option:
' on peut "accrocher"toutes les cartes de stack 1
' peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragAll%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 2:
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siHeart%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST2%,1100,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Défausse"
' première option:
' on ne peut "accrocher" que la dernière carte
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST2%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
if debug%=1 then message "MyCardsCardStackOptions="+str$(res%)
' pile 3:
ST3% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,85,siNone%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST3%,10,200)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Dos de cartes"
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropNone%,adr(nom$))
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
' res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropLast%,adr(nom$))
' créer les 52 cartes et les envoyer dans la pile horizontale
ncd%(1)= 0
for i%=0 to 3
for k%=1 to 13
CD%(k%,i%) = dll_call4("CreateMyCardsCard",PG%,i%,k%,4)
if CD%(k%,i%)=0 then message "oups - carte "+str$(k%)+","+str$(i%)
if CD%(k%,i%)<>0 then ncd%(1) = ncd%(1) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CD%(k%,i%))
res% = dll_call2("MoveMyCardsCardToStack",CD%(k%,i%),ST1%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
next k%
next i%
message str$(ncd%(1))+" cartes ont été créées."
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
res% = dll_call2("SortMyCardsStack",ST1%,saByValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par valeur"
res% = dll_call2("SortMyCardsStack",ST1%,saByColorValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par couleur et valeur"
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
' créer les 12 dos de cartes et les envoyer dans l'autre pile horizontale
ncd%(3)= 0
for i%=0 to 11
CDdos%(i%) = dll_call4("CreateMyCardsCard",PG%,0,1,i%)
if CDdos%(i%)=0 then message "oups - dos "+str$(i%)
if CDdos%(i%)<>0 then ncd%(3) = ncd%(3) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CDdos%(i%))
res% = dll_call2("MoveMyCardsCardToStack",CDdos%(i%),ST3%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
res% = dll_call2("ManageMyCardsCard",CDdos%(i%),3) : ' retourner la carte !
next i%
message str$(ncd%(3))+" dos de cartes ont été créées."
inactive 1
active 2
active 6
return
supprimer:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
if debug%=1 then message "DeleteMyCardsPlayground="+str$(PG%)
active 1
inactive 2
inactive 6
inactive 7
return
ramasser:
res% = dll_call2("MoveMyCardsStackToStack",ST1%,ST2%)
ncd%(1) = ncd%(1) - res%
ncd%(2) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(2))+" cartes ont été ramassées."
inactive 6
active 7
return
distribuer:
res% = dll_call2("MoveMyCardsStackToStack",ST2%,ST1%)
ncd%(2) = ncd%(2) - res%
ncd%(1) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(1))+" cartes ont été distribuées."
inactive 7
active 6
return
event:
s$ = trim$(text$(99))
if left$(s$,2)="CC" : ' clic sur carte
message "clic - "+text$(99)
if instr(s$,"Trèfle")>0 : ' carte de trèfle ?
xcd% = hex(mid$(s$,3,8))
res% = dll_call2("ManageMyCardsCard",xcd%,3) : ' retourner la carte !
end_if
end_if
if left$(s$,2)="CP" : ' clic sur terrain de jeu
message "clic - "+text$(99)
end_if
return
test:
return
ATTENTION:Si l'on veut glisser une carte sur une pile, il faut que le curseur qui accroche la carte soit physiquement au-dessus de la pile ou au-dessus d'une carte appartenant à la pile visée ! Si la carte "mord" un peu sur la pile mais le curseur reste en-dehors, ce sera le terrain de jeu qui sera visé et la carte restera à l'endroit choisi, mais étant affectée au terrain de jeu. Le prochain travail sera d'améliorer le ciblage d'une pile pour éliminer cet inconvénient, et de rendre impossible de déposer une carte affectée au terrain de jeu et recouvrant partiellement une pile. | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Sam 26 Nov 2016 - 0:36 | |
| Nouvelle version: - ajout d'un paramètre extend% à la fonction MyCardsPlaygroundOptions Ce paramètre permet de choisir le mode de reconnaissance d'une pile touchée par une carte lors du glisser/déposer: mode normal: la pile est reconnue lorsque le curseur est au-dessus de la pile mode étendu: la pile est reconnue si au moins 1 des 4 coins de la carte est au-dessus de la pile La doc est modifiée, et contient quelques informations supplémentaires. Téléchargez-la également (WebDav dossier DLLs). Voici le programme de démo adapté, et configuré en mode étendu: - Code:
-
' test_MyCards.bas
label creer, supprimer, ramasser, distribuer, event, test
dim PG%, ST1%, ST2%, ST3%, CD%(13,3), CDdos%(11)
dim ncd%(3), fond$
dim res%, i%, k%, n%, s$, xcd%, nom$
dim debug% : debug% = 0
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
dim poStandard% : poStandard% = 0
dim poExtended% : poExtended% = 1
full_space 0
dll_on "KGF.dll"
button 1 : top 1,10 : left 1,10 : caption 1,"Créer" : on_click 1,creer
button 2 : top 2,10 : left 2,90 : caption 2,"Supprimer" : on_click 2,supprimer : inactive 2
button 6 : top 6,10 : left 6,410 : caption 6,"Ramasser" : on_click 6,ramasser : inactive 6
button 7 : top 7,10 : left 7,490 : caption 7,"Distribuer" : on_click 7,distribuer : inactive 7
button 8 : top 8,10 : left 8,570 : caption 8,"Test" : on_click 8,test : ' hide 8
open_dialog 97
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : ' hide 99
end
creer:
' créer le terrain de jeu
filter 97,"Fchiers *.BMP |*.bmp"
fond$ = file_name$(97)
if fond$="_"
fond$ = ""
else
if file_exists(fond$)=0 then fond$ = ""
end_if
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(fond$))
if debug%=1 then message "CreateMyCardsPlayground="+hex$(PG%)
' première option:
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
' identification de la pile en fonction de la position du curseur
' res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%,poStandard%)
' deuxième option:
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
' identification de la pile en fonction d'un contact avec un des 4 coins de la carte
res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%,poExtended%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
if debug%=1 then message "MyCardsPlaygroundGeometry="+str$(res%)
' créer les 3 piles - une de gauche à droite
' - une empilée les unes sur les autres
' - une à gauche avec cartes détachées
' pile 1:
ST1% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,15,siNone%)
' <========== dans la ligne précédente, essayez scHearts% à la place de scAll% !!!!!
if debug%=1 then message "CreateMyCardsStack="+str$(ST1%)
res% = dll_call3("LocateMyCardsStack",ST1%,10,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Jeu complet mélangé"
' première option:
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' seconde option:
' on peut "accrocher"toutes les cartes de stack 1
' peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragAll%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 2:
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siHeart%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST2%,1100,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Défausse"
' première option:
' on ne peut "accrocher" que la dernière carte
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST2%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
if debug%=1 then message "MyCardsCardStackOptions="+str$(res%)
' pile 3:
ST3% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,85,siNone%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST3%,10,200)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Dos de cartes"
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropNone%,adr(nom$))
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
' res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropLast%,adr(nom$))
' créer les 52 cartes et les envoyer dans la pile horizontale
ncd%(1)= 0
for i%=0 to 3
for k%=1 to 13
CD%(k%,i%) = dll_call4("CreateMyCardsCard",PG%,i%,k%,4)
if CD%(k%,i%)=0 then message "oups - carte "+str$(k%)+","+str$(i%)
if CD%(k%,i%)<>0 then ncd%(1) = ncd%(1) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CD%(k%,i%))
res% = dll_call2("MoveMyCardsCardToStack",CD%(k%,i%),ST1%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
next k%
next i%
message str$(ncd%(1))+" cartes ont été créées."
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
res% = dll_call2("SortMyCardsStack",ST1%,saByValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par valeur"
res% = dll_call2("SortMyCardsStack",ST1%,saByColorValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par couleur et valeur"
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
' créer les 12 dos de cartes et les envoyer dans l'autre pile horizontale
ncd%(3)= 0
for i%=0 to 11
CDdos%(i%) = dll_call4("CreateMyCardsCard",PG%,0,1,i%)
if CDdos%(i%)=0 then message "oups - dos "+str$(i%)
if CDdos%(i%)<>0 then ncd%(3) = ncd%(3) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CDdos%(i%))
res% = dll_call2("MoveMyCardsCardToStack",CDdos%(i%),ST3%)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
res% = dll_call2("ManageMyCardsCard",CDdos%(i%),3) : ' retourner la carte !
next i%
message str$(ncd%(3))+" dos de cartes ont été créées."
inactive 1
active 2
active 6
return
supprimer:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
if debug%=1 then message "DeleteMyCardsPlayground="+str$(PG%)
active 1
inactive 2
inactive 6
inactive 7
return
ramasser:
res% = dll_call2("MoveMyCardsStackToStack",ST1%,ST2%)
ncd%(1) = ncd%(1) - res%
ncd%(2) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(2))+" cartes ont été ramassées."
inactive 6
active 7
return
distribuer:
res% = dll_call2("MoveMyCardsStackToStack",ST2%,ST1%)
ncd%(2) = ncd%(2) - res%
ncd%(1) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(1))+" cartes ont été distribuées."
inactive 7
active 6
return
event:
s$ = trim$(text$(99))
if left$(s$,2)="CC" : ' clic sur carte
message "clic - "+text$(99)
if instr(s$,"Trèfle")>0 : ' carte de trèfle ?
xcd% = hex(mid$(s$,3,8))
res% = dll_call2("ManageMyCardsCard",xcd%,3) : ' retourner la carte !
end_if
end_if
if left$(s$,2)="CP" : ' clic sur terrain de jeu
message "clic - "+text$(99)
end_if
if left$(s$,2)="CS" : ' clic sur une partie noon utilisée d'une pile
message "clic - "+text$(99)
end_if
return
test:
return
Le prochain travail sera de rendre impossible de déposer une carte affectée au terrain de jeu et recouvrant partiellement une pile. Actuellement, en mode normal, la carte sera acceptée et positionnée dans le terrain de jeu, même si elle recouvre la pile. En mode étendu, si la pile accepte la carte, elle sera intégrée et prendra sa place automatiquement. En mode étendue, si la carte est rejetée, elle retournera automatiquement à sa place initiale. | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Sam 26 Nov 2016 - 2:42 | |
| Voici un début d'application dans un jeu réel: la bataille. Pour le moment, le programme ne fait rien de passionnant - il prépare simplement le terrain de jeu et les piles nécessaires, neanmoins avec toutes les options requises. Prochaine étape: distribution initiale des cartes. - Code:
-
' Bataille.bas
' Ce programme est une première version du jeu de bataille.
' Le joueur joue contre l'ordinateur.
' Les règles (origine: Wikipedia):
' On distribue l'ensemble d'un (ou plusieurs) jeu de cartes (54 ou 32) aux joueurs,
' qui n'en prennent pas connaissance. À chaque tour, chaque joueur retourne la carte
' du haut de sa main (ou son tas). Celui qui a la carte de la plus haute valeur -
' selon la hiérarchie du bridge : As, Roi, Dame, Valet, dix… jusqu'au deux - fait
' la levée, qu'il place sous son tas.
' En cas d'égalité de valeurs - cas appelé bataille - les joueurs en ballotage
' disent « bataille ! », et commencent par placer une première carte face cachée
' puis une seconde carte face visible pour décider qui fera la levée.
' En cas de nouvelle égalité, la procédure est répétée. La bataille est
' parfois l'occasion d'acquérir une grosse carte et c'est l'unique manière
' de gagner un as. Sans bataille et à moins qu'un joueur ne possède tous les as,
' il serait impossible de terminer une partie de bataille. La partie se termine
' et le gagnant est déterminé lorsque ce dernier a en sa possession toutes les
' cartes du jeu.
' Technique:
' le programme prépare un terrain de jeu, avec 4 piles:
' pile 1: tas du joueur - pile non triée, face cachée
' pile 2: enjeu du joueur : pile non triée, face cachée et ouverte, cartes non glissables
' pile 3: tas du programme - pile non triée, face cachée, cartes non glissables
' pile 4: enjeu du programme : pile non triée, face cachée et ouverte, cartes non glissables
label event, close0
full_space 0 : caption 0,"Jeu de Bataille" : on_close 0,close0
dll_on "KGF.dll"
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
dim poStandard% : poStandard% = 0
dim poExtended% : poExtended% = 1
dim ImageDeFond$ : ImageDeFond$ = ""
dim PG%, ST1%, ST2%, ST3%, ST4%
dim res%, nom$
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : hide 99
' *********************** terrain de jeu
' création du terrain de jeu
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(ImageDeFond$))
' on ne peut "accrocher" aucune carte dans le terrain de jeu
' on ne peut déposer nulle part
' identification de la pile en fonction d'un contact avec un des 4 coins de la carte
res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragNone%,dropNone%,poExtended%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
' *********************** pile 1: tas du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST1% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en bas au milieu
res% = dll_call3("LocateMyCardsStack",ST1%,600,500)
nom$ = "Tas du joueur"
' on ne peut "accrocher" que la dernière carte de la pile 1
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,dropNone%,adr(nom$))
' *********************** pile 2: enjeu du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile au-dessus de la pile 1
res% = dll_call3("LocateMyCardsStack",ST2%,600,400)
nom$ = "Enjeu du joueur"
' on ne peut "accrocher" aucune carte de la pile 2
' les cartes déposées se placent automatiquement sur le dessus de la pile (à la fin)
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropLast%,adr(nom$))
' *********************** pile 3: tas du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST3% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en haut au milieu
res% = dll_call3("LocateMyCardsStack",ST3%,600,100)
nom$ = "Tas du programme"
' on ne peut "accrocher" aucune carte de la pile 1
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropNone%,adr(nom$))
' *********************** pile 4: enjeu du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST4% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en-dessous de la pile 3
res% = dll_call3("LocateMyCardsStack",ST4%,600,200)
nom$ = "Enjeu du programme"
' on ne peut "accrocher" aucune carte de la pile 2
' on ne peut déposer aucune carte sur cette pile
res% = dll_call4("MyCardsCardStackOptions",ST4%,dragNone%,dropNone%,adr(nom$))
end
close0:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
return
event:
return
| |
| | | | papydall
Nombre de messages : 7009
Age : 73
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012
| | Sujet: Re: Démonstration de CARDS.DLL Sam 26 Nov 2016 - 5:02 | |
| Beau travail, merci Klaus et bonne continuation. | |
| | | | Minibug
Nombre de messages : 4566
Age : 57
Localisation : Vienne (86)
Date d'inscription : 09/02/2012
| | Sujet: Re: Démonstration de CARDS.DLL Sam 26 Nov 2016 - 11:43 | |
| J'ai hâte de voir la suite...  | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Sam 26 Nov 2016 - 11:57 | |
| La suite ? La voilà: Nouvelle version: - légères modifications dans certaines fonctions - ajout de paramètres à MoveMyCardsStackToStack ("effacer avant l'action" et "ajouter à la fin ou au début de la pile") - correction de quelques anomalies La doc a été modifiée et complétée. Voici le programme de démo (sans nouveautés, mais adapté aux nouvelles exigences des paramètres des fonctions): - Code:
-
' test_MyCards.bas
label creer, supprimer, ramasser, distribuer, event, test
dim PG%, ST1%, ST2%, ST3%, CD%(13,3), CDdos%(11)
dim ncd%(3), fond$
dim res%, i%, k%, n%, s$, xcd%, nom$
dim debug% : debug% = 0
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
dim poStandard% : poStandard% = 0
dim poExtended% : poExtended% = 1
full_space 0
dll_on "KGF.dll"
button 1 : top 1,10 : left 1,10 : caption 1,"Créer" : on_click 1,creer
button 2 : top 2,10 : left 2,90 : caption 2,"Supprimer" : on_click 2,supprimer : inactive 2
button 6 : top 6,10 : left 6,410 : caption 6,"Ramasser" : on_click 6,ramasser : inactive 6
button 7 : top 7,10 : left 7,490 : caption 7,"Distribuer" : on_click 7,distribuer : inactive 7
button 8 : top 8,10 : left 8,570 : caption 8,"Test" : on_click 8,test : ' hide 8
open_dialog 97
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : ' hide 99
end
creer:
' créer le terrain de jeu
filter 97,"Fchiers *.BMP |*.bmp"
fond$ = file_name$(97)
if fond$="_"
fond$ = ""
else
if file_exists(fond$)=0 then fond$ = ""
end_if
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(fond$))
if debug%=1 then message "CreateMyCardsPlayground="+hex$(PG%)
' première option:
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
' identification de la pile en fonction de la position du curseur
' res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%,poStandard%)
' deuxième option:
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
' identification de la pile en fonction d'un contact avec un des 4 coins de la carte
res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%,poExtended%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
if debug%=1 then message "MyCardsPlaygroundGeometry="+str$(res%)
' créer les 3 piles - une de gauche à droite
' - une empilée les unes sur les autres
' - une à gauche avec cartes détachées
' pile 1:
ST1% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,15,siNone%)
' <========== dans la ligne précédente, essayez scHearts% à la place de scAll% !!!!!
if debug%=1 then message "CreateMyCardsStack="+str$(ST1%)
res% = dll_call3("LocateMyCardsStack",ST1%,10,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Jeu complet mélangé"
' première option:
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' seconde option:
' on peut "accrocher"toutes les cartes de stack 1
' peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragAll%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 2:
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siHeart%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST2%,1100,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Défausse"
' première option:
' on ne peut "accrocher" que la dernière carte
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST2%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
if debug%=1 then message "MyCardsCardStackOptions="+str$(res%)
' pile 3:
ST3% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,85,siNone%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST3%,10,200)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Dos de cartes"
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropNone%,adr(nom$))
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
' res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropLast%,adr(nom$))
' créer les 52 cartes et les envoyer dans la pile horizontale
ncd%(1)= 0
for i%=0 to 3
for k%=1 to 13
CD%(k%,i%) = dll_call4("CreateMyCardsCard",PG%,i%,k%,4)
if CD%(k%,i%)=0 then message "oups - carte "+str$(k%)+","+str$(i%)
if CD%(k%,i%)<>0 then ncd%(1) = ncd%(1) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CD%(k%,i%))
res% = dll_call3("MoveMyCardsCardToStack",CD%(k%,i%),ST1%,0)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
next k%
next i%
message str$(ncd%(1))+" cartes ont été créées."
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
res% = dll_call2("SortMyCardsStack",ST1%,saByValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par valeur"
res% = dll_call2("SortMyCardsStack",ST1%,saByColorValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par couleur et valeur"
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
' créer les 12 dos de cartes et les envoyer dans l'autre pile horizontale
ncd%(3)= 0
for i%=0 to 11
CDdos%(i%) = dll_call4("CreateMyCardsCard",PG%,0,1,i%)
if CDdos%(i%)=0 then message "oups - dos "+str$(i%)
if CDdos%(i%)<>0 then ncd%(3) = ncd%(3) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CDdos%(i%))
res% = dll_call3("MoveMyCardsCardToStack",CDdos%(i%),ST3%,0)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
res% = dll_call2("ManageMyCardsCard",CDdos%(i%),3) : ' retourner la carte !
next i%
message str$(ncd%(3))+" dos de cartes ont été créées."
inactive 1
active 2
active 6
return
supprimer:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
if debug%=1 then message "DeleteMyCardsPlayground="+str$(PG%)
active 1
inactive 2
inactive 6
inactive 7
return
ramasser:
res% = dll_call4("MoveMyCardsStackToStack",ST1%,ST2%,1,0)
ncd%(1) = ncd%(1) - res%
ncd%(2) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(2))+" cartes ont été ramassées."
inactive 6
active 7
return
distribuer:
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST1%,1,0)
ncd%(2) = ncd%(2) - res%
ncd%(1) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(1))+" cartes ont été distribuées."
inactive 7
active 6
return
event:
s$ = trim$(text$(99))
if left$(s$,2)="CC" : ' clic sur carte
message "clic - "+text$(99)
if instr(s$,"Trèfle")>0 : ' carte de trèfle ?
xcd% = hex(mid$(s$,3,8))
res% = dll_call2("ManageMyCardsCard",xcd%,3) : ' retourner la carte !
end_if
end_if
if left$(s$,2)="CP" : ' clic sur terrain de jeu
message "clic - "+text$(99)
end_if
if left$(s$,2)="CS" : ' clic sur une partie noon utilisée d'une pile
message "clic - "+text$(99)
end_if
return
test:
return
Et voici la suite de la "Bataille": - le programme rest restructuré de façon plus rigoureuse - les cartes sont déposées dans un talon à gauche du terrain de jeu - en-dessous de chaque pile, un compteur de cartes apparaît - des boutons d'action sont disponibles - bouton actif "Distribuer" = distribue les cartes du talon vers les tas du joueur et du programme - bouton actif "Ramasser" = ramasse toutes les cartes, les remet dans le talon et rebat les cartes Les autres boutons ne sont pas encore actifs. Voici le code: - Code:
-
' Bataille.bas
' Ce programme est une première version du jeu de bataille.
' Le joueur joue contre l'ordinateur.
' Les règles (origine: Wikipedia):
' On distribue l'ensemble d'un (ou plusieurs) jeu de cartes (54 ou 32) aux joueurs,
' qui n'en prennent pas connaissance. À chaque tour, chaque joueur retourne la carte
' du haut de sa main (ou son tas). Celui qui a la carte de la plus haute valeur -
' selon la hiérarchie du bridge : As, Roi, Dame, Valet, dix… jusqu'au deux - fait
' la levée, qu'il place sous son tas.
' En cas d'égalité de valeurs - cas appelé bataille - les joueurs en ballotage
' disent « bataille ! », et commencent par placer une première carte face cachée
' puis une seconde carte face visible pour décider qui fera la levée.
' En cas de nouvelle égalité, la procédure est répétée. La bataille est
' parfois l'occasion d'acquérir une grosse carte et c'est l'unique manière
' de gagner un as. Sans bataille et à moins qu'un joueur ne possède tous les as,
' il serait impossible de terminer une partie de bataille. La partie se termine
' et le gagnant est déterminé lorsque ce dernier a en sa possession toutes les
' cartes du jeu.
' Technique:
' le programme prépare un terrain de jeu, avec 5 piles:
' pile 1: tas du joueur - pile non triée, face cachée
' pile 2: enjeu du joueur : pile non triée, face cachée et ouverte, cartes non glissables
' pile 3: tas du programme - pile non triée, face cachée, cartes non glissables
' pile 4: enjeu du programme : pile non triée, face cachée et ouverte, cartes non glissables
' pile 5: talon initial pour dustribuer les cartes, puis outil technique pour des manipulations
label event, close0, jouer, bataille, distribuer, ramasser
full_space 0 : caption 0,"Jeu de Bataille" : on_close 0,close0
dll_on "KGF.dll"
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
dim poStandard% : poStandard% = 0
dim poExtended% : poExtended% = 1
dim ImageDeFond$ : ImageDeFond$ = ""
dim PG%, ST1%, ST2%, ST3%, ST4%, ST5%, CD%(52), hPG%
dim res%, nom$, n%, couleur%
creer_objets_speciaux()
creer_terrain()
creer_objets_visuels()
creer_tas_joueur()
creer_enjeu_joueur()
creer_tas_programme()
creer_enjeu_programme()
creer_talon()
creer_jeu_52_cartes()
end
close0:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
return
event:
return
jouer:
return
bataille:
return
distribuer:
distribuer_les_cartes()
return
ramasser:
ramasser_les_cartes()
return
sub creer_terrain()
' *********************** terrain de jeu
' création du terrain de jeu
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(ImageDeFond$))
' on ne peut "accrocher" aucune carte dans le terrain de jeu
' on ne peut déposer nulle part
' identification de la pile en fonction d'un contact avec un des 4 coins de la carte
res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragNone%,dropNone%,poExtended%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
' récupérer le handle du terrain de jeu
hPG% = dll_call3("GetMyCardsInfo",PG%,5,0)
end_sub
sub creer_tas_joueur()
' *********************** pile 1: tas du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST1% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en bas au milieu
res% = dll_call3("LocateMyCardsStack",ST1%,600,500)
nom$ = "Tas du joueur"
' on ne peut "accrocher" que la dernière carte de la pile 1
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,dropNone%,adr(nom$))
end_sub
sub creer_enjeu_joueur()
' *********************** pile 2: enjeu du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile au-dessus de la pile 1
res% = dll_call3("LocateMyCardsStack",ST2%,600,350)
nom$ = "Enjeu du joueur"
' on ne peut "accrocher" aucune carte de la pile 2
' les cartes déposées se placent automatiquement sur le dessus de la pile (à la fin)
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropLast%,adr(nom$))
end_sub
sub creer_tas_programme()
' *********************** pile 3: tas du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST3% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en haut au milieu
res% = dll_call3("LocateMyCardsStack",ST3%,600,10)
nom$ = "Tas du programme"
' on ne peut "accrocher" aucune carte de la pile 3
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_enjeu_programme()
' *********************** pile 4: enjeu du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST4% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en-dessous de la pile 3
res% = dll_call3("LocateMyCardsStack",ST4%,600,160)
nom$ = "Enjeu du programme"
' on ne peut "accrocher" aucune carte de la pile 4
' on ne peut déposer aucune carte sur cette pile
res% = dll_call4("MyCardsCardStackOptions",ST4%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_talon()
' *********************** créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST5% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile au milieu à gauche
res% = dll_call3("LocateMyCardsStack",ST5%,300,250)
nom$ = "Talon"
' on ne peut "accrocher" aucune carte de la pile 5
' on ne peut déposer aucune carte sur cette pile
res% = dll_call4("MyCardsCardStackOptions",ST5%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_jeu_52_cartes()
' *********************** créer le jeu de 52 cartes (invisibles)
for couleur%=0 to 3
for n%=1 to 13
CD%(couleur%*13+n%) = dll_call4("CreateMyCardsCard",PG%,couleur%,n%,3)
res% = dll_call3("MoveMyCardsCardToStack",CD%(couleur%*13+n%),ST5%,0)
next n%
next couleur%
' battre le jeu
res% = dll_call1("ShuffleMyCardsStack",ST5%)
text 85,"52"
end_sub
sub distribuer_les_cartes()
dim_local i%, res%
' *********************** copier alternativement le jeu dans la main du joueur et du programme
for n%=1 to 26
res% = dll_call3("MoveMyCardsCardToStack",ST5%,ST1%,0) : ' main du joueur
res% = dll_call3("MoveMyCardsCardToStack",ST5%,ST3%,0) : ' main du programme
next n%
text 81,"26"
text 82,"0"
text 83,"26"
text 84,"0"
text 85,"0"
end_sub
sub ramasser_les_cartes()
' *********************** ramasser les cartes de toutes les piles
res% = dll_call4("MoveMyCardsStackToStack",ST1%,ST5%,0,0)
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST5%,0,0)
res% = dll_call4("MoveMyCardsStackToStack",ST3%,ST5%,0,0)
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST5%,0,0)
text 81,"0"
text 82,"0"
text 83,"0"
text 84,"0"
text 85,"26"
' battre le jeu
res% = dll_call1("ShuffleMyCardsStack",ST5%)
end_sub
sub creer_objets_speciaux()
' *********************** objets spéciaux
form 97 : hide 97
memo 98 : parent 98,97 : bar_both 98 : ' hide 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : hide 99
end_sub
sub creer_objets_visuels()
' *********************** boutons techiques
button 1 : top 1,570 : left 1,480 : caption 1,"Jouer" : on_click 1,jouer
button 2 : top 2,570 : left 2,720 : caption 2,"Bataille !" : on_click 2,bataille
button 3 : top 3,300 : left 3,380 : caption 3,"Distribuer" : on_click 3,distribuer
button 4 : top 4,360 : left 4,380 : caption 4,"Ramasser" : on_click 4,ramasser
' *********************** affichage du nombre de cartes par pile
edit 81 : top 81,640 : left 81,620 : width 81,25 : text 81,"0" : inactive 81
edit 82 : top 82,490 : left 82,620 : width 82,25 : text 82,"0" : inactive 82
edit 83 : top 83,150 : left 83,620 : width 83,25 : text 83,"0" : inactive 83
edit 84 : top 84,300 : left 84,620 : width 84,25 : text 84,"0" : inactive 84
edit 85 : top 85,390 : left 85,320 : width 85,25 : text 85,"0" : inactive 85
end_sub
Je pense qu'il est lisible et donne un bon exemple de l'usage de ces fonctions, qui continueront d'évoluer au fil de la réalisation de ce jeu (et éventuellement en tenant compte de vos suggestions...) | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Sam 26 Nov 2016 - 14:39 | |
| Nouvelle version: - quelques compléments dans la fonction ManageMyCardsCard - quelques compléments dans la fonction GetMyCardsInfo La doc est à jour. Et voici le "Bataille" en versioin complète et opérationnelle. On peut jouer levée après levée, le programme reconnaît la situation de "bataille" et la joue correctement, et détecte qui perd et qui gagne. - Code:
-
' Bataille.bas
' Ce programme est une première version du jeu de bataille.
' Le joueur joue contre l'ordinateur.
' Les règles (origine: Wikipedia):
' On distribue l'ensemble d'un (ou plusieurs) jeu de cartes (54 ou 32) aux joueurs,
' qui n'en prennent pas connaissance. À chaque tour, chaque joueur retourne la carte
' du haut de sa main (ou son tas). Celui qui a la carte de la plus haute valeur -
' selon la hiérarchie du bridge : As, Roi, Dame, Valet, dix… jusqu'au deux - fait
' la levée, qu'il place sous son tas.
' En cas d'égalité de valeurs - cas appelé bataille - les joueurs en ballotage
' disent « bataille ! », et commencent par placer une première carte face cachée
' puis une seconde carte face visible pour décider qui fera la levée.
' En cas de nouvelle égalité, la procédure est répétée. La bataille est
' parfois l'occasion d'acquérir une grosse carte et c'est l'unique manière
' de gagner un as. Sans bataille et à moins qu'un joueur ne possède tous les as,
' il serait impossible de terminer une partie de bataille. La partie se termine
' et le gagnant est déterminé lorsque ce dernier a en sa possession toutes les
' cartes du jeu.
' Technique:
' le programme prépare un terrain de jeu, avec 5 piles:
' pile 1: tas du joueur - pile non triée, face cachée
' pile 2: enjeu du joueur : pile non triée, face cachée et ouverte, cartes non glissables
' pile 3: tas du programme - pile non triée, face cachée, cartes non glissables
' pile 4: enjeu du programme : pile non triée, face cachée et ouverte, cartes non glissables
' pile 5: talon initial pour dustribuer les cartes, puis outil technique pour des manipulations
label event, close0, jouer, bataille, distribuer, ramasser
full_space 0 : caption 0,"Jeu de Bataille" : on_close 0,close0
dll_on "KGF.dll"
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
dim poStandard% : poStandard% = 0
dim poExtended% : poExtended% = 1
dim ciGetPlaygroundStacks% : ciGetPlaygroundStacks% = 1
dim ciGetPlaygroundCards% : ciGetPlaygroundCards% = 2
dim GetStackCards% : GetStackCards% = 3
dim GetStackName% : GetStackName% = 4
dim ciGetObjectHandle% : ciGetObjectHandle% = 5
dim ciGetCardSuitValue% : ciGetCardSuitValue% = 6
dim ciStackCardCount% : ciStackCardCount% = 7
' 1 = liste des piles dans un terrain de jeu (obj% est identifiant d'un terrain de jeu)
' 2 = liste des cartes dans un terrain de jeu (obj% est identifiant d'un terrain de jeu)
' 3 = liste des cartes dans une pile (obj% est identifiant d'une pile)
' 4 = retourner le nom d'une pile
' 5 = retourner le handle de l'objet (PG, ST, CD
' 6 = retourner couleur et valeur d'une carte (hexa CCCCVVVV)
' 7 = retourner le nombre de cartes dans une pile
dim mcHideCard% : mcHideCard% = 1
dim mcShowCard% : mcShowCard% = 2
dim mcTurnCard% : mcTurnCard% = 3
dim mcDeleteCard% : mcDeleteCard% = 4
dim mcShowCardDeck% : mcShowCardDeck% = 5
dim mcShowCardFace% : mcShowCardFace% = 6
' 1 = cacher la carte
' 2 = montrer la carte
' 3 = retourner la carte
' 4 = supprimer la carte (pas encore implémenté)
' 5 = cacher la face de la carte
' 6 = montrer la face de la carte
dim caAddCardAtEnd% : caAddCardAtEnd% = 0
dim caAddCardAtFront% : caAddCardAtFront% = 1
' 0 = ajouter en fin de pile
' 1 = insérer eu début de la pile
dim caPreserveStack% : caPreserveStack% = 0
dim caClearStack% : caClearStack% = 1
' 0 = ne pas vider avant l'action
' 1 = vider avant l'action
dim cdStandard1% : cdStandard1% = 0
dim cdStandard2% : cdStandard2% = 1
dim cdFishes1% : cdFishes1% = 2
dim cdFishes2% : cdFishes2% = 3
dim cdBeach% : cdBeach% = 4
dim cdLeaves1% : cdLeaves1% = 5
dim cdLeaves2% : cdLeaves2% = 6
dim cdRobot% : cdRobot% = 7
dim cdRoses% : cdRoses% = 8
dim cdShell% : cdShell% = 9
dim cdCastle% : cdCastle% = 10
dim cdHand% : cdHand% = 11
' Standard1, Standard2, Fishes1, Fishes2, Beach,
' Leaves1, Leaves2, Robot, Roses, Shell, Castle, Hand
dim ImageDeFond$ : ImageDeFond$ = ""
dim PG%, ST1%, ST2%, ST3%, ST4%, ST5%, CD%(52), hPG%
dim res%, nom$, n%, couleur%
creer_objets_speciaux()
creer_terrain()
creer_objets_visuels()
creer_tas_joueur()
creer_enjeu_joueur()
creer_tas_programme()
creer_enjeu_programme()
creer_talon()
creer_jeu_52_cartes()
end
close0:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
return
event:
return
jouer:
jouer_une_carte()
return
bataille:
faire_la_bataille()
return
distribuer:
distribuer_les_cartes()
return
ramasser:
ramasser_les_cartes()
return
sub creer_terrain()
' *********************** terrain de jeu
' création du terrain de jeu
PG% = dll_call5("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(ImageDeFond$))
' on ne peut "accrocher" aucune carte dans le terrain de jeu
' on ne peut déposer nulle part
' identification de la pile en fonction d'un contact avec un des 4 coins de la carte
res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragNone%,dropNone%,poExtended%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
' récupérer le handle du terrain de jeu
hPG% = dll_call3("GetMyCardsInfo",PG%,ciGetObjectHandle%,0)
end_sub
sub creer_tas_joueur()
' *********************** pile 1: tas du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST1% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en bas au milieu
res% = dll_call3("LocateMyCardsStack",ST1%,600,500)
nom$ = "Tas du joueur"
' on ne peut "accrocher" que la dernière carte de la pile 1
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,dropNone%,adr(nom$))
end_sub
sub creer_enjeu_joueur()
' *********************** pile 2: enjeu du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile au-dessus de la pile 1
res% = dll_call3("LocateMyCardsStack",ST2%,600,350)
nom$ = "Enjeu du joueur"
' on ne peut "accrocher" aucune carte de la pile 2
' les cartes déposées se placent automatiquement sur le dessus de la pile (à la fin)
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropLast%,adr(nom$))
end_sub
sub creer_tas_programme()
' *********************** pile 3: tas du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST3% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en haut au milieu
res% = dll_call3("LocateMyCardsStack",ST3%,600,10)
nom$ = "Tas du programme"
' on ne peut "accrocher" aucune carte de la pile 3
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_enjeu_programme()
' *********************** pile 4: enjeu du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST4% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en-dessous de la pile 3
res% = dll_call3("LocateMyCardsStack",ST4%,600,160)
nom$ = "Enjeu du programme"
' on ne peut "accrocher" aucune carte de la pile 4
' on ne peut déposer aucune carte sur cette pile
res% = dll_call4("MyCardsCardStackOptions",ST4%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_talon()
' *********************** créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST5% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile au milieu à gauche
res% = dll_call3("LocateMyCardsStack",ST5%,300,250)
nom$ = "Talon"
' on ne peut "accrocher" aucune carte de la pile 5
' on ne peut déposer aucune carte sur cette pile
res% = dll_call4("MyCardsCardStackOptions",ST5%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_jeu_52_cartes()
' *********************** créer le jeu de 52 cartes (invisibles)
for couleur%=0 to 3
for n%=1 to 13
CD%(couleur%*13+n%) = dll_call4("CreateMyCardsCard",PG%,couleur%,n%,3)
res% = dll_call3("MoveMyCardsCardToStack",CD%(couleur%*13+n%),ST5%,caAddCardAtEnd%)
next n%
next couleur%
' battre le jeu
res% = dll_call1("ShuffleMyCardsStack",ST5%)
text 85,"52"
end_sub
sub distribuer_les_cartes()
dim_local i%, res%
' *********************** copier alternativement le jeu dans la main du joueur et du programme
for n%=1 to 26
res% = dll_call3("MoveMyCardsCardToStack",ST5%,ST1%,caAddCardAtEnd%) : ' main du joueur
res% = dll_call3("MoveMyCardsCardToStack",ST5%,ST3%,caAddCardAtEnd%) : ' main du programme
next n%
comptage()
inactive 3
active 1
active 4
end_sub
sub ramasser_les_cartes()
' *********************** ramasser les cartes de toutes les piles
res% = dll_call4("MoveMyCardsStackToStack",ST1%,ST5%,caPreserveStack%,caAddCardAtEnd%)
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST5%,caPreserveStack%,caAddCardAtEnd%)
res% = dll_call4("MoveMyCardsStackToStack",ST3%,ST5%,caPreserveStack%,caAddCardAtEnd%)
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST5%,caPreserveStack%,caAddCardAtEnd%)
comptage()
' battre le jeu
res% = dll_call1("ShuffleMyCardsStack",ST5%)
inactive 1
inactive 2
inactive 4
active 3
end_sub
sub creer_objets_speciaux()
' *********************** objets spéciaux
form 97 : hide 97
memo 98 : parent 98,97 : bar_both 98 : ' hide 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : hide 99
end_sub
sub creer_objets_visuels()
' *********************** boutons techiques
button 1 : top 1,570 : left 1,480 : caption 1,"Jouer" : on_click 1,jouer : inactive 1
button 2 : top 2,570 : left 2,720 : caption 2,"Bataille !" : on_click 2,bataille : inactive 2
button 3 : top 3,300 : left 3,380 : caption 3,"Distribuer" : on_click 3,distribuer
button 4 : top 4,360 : left 4,380 : caption 4,"Ramasser" : on_click 4,ramasser : inactive 4
' *********************** affichage du nombre de cartes par pile
edit 81 : top 81,640 : left 81,620 : width 81,25 : text 81,"0" : inactive 81
edit 82 : top 82,490 : left 82,620 : width 82,25 : text 82,"0" : inactive 82
edit 83 : top 83,150 : left 83,620 : width 83,25 : text 83,"0" : inactive 83
edit 84 : top 84,300 : left 84,620 : width 84,25 : text 84,"0" : inactive 84
edit 85 : top 85,390 : left 85,320 : width 85,25 : text 85,"0" : inactive 85
end_sub
sub comptage()
dim_local v%
v% = dll_call3("GetMyCardsInfo",ST1%,ciStackCardCount%,0)
text 81,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST2%,ciStackCardCount%,0)
text 82,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST3%,ciStackCardCount%,0)
text 83,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST4%,ciStackCardCount%,0)
text 84,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST5%,ciStackCardCount%,0)
text 85,str$(v%)
end_sub
sub jouer_une_carte()
dim_local CDjoueur%, CDprogramme%, ValeurJoueur%, ValeurProgramme%, v%
inactive 2
CDjoueur% = dll_call3("MoveMyCardsCardToStack",ST1%,ST2%,caAddCardAtEnd%) : ' joueur
CDprogramme% = dll_call3("MoveMyCardsCardToStack",ST3%,ST4%,caAddCardAtEnd%) : ' programme
comptage()
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcTurnCard%) : ' retourner la carte !
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcTurnCard%) : ' retourner la carte !
v% = dll_call3("GetMyCardsInfo",CDjoueur%,ciGetCardSuitValue%,0)
ValeurJoueur% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurJoueur% = 14 : ' As est le plus fort !
v% = dll_call3("GetMyCardsInfo",CDprogramme%,ciGetCardSuitValue%,0)
ValeurProgramme% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurProgramme% = 14 : ' As est le plus fort !
if ValeurProgramme%=ValeurJoueur% : ' bataille ?
inactive 1
active 2
message "Bataille !"
exit_sub
end_if
if ValeurProgramme%>ValeurJoueur% : ' le programme emporte la mise ?
message "Dommage ! Vous avez perdu la mise."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST3%,caPreserveStack%,caAddCardAtFront%) : ' placer les cartes de ma mise du joueur sous les cartes du tas du programme
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST3%,caPreserveStack%,caAddCardAtFront%)
else : ' le joueur emporte la mise !
message "Super ! Vous avez gagné la mise."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST1%,caPreserveStack%,caAddCardAtFront%) : ' placer les cartes de ma mise du programme sous les cartes du tas du joueur
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST1%,caPreserveStack%,caAddCardAtFront%)
end_if
comptage()
if text$(81)="0"
message "Oups - vous avez perdu !"
inactive 1
inactive 2
exit_sub
end_if
if text$(83)="0"
message "BRAVO - vous avez gagné !"
inactive 1
inactive 2
exit_sub
end_if
end_sub
sub faire_la_bataille()
dim_local CDjoueur%, CDprogramme%, ValeurJoueur%, ValeurProgramme%, v%
' chacun joue une carte cachée
CDjoueur% = dll_call3("MoveMyCardsCardToStack",ST1%,ST2%,caAddCardAtEnd%) : ' joueur
CDprogramme% = dll_call3("MoveMyCardsCardToStack",ST3%,ST4%,caAddCardAtEnd%) : ' programme
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%)
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
comptage()
if text$(81)="0"
message "Oups - vous avez perdu !"
inactive 1
inactive 2
exit_sub
end_if
if text$(83)="0"
message "BRAVO - vous avez gagné !"
inactive 1
inactive 2
exit_sub
end_if
' et une carte ouverte
CDjoueur% = dll_call3("MoveMyCardsCardToStack",ST1%,ST2%,caAddCardAtEnd%) : ' joueur
CDprogramme% = dll_call3("MoveMyCardsCardToStack",ST3%,ST4%,caAddCardAtEnd%) : ' programme
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardFace%)
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardFace%)
comptage()
v% = dll_call3("GetMyCardsInfo",CDjoueur%,ciGetCardSuitValue%,0)
ValeurJoueur% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurJoueur% = 14 : ' As est le plus fort !
v% = dll_call3("GetMyCardsInfo",CDprogramme%,ciGetCardSuitValue%,0)
ValeurProgramme% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurProgramme% = 14 : ' As est le plus fort !
if ValeurProgramme%=ValeurJoueur% : ' bataille ?
inactive 1
active 2
message "Bataille !"
exit_sub
end_if
inactive 2
active 1
if ValeurProgramme%>ValeurJoueur% : ' le programme emporte la mise ?
message "Dommage ! Vous avez perdu la mise avec bataille."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST3%,caPreserveStack%,caAddCardAtEnd%) : ' placer les cartes de ma mise du joueur sous les cartes du tas du programme
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST3%,caPreserveStack%,caAddCardAtEnd%)
else : ' le joueur emporte la mise !
message "Super ! Vous avez gagné la mise avec bataille."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST1%,caPreserveStack%,caAddCardAtEnd%) : ' placer les cartes de ma mise du programme sous les cartes du tas du joueur
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST1%,caPreserveStack%,caAddCardAtEnd%)
end_if
comptage()
if text$(81)="0"
inactive 1
active 2
message "Bataille !"
exit_sub
end_if
if text$(83)="0"
message "BRAVO - vous avez gagné !"
inactive 1
inactive 2
exit_sub
end_if
end_sub
Je reconnais que ce jeu, par principe, ne nécesite aucune réflexion. Seul le hasard détermine le cours et l'issue du jeu. Je lai choisi pour démontrer la faisabilité de la réalisation d'un jeu de cartes avec l'outil MyCards contenu dans KGF.dll. En plus, je démontre la possibilité de placer des boutons et edits par-dessus le terrain de jeu, ce qui peut avoir son intérêt. Alors, à vous de jouer ! Pour ma part, je replonge plus en profondeur de MyCards pour créer de nouvelles possibilités... Comme c'est une nouvelle version, il faut recharger KGF.dll ! | |
| | | | Yannick
Nombre de messages : 8611
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010
| | Sujet: re Sam 26 Nov 2016 - 18:56 | |
| Je n' ai pas encore étudié le schmilblick mais je vais m' y mettre car cela m' intéresse. Ne serait ce que pour refaire mon poker en mieux. Je vais donc peut être dire une bêtise et me faire houspiller. Il serait bien d' avoir un jeu blanc que le programmeur puissent personnaliser avec un imagelist. Je ne suis pas sûr d' être très clair sur ce coup là... En fait, ce serait des fonctions permettant de se servir d' images de facade et d' un dos de carte placés dans un imagelist. Ainsi, nous pourrions créer d' autres jeux plus exotiques que la belote, poker et autres existant déjà. bon, je sors...  | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Sam 26 Nov 2016 - 19:21 | |
| C'est une idée, Ygeronimi, et je vais y réfléchir. Je ne vois pas pourquoi ce serait impossible.
Actuellement, les constantes techiques sont les suivantes:
- largeur des cartes: 71 pixels
- hauteur des cartes: 96 pixels
(ne me demande pas pourquoi - l'outil qui a servi de base pour Mycards avait ces valeurs codées en dur. Le les ai paramétrées par des constantes et on devrait pourvoir changer cela, mais... prudence.
- deux couleurs (rouge et noir)
- 4 suites de cartes (pique, caro, trèfle, coeur)
- 13 cartes dans chaque suite: A, 2, 3, ..., 10, valet, dame, roi
Ceci nous donne un jeu de 52 cartes., et on peut utiliser 2 jeux (104 cartes), soit avec le même dos, soit avec des dos différents
- au lieu de générer des jeux de 13 cartes dans chaque suite, on peut générer des sous-ensembles (comme 7, 8, 9, 10, valet, dame, roi, as) comme pour la belote.
L'idée des images externes est intéressante et certainement réalisable sans trop de problèmes. Je vais étudier cela.
EDIT
La vérification a été très rapide. Oui, c'est clairement possible, et simple si les constraintes de dimensions sont respectées. Il faut simplement déterminer le lien entre l'identification de la carte et l'indice de l'image dans l'objet ImageList. Mais ce n'est qu'une question de convention, de définition. Rien de bloquant.
Donc, oui, c'est facilement faisable. Pour cela, il faut simplement que j'ajoute une option à CreateMyCardsPlayground (ce sera le 6ème paramètre) avec le chemin et nom du fichier *.ils concerné. Je le charge alors en mémoire à la création du terrain de jeu, et partir de là, je vais chercher les images en mémoire au lieu de les faire venir à partir des ressources du programme. | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Dim 27 Nov 2016 - 1:40 | |
| @Ygeronimi:
Je suis prêt à faire les tests en grandeur nature, avec une ImageList de ton crû. Il faudrait me produire une imagelist avec le contenu suivant:
largeur 71 pixels
hauteur 96 pixels
52 images correspondant aux 52 cartes normales, soit 4 fois 13 cartes
12 images de dos de cartes
au moins 1 image représentant une pile vide (comme dans le jeu de bataille, au démarrage, les deux piles du milieu). S'il y en a plusieurs, ou pourra choisir en fonction de la pile.
Si tu me fais ça (par le WebDav, par exemple), je pourrais finir la mise au point. J'ai ajouté un paramètre à la fonction de création du terrain de jeu pour donner le chemin et le nom d'un fichier ILB, ainsi qu'à la fonction de création d'une carte à laquelle j'ai ajouté un paramètre qui est l'indice dans cetta ILB pour l'image de la carte. | |
| | | | Yannick
Nombre de messages : 8611
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010
| | Sujet: re Dim 27 Nov 2016 - 11:24 | |
| 52 cartes +1 dos
format 71x96.
Wouhaou, je me mets au boulot mais il va me falloir une idée pour commencer.
Dans les contraintes j' en vois une plus intéressante à faire sauter que les autres
c' est le nombre de suites, 4 à l' heure actuelle.
Je pense par exemple au jeu des 7 familles
7 suites de 6 cartes (père,mère,fils,fille,grand père,grand mère)
Bon je m' arrête là car tu risques de faire sauter le verrou avant que j' ai fait la moindre carte. | |
| | | | Yannick
Nombre de messages : 8611
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010
| | Sujet: RE Dim 27 Nov 2016 - 16:29 | |
| Ca y est ! j' ai pondu un jeu de 52 cartes+1 dos.
Il est basic mais il est pour la démo et chacun pourra s' en faire un à sa sauce après.
Pour l' imagelist ilb, dans quel ordre veux tu que j' enregistre les cartes ?
ex : faces pique(1,2,3,4....) puis coeur, puis treffle et carreau avec des dos à la fin
Dernière édition par ygeronimi le Dim 27 Nov 2016 - 16:56, édité 1 fois | |
| | | | Minibug
Nombre de messages : 4566
Age : 57
Localisation : Vienne (86)
Date d'inscription : 09/02/2012
| | Sujet: Re: Démonstration de CARDS.DLL Dim 27 Nov 2016 - 16:36 | |
| Je reprends ce que disait ygeronimi...
C'est vrai que ça serait une bonne idée de pourvoir créer des jeux de cartes plus 'exotiques' comme le tarot, les 7 familles, le mille bornes, etc.
mais là c'est peut être plus compliqué...
| |
| | | | Yannick
Nombre de messages : 8611
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010
| | Sujet: re Dim 27 Nov 2016 - 17:04 | |
| Il faudrait pour cela pouvoir créer son propre jeu de carte : Nbre de carte (32,52 ou autres) Nbre de couleur (1,2 ou plus) Nombre de familles (1,2,3,4...avec peut être une limite) Nombre de cartes / famille (8,13, ou autre) valeurs des couleurs (rouges, noires et autres) valeurs des familles (treffle,pique,coeur,carreau ou autres) valeurs des cartes (1,2,3,4,5,6,7,8,9,10,V,D,R... ou autres) cela complique le shmilblick...  | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Dim 27 Nov 2016 - 18:37 | |
| @geronimi: L'ordre actuel des couleurs est: Pique, Caro, Trèfle, Coeur 52 cartes plus un dos de carte - c'est bien, ça permet de commencer. Il faut prévoir aussi 1 image symbolisant une pile vide (juste l'emplacement). Au besoin, tu peux prendre celle-ci:  L'ordre des cartes dans le fichier ILB devrait être: Pique: As, 2, 3, ..., 10, Valet, Dame, Roi Caro: idem Trèfle: idem Coeur: idem liste des images des dos des cartes (une seule actuellement selon ce que tu dis) liste des images des piles (une seule pour le moment: celle que j'ai postée ci-dessus) Pour élargir le nombre de suites (4 également):je vais regarder cela. Pour réduire le nombre de cartes par suite: déjà possible - il suffit de ne générer que les cartes nécessaires Pour augmenter le nombre de cartes par suite: je vais regarder cela Pour augmenter les couleurs (actuellement rouge et noir): je vais regarersi l'on peut en ajouter d'autres (jaune, bleu...) mais est-ce vraiment intéressant ? Valeur des cartes: j'ai déjà une modification dans les cartons permettant pour chaque carte de paramétrer un "nom" personnalisé Voilà. Ai-je répondu à vos interrogations ? | |
| | | | Jicehel
Nombre de messages : 5947
Age : 51
Localisation : 77500
Date d'inscription : 18/04/2011
| | Sujet: Re: Démonstration de CARDS.DLL Dim 27 Nov 2016 - 21:06 | |
| Le cas du tarot est plus complexe car il y a 4 séries de cartes (géré) mais aussi une série d'atout de 22 cartes si on y met l'excuse. | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Dim 27 Nov 2016 - 21:37 | |
| @Jicehel: Tu dis: - Citation :
- Le cas du tarot est plus complexe car il y a 4 séries de cartes (géré) mais aussi une série d'atout de 22 cartes si on y met l'excuse.
Je ne connais pas le tarot. Cela veut-il dire qu'il y a 5 suite, dont 4 de 13 cartes et 1 suite de 22 cartes ? Cela dépasse à priori le champ couvert par ces fonctions. Mais puisque je suis entièremen maître des sources, rien n'interdit de définir un truc de ce genre. Simplement, le tarot, je n'y connais rien et il me faut un peu plus d'informations à ce sujet. Cependant, je me focalise en priorité sur les fonctionnalités de ce que l'on peut faire avec un ou deux jeux de 52 cartes, éventuellement avec un ou deux jokers dans chaque jeu. En effet, les jokers ne sont pas encore gérés, et ce sera en principe mon prochain ajout. Cela fera déjà pas mal de jeux qu'on pourra réaliser... | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Dim 27 Nov 2016 - 22:44 | |
| Nouvelle version: - possibilité de définir une ImageList (KGF.dll) sous forme d'un fichier *.ILB pour un terrain de jeu Dans ce cas, toutes les images (faces des cartes, dos des cartes ainsi qu'images des piles) sont prises dans cette ImageList, en spécifiant l'indice de l'image correspondante lors de la création des cartes et piles. par défaut, ce sont évidemment les images internes qui sont utilisées. La doc a été mise à jour. Voici le programme de démo adapté: - Code:
-
' test_MyCards.bas
label creer, supprimer, ramasser, distribuer, event, test
dim PG%, ST1%, ST2%, ST3%, CD%(13,3), CDdos%(11)
dim ncd%(3), fond$
dim res%, i%, k%, n%, s$, xcd%, nom$, ils$
dim debug% : debug% = 0
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
dim poStandard% : poStandard% = 0
dim poExtended% : poExtended% = 1
dim ciGetPlaygroundStacks% : ciGetPlaygroundStacks% = 1
dim ciGetPlaygroundCards% : ciGetPlaygroundCards% = 2
dim GetStackCards% : GetStackCards% = 3
dim GetStackName% : GetStackName% = 4
dim ciGetObjectHandle% : ciGetObjectHandle% = 5
dim ciGetCardSuitValue% : ciGetCardSuitValue% = 6
dim ciStackCardCount% : ciStackCardCount% = 7
' 1 = liste des piles dans un terrain de jeu (obj% est identifiant d'un terrain de jeu)
' 2 = liste des cartes dans un terrain de jeu (obj% est identifiant d'un terrain de jeu)
' 3 = liste des cartes dans une pile (obj% est identifiant d'une pile)
' 4 = retourner le nom d'une pile
' 5 = retourner le handle de l'objet (PG, ST, CD
' 6 = retourner couleur et valeur d'une carte (hexa CCCCVVVV)
' 7 = retourner le nombre de cartes dans une pile
dim mcHideCard% : mcHideCard% = 1
dim mcShowCard% : mcShowCard% = 2
dim mcTurnCard% : mcTurnCard% = 3
dim mcDeleteCard% : mcDeleteCard% = 4
dim mcShowCardDeck% : mcShowCardDeck% = 5
dim mcShowCardFace% : mcShowCardFace% = 6
' 1 = cacher la carte
' 2 = montrer la carte
' 3 = retourner la carte
' 4 = supprimer la carte (pas encore implémenté)
' 5 = cacher la face de la carte
' 6 = montrer la face de la carte
dim caAddCardAtEnd% : caAddCardAtEnd% = 0
dim caAddCardAtFront% : caAddCardAtFront% = 1
' 0 = ajouter en fin de pile
' 1 = insérer eu début de la pile
dim caPreserveStack% : caPreserveStack% = 0
dim caClearStack% : caClearStack% = 1
' 0 = ne pas vider avant l'action
' 1 = vider avant l'action
dim cdStandard1% : cdStandard1% = 0
dim cdStandard2% : cdStandard2% = 1
dim cdFishes1% : cdFishes1% = 2
dim cdFishes2% : cdFishes2% = 3
dim cdBeach% : cdBeach% = 4
dim cdLeaves1% : cdLeaves1% = 5
dim cdLeaves2% : cdLeaves2% = 6
dim cdRobot% : cdRobot% = 7
dim cdRoses% : cdRoses% = 8
dim cdShell% : cdShell% = 9
dim cdCastle% : cdCastle% = 10
dim cdHand% : cdHand% = 11
' Standard1, Standard2, Fishes1, Fishes2, Beach,
' Leaves1, Leaves2, Robot, Roses, Shell, Castle, Hand
full_space 0
dll_on "KGF.dll"
button 1 : top 1,10 : left 1,10 : caption 1,"Créer" : on_click 1,creer
button 2 : top 2,10 : left 2,90 : caption 2,"Supprimer" : on_click 2,supprimer : inactive 2
button 6 : top 6,10 : left 6,410 : caption 6,"Ramasser" : on_click 6,ramasser : inactive 6
button 7 : top 7,10 : left 7,490 : caption 7,"Distribuer" : on_click 7,distribuer : inactive 7
button 8 : top 8,10 : left 8,570 : caption 8,"Test" : on_click 8,test : ' hide 8
open_dialog 97
memo 98 : hide 98 : bar_both 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : ' hide 99
end
creer:
' créer le terrain de jeu
filter 97,"Fchiers *.BMP |*.bmp"
fond$ = file_name$(97)
if fond$="_"
fond$ = ""
else
if file_exists(fond$)=0 then fond$ = ""
end_if
ils$ = ""
PG% = dll_call6("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(fond$),adr(ils$))
if debug%=1 then message "CreateMyCardsPlayground="+hex$(PG%)
' première option:
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
' identification de la pile en fonction de la position du curseur
' res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%,poStandard%)
' deuxième option:
' on ne peut "accrocher" que les cartes ouvertes dans le terrain de jeu
' on peut déposer n'importe où
' identification de la pile en fonction d'un contact avec un des 4 coins de la carte
res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragFaceUp%,DropAny%,poExtended%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
if debug%=1 then message "MyCardsPlaygroundGeometry="+str$(res%)
' créer les 3 piles - une de gauche à droite
' - une empilée les unes sur les autres
' - une à gauche avec cartes détachées
' pile 1:
ST1% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,15,siNone%)
' <========== dans la ligne précédente, essayez scHearts% à la place de scAll% !!!!!
if debug%=1 then message "CreateMyCardsStack="+str$(ST1%)
res% = dll_call3("LocateMyCardsStack",ST1%,10,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Jeu complet mélangé"
' première option:
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
' res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
' seconde option:
' on peut "accrocher"toutes les cartes de stack 1
' peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragAll%,DropLast%,adr(nom$)) : ' dropNone%)
' pile 2:
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siHeart%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST2%,1100,40)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Défausse"
' première option:
' on ne peut "accrocher" que la dernière carte
' on peut déposer des cartes - elles se mettront automatiquement en dernière position
res% = dll_call4("MyCardsCardStackOptions",ST2%,dragLast%,DropLast%,adr(nom$)) : ' dropNone%)
if debug%=1 then message "MyCardsCardStackOptions="+str$(res%)
' pile 3:
ST3% = dll_call6("CreateMyCardsStack",PG%,sgLeftRight%,soNone%,scAll%,85,siNone%)
if debug%=1 then message "CreateMyCardsStack="+str$(ST2%)
res% = dll_call3("LocateMyCardsStack",ST3%,10,200)
if debug%=1 then message "LocateMyCardsStack="+str$(res%)
nom$ = "Dos de cartes"
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropNone%,adr(nom$))
' première option:
' on peut tirer toutes les cartes de stack 3
' on ne peut déposer aucune carte
' res% = dll_call4("MyCardsCardStackOptions",ST3%,dragAll%,dropLast%,adr(nom$))
' créer les 52 cartes et les envoyer dans la pile horizontale
ncd%(1)= 0
for i%=0 to 3
for k%=1 to 13
CD%(k%,i%) = dll_call6("CreateMyCardsCard",PG%,i%,k%,cdBeach%,0,0)
if CD%(k%,i%)=0 then message "oups - carte "+str$(k%)+","+str$(i%)
if CD%(k%,i%)<>0 then ncd%(1) = ncd%(1) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CD%(k%,i%))
res% = dll_call3("MoveMyCardsCardToStack",CD%(k%,i%),ST1%,0)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
next k%
next i%
message str$(ncd%(1))+" cartes ont été créées."
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
res% = dll_call2("SortMyCardsStack",ST1%,saByValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par valeur"
res% = dll_call2("SortMyCardsStack",ST1%,saByColorValue%)
if debug%=1 then message "SortMyCardsStack="+str$(res%)
message "Les cartes sont triées par couleur et valeur"
' mélanger les 52 cartes
res% = dll_call1("ShuffleMyCardsStack",ST1%)
if debug%=1 then message "ShuffleMyCardsStack="+str$(res%)
message "Les cartes ont été battues"
' créer les 12 dos de cartes et les envoyer dans l'autre pile horizontale
ncd%(3)= 0
for i%=0 to 11
CDdos%(i%) = dll_call6("CreateMyCardsCard",PG%,0,1,i%,0,0)
if CDdos%(i%)=0 then message "oups - dos "+str$(i%)
if CDdos%(i%)<>0 then ncd%(3) = ncd%(3) + 1
if debug%=1 then message "CreateMyCardsCard="+str$(CDdos%(i%))
res% = dll_call3("MoveMyCardsCardToStack",CDdos%(i%),ST3%,0)
if debug%=1 then message "MoveMyCardsCardToStack="+str$(res%)
res% = dll_call2("ManageMyCardsCard",CDdos%(i%),3) : ' retourner la carte !
next i%
message str$(ncd%(3))+" dos de cartes ont été créées."
inactive 1
active 2
active 6
return
supprimer:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
if debug%=1 then message "DeleteMyCardsPlayground="+str$(PG%)
active 1
inactive 2
inactive 6
inactive 7
return
ramasser:
res% = dll_call4("MoveMyCardsStackToStack",ST1%,ST2%,1,0)
ncd%(1) = ncd%(1) - res%
ncd%(2) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(2))+" cartes ont été ramassées."
inactive 6
active 7
return
distribuer:
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST1%,1,0)
ncd%(2) = ncd%(2) - res%
ncd%(1) = res%
if debug%=1 then message "MoveMyCardsStackToStack="+str$(res%)
message str$(ncd%(1))+" cartes ont été distribuées."
inactive 7
active 6
return
event:
s$ = trim$(text$(99))
if left$(s$,2)="CC" : ' clic sur carte
message "clic - "+text$(99)
if instr(s$,"Trèfle")>0 : ' carte de trèfle ?
xcd% = hex(mid$(s$,3,8))
res% = dll_call2("ManageMyCardsCard",xcd%,3) : ' retourner la carte !
end_if
end_if
if left$(s$,2)="CP" : ' clic sur terrain de jeu
message "clic - "+text$(99)
end_if
if left$(s$,2)="CS" : ' clic sur une partie noon utilisée d'une pile
message "clic - "+text$(99)
end_if
return
test:
return
et voici la Bataille adaptée de la même manière: - Code:
-
' Bataille.bas
' Ce programme est une première version du jeu de bataille.
' Le joueur joue contre l'ordinateur.
' Les règles (origine: Wikipedia):
' On distribue l'ensemble d'un (ou plusieurs) jeu de cartes (54 ou 32) aux joueurs,
' qui n'en prennent pas connaissance. À chaque tour, chaque joueur retourne la carte
' du haut de sa main (ou son tas). Celui qui a la carte de la plus haute valeur -
' selon la hiérarchie du bridge : As, Roi, Dame, Valet, dix… jusqu'au deux - fait
' la levée, qu'il place sous son tas.
' En cas d'égalité de valeurs - cas appelé bataille - les joueurs en ballotage
' disent « bataille ! », et commencent par placer une première carte face cachée
' puis une seconde carte face visible pour décider qui fera la levée.
' En cas de nouvelle égalité, la procédure est répétée. La bataille est
' parfois l'occasion d'acquérir une grosse carte et c'est l'unique manière
' de gagner un as. Sans bataille et à moins qu'un joueur ne possède tous les as,
' il serait impossible de terminer une partie de bataille. La partie se termine
' et le gagnant est déterminé lorsque ce dernier a en sa possession toutes les
' cartes du jeu.
' Technique:
' le programme prépare un terrain de jeu, avec 5 piles:
' pile 1: tas du joueur - pile non triée, face cachée
' pile 2: enjeu du joueur : pile non triée, face cachée et ouverte, cartes non glissables
' pile 3: tas du programme - pile non triée, face cachée, cartes non glissables
' pile 4: enjeu du programme : pile non triée, face cachée et ouverte, cartes non glissables
' pile 5: talon initial pour dustribuer les cartes, puis outil technique pour des manipulations
label event, close0, jouer, bataille, distribuer, ramasser
full_space 0 : caption 0,"Jeu de Bataille" : on_close 0,close0
dll_on "KGF.dll"
dim sSpades% : sSpades% = 0
dim sDiamonds% : sDiamonds% = 1
dim sClubs% : sClubs% = 2
dim sHearts% : sHearts% = 3
dim sgStockTopBackUp% : sgStockTopBackUp% = 0
dim sgStockTopFaceUp% : sgStockTopFaceUp% = 1
dim sgTopDown% : sgTopDown% = 2
dim sgLeftRight% : sgLeftRight% = 3
dim sgDownTop% : sgDownTop% = 4
dim sgRightLeft% : sgRightLeft% = 5
dim soNone% : soNone% = 0
dim soAscendant% : soAscendant% = 1
dim soDescendant% : soDescendant% = 2
dim scAll% : scAll% = 0
dim scSpades% : scSpades% = 1
dim scDiamonds% : scDiamonds% = 2
dim scClubs% : scClubs% = 3
dim scHearts% : scHearts% = 4
dim scBlack% : scBlack% = 5
dim scRed% : scRed% = 6
dim scAlternateBlackRed% : scAlternateBlackRed% = 7
dim dragNone% : dragNone% = 0
dim dragAll% : dragAll% = 1
dim dragFaceUp% : dragFaceUp% = 2
dim dragFaceDown% : dragFaceDown% = 3
dim dragLast% : dragLast% = 4
dim dropNone% : dropNone% = 0
dim DropAny% : DropAny% = 1
dim DropLast% : DropLast% = 2
dim siNone% : siNone% = 0
dim siWaste% : siWaste% = 1
dim siClub% : siClub% = 2
dim siDiamond% : siDiamond% = 3
dim siSpade% : siSpade% = 4
dim siHeart% : siHeart% = 5
dim saByValue% : saByValue% = 0
dim saByColorValue% : saByColorValue% = 1
dim poStandard% : poStandard% = 0
dim poExtended% : poExtended% = 1
dim ciGetPlaygroundStacks% : ciGetPlaygroundStacks% = 1
dim ciGetPlaygroundCards% : ciGetPlaygroundCards% = 2
dim GetStackCards% : GetStackCards% = 3
dim GetStackName% : GetStackName% = 4
dim ciGetObjectHandle% : ciGetObjectHandle% = 5
dim ciGetCardSuitValue% : ciGetCardSuitValue% = 6
dim ciStackCardCount% : ciStackCardCount% = 7
' 1 = liste des piles dans un terrain de jeu (obj% est identifiant d'un terrain de jeu)
' 2 = liste des cartes dans un terrain de jeu (obj% est identifiant d'un terrain de jeu)
' 3 = liste des cartes dans une pile (obj% est identifiant d'une pile)
' 4 = retourner le nom d'une pile
' 5 = retourner le handle de l'objet (PG, ST, CD
' 6 = retourner couleur et valeur d'une carte (hexa CCCCVVVV)
' 7 = retourner le nombre de cartes dans une pile
dim mcHideCard% : mcHideCard% = 1
dim mcShowCard% : mcShowCard% = 2
dim mcTurnCard% : mcTurnCard% = 3
dim mcDeleteCard% : mcDeleteCard% = 4
dim mcShowCardDeck% : mcShowCardDeck% = 5
dim mcShowCardFace% : mcShowCardFace% = 6
' 1 = cacher la carte
' 2 = montrer la carte
' 3 = retourner la carte
' 4 = supprimer la carte (pas encore implémenté)
' 5 = cacher la face de la carte
' 6 = montrer la face de la carte
dim caAddCardAtEnd% : caAddCardAtEnd% = 0
dim caAddCardAtFront% : caAddCardAtFront% = 1
' 0 = ajouter en fin de pile
' 1 = insérer eu début de la pile
dim caPreserveStack% : caPreserveStack% = 0
dim caClearStack% : caClearStack% = 1
' 0 = ne pas vider avant l'action
' 1 = vider avant l'action
dim cdStandard1% : cdStandard1% = 0
dim cdStandard2% : cdStandard2% = 1
dim cdFishes1% : cdFishes1% = 2
dim cdFishes2% : cdFishes2% = 3
dim cdBeach% : cdBeach% = 4
dim cdLeaves1% : cdLeaves1% = 5
dim cdLeaves2% : cdLeaves2% = 6
dim cdRobot% : cdRobot% = 7
dim cdRoses% : cdRoses% = 8
dim cdShell% : cdShell% = 9
dim cdCastle% : cdCastle% = 10
dim cdHand% : cdHand% = 11
' Standard1, Standard2, Fishes1, Fishes2, Beach,
' Leaves1, Leaves2, Robot, Roses, Shell, Castle, Hand
dim ImageDeFond$ : ImageDeFond$ = ""
dim ImageList$ : ImageList$ = ""
dim PG%, ST1%, ST2%, ST3%, ST4%, ST5%, CD%(52), hPG%
dim res%, nom$, n%, couleur%
creer_objets_speciaux()
creer_terrain()
creer_objets_visuels()
creer_tas_joueur()
creer_enjeu_joueur()
creer_tas_programme()
creer_enjeu_programme()
creer_talon()
creer_jeu_52_cartes()
end
close0:
PG% = dll_call1("DeleteMyCardsPlayground",PG%)
return
event:
return
jouer:
jouer_une_carte()
return
bataille:
faire_la_bataille()
return
distribuer:
distribuer_les_cartes()
return
ramasser:
ramasser_les_cartes()
return
sub creer_terrain()
' *********************** terrain de jeu
' création du terrain de jeu
PG% = dll_call6("CreateMyCardsPlayground",handle(0),handle(99),10,40,adr(ImageDeFond$),adr(ImageList$))
' on ne peut "accrocher" aucune carte dans le terrain de jeu
' on ne peut déposer nulle part
' identification de la pile en fonction d'un contact avec un des 4 coins de la carte
res% = dll_call4("MyCardsPlaygroundOptions",PG%,dragNone%,dropNone%,poExtended%)
' dimensionner le terrain de jeu
res% = dll_call5("MyCardsPlaygroundGeometry",PG%,0,40,1200,650)
' récupérer le handle du terrain de jeu
hPG% = dll_call3("GetMyCardsInfo",PG%,ciGetObjectHandle%,0)
end_sub
sub creer_tas_joueur()
' *********************** pile 1: tas du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST1% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en bas au milieu
res% = dll_call3("LocateMyCardsStack",ST1%,600,500)
nom$ = "Tas du joueur"
' on ne peut "accrocher" que la dernière carte de la pile 1
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST1%,dragLast%,dropNone%,adr(nom$))
end_sub
sub creer_enjeu_joueur()
' *********************** pile 2: enjeu du joueur
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST2% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile au-dessus de la pile 1
res% = dll_call3("LocateMyCardsStack",ST2%,600,350)
nom$ = "Enjeu du joueur"
' on ne peut "accrocher" aucune carte de la pile 2
' les cartes déposées se placent automatiquement sur le dessus de la pile (à la fin)
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropLast%,adr(nom$))
end_sub
sub creer_tas_programme()
' *********************** pile 3: tas du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST3% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en haut au milieu
res% = dll_call3("LocateMyCardsStack",ST3%,600,10)
nom$ = "Tas du programme"
' on ne peut "accrocher" aucune carte de la pile 3
' peut ne déposer aucune carte
res% = dll_call4("MyCardsCardStackOptions",ST3%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_enjeu_programme()
' *********************** pile 4: enjeu du programme
' créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST4% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile en-dessous de la pile 3
res% = dll_call3("LocateMyCardsStack",ST4%,600,160)
nom$ = "Enjeu du programme"
' on ne peut "accrocher" aucune carte de la pile 4
' on ne peut déposer aucune carte sur cette pile
res% = dll_call4("MyCardsCardStackOptions",ST4%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_talon()
' *********************** créer la pile
' faces cachées, toutes couleurs, aucun décalage des cartes, image de pile par défaut
ST5% = dll_call6("CreateMyCardsStack",PG%,sgStockTopBackUp%,soNone%,scAll%,0,siNone%)
' placer la pile au milieu à gauche
res% = dll_call3("LocateMyCardsStack",ST5%,300,250)
nom$ = "Talon"
' on ne peut "accrocher" aucune carte de la pile 5
' on ne peut déposer aucune carte sur cette pile
res% = dll_call4("MyCardsCardStackOptions",ST5%,dragNone%,dropNone%,adr(nom$))
end_sub
sub creer_jeu_52_cartes()
' *********************** créer le jeu de 52 cartes (invisibles)
for couleur%=0 to 3
for n%=1 to 13
CD%(couleur%*13+n%) = dll_call6("CreateMyCardsCard",PG%,couleur%,n%,cdFishes2%,0,0)
res% = dll_call3("MoveMyCardsCardToStack",CD%(couleur%*13+n%),ST5%,caAddCardAtEnd%)
next n%
next couleur%
' battre le jeu
res% = dll_call1("ShuffleMyCardsStack",ST5%)
text 85,"52"
end_sub
sub distribuer_les_cartes()
dim_local i%, res%
' *********************** copier alternativement le jeu dans la main du joueur et du programme
for n%=1 to 26
res% = dll_call3("MoveMyCardsCardToStack",ST5%,ST1%,caAddCardAtEnd%) : ' main du joueur
res% = dll_call3("MoveMyCardsCardToStack",ST5%,ST3%,caAddCardAtEnd%) : ' main du programme
next n%
comptage()
inactive 3
active 1
active 4
end_sub
sub ramasser_les_cartes()
' *********************** ramasser les cartes de toutes les piles
res% = dll_call4("MoveMyCardsStackToStack",ST1%,ST5%,caPreserveStack%,caAddCardAtEnd%)
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST5%,caPreserveStack%,caAddCardAtEnd%)
res% = dll_call4("MoveMyCardsStackToStack",ST3%,ST5%,caPreserveStack%,caAddCardAtEnd%)
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST5%,caPreserveStack%,caAddCardAtEnd%)
comptage()
' battre le jeu
res% = dll_call1("ShuffleMyCardsStack",ST5%)
inactive 1
inactive 2
inactive 4
active 3
end_sub
sub creer_objets_speciaux()
' *********************** objets spéciaux
form 97 : hide 97
memo 98 : parent 98,97 : bar_both 98 : ' hide 98
edit 99 : left 99,700 : width 99,300 : on_change 99,event : hide 99
end_sub
sub creer_objets_visuels()
' *********************** boutons techiques
button 1 : top 1,570 : left 1,480 : caption 1,"Jouer" : on_click 1,jouer : inactive 1
button 2 : top 2,570 : left 2,720 : caption 2,"Bataille !" : on_click 2,bataille : inactive 2
button 3 : top 3,300 : left 3,380 : caption 3,"Distribuer" : on_click 3,distribuer
button 4 : top 4,360 : left 4,380 : caption 4,"Ramasser" : on_click 4,ramasser : inactive 4
' *********************** affichage du nombre de cartes par pile
edit 81 : top 81,640 : left 81,620 : width 81,25 : text 81,"0" : inactive 81
edit 82 : top 82,490 : left 82,620 : width 82,25 : text 82,"0" : inactive 82
edit 83 : top 83,150 : left 83,620 : width 83,25 : text 83,"0" : inactive 83
edit 84 : top 84,300 : left 84,620 : width 84,25 : text 84,"0" : inactive 84
edit 85 : top 85,390 : left 85,320 : width 85,25 : text 85,"0" : inactive 85
end_sub
sub comptage()
dim_local v%
v% = dll_call3("GetMyCardsInfo",ST1%,ciStackCardCount%,0)
text 81,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST2%,ciStackCardCount%,0)
text 82,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST3%,ciStackCardCount%,0)
text 83,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST4%,ciStackCardCount%,0)
text 84,str$(v%)
v% = dll_call3("GetMyCardsInfo",ST5%,ciStackCardCount%,0)
text 85,str$(v%)
end_sub
sub jouer_une_carte()
dim_local CDjoueur%, CDprogramme%, ValeurJoueur%, ValeurProgramme%, v%
inactive 2
CDjoueur% = dll_call3("MoveMyCardsCardToStack",ST1%,ST2%,caAddCardAtEnd%) : ' joueur
CDprogramme% = dll_call3("MoveMyCardsCardToStack",ST3%,ST4%,caAddCardAtEnd%) : ' programme
comptage()
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcTurnCard%) : ' retourner la carte !
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcTurnCard%) : ' retourner la carte !
v% = dll_call3("GetMyCardsInfo",CDjoueur%,ciGetCardSuitValue%,0)
ValeurJoueur% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurJoueur% = 14 : ' As est le plus fort !
v% = dll_call3("GetMyCardsInfo",CDprogramme%,ciGetCardSuitValue%,0)
ValeurProgramme% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurProgramme% = 14 : ' As est le plus fort !
if ValeurProgramme%=ValeurJoueur% : ' bataille ?
inactive 1
active 2
message "Bataille !"
exit_sub
end_if
if ValeurProgramme%>ValeurJoueur% : ' le programme emporte la mise ?
message "Dommage ! Vous avez perdu la mise."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST3%,caPreserveStack%,caAddCardAtFront%) : ' placer les cartes de ma mise du joueur sous les cartes du tas du programme
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST3%,caPreserveStack%,caAddCardAtFront%)
else : ' le joueur emporte la mise !
message "Super ! Vous avez gagné la mise."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST1%,caPreserveStack%,caAddCardAtFront%) : ' placer les cartes de ma mise du programme sous les cartes du tas du joueur
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST1%,caPreserveStack%,caAddCardAtFront%)
end_if
comptage()
if text$(81)="0"
message "Oups - vous avez perdu !"
inactive 1
inactive 2
exit_sub
end_if
if text$(83)="0"
message "BRAVO - vous avez gagné !"
inactive 1
inactive 2
exit_sub
end_if
end_sub
sub faire_la_bataille()
dim_local CDjoueur%, CDprogramme%, ValeurJoueur%, ValeurProgramme%, v%
' chacun joue une carte cachée
CDjoueur% = dll_call3("MoveMyCardsCardToStack",ST1%,ST2%,caAddCardAtEnd%) : ' joueur
CDprogramme% = dll_call3("MoveMyCardsCardToStack",ST3%,ST4%,caAddCardAtEnd%) : ' programme
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%)
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
comptage()
if text$(81)="0"
message "Oups - vous avez perdu !"
inactive 1
inactive 2
exit_sub
end_if
if text$(83)="0"
message "BRAVO - vous avez gagné !"
inactive 1
inactive 2
exit_sub
end_if
' et une carte ouverte
CDjoueur% = dll_call3("MoveMyCardsCardToStack",ST1%,ST2%,caAddCardAtEnd%) : ' joueur
CDprogramme% = dll_call3("MoveMyCardsCardToStack",ST3%,ST4%,caAddCardAtEnd%) : ' programme
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardFace%)
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardFace%)
comptage()
v% = dll_call3("GetMyCardsInfo",CDjoueur%,ciGetCardSuitValue%,0)
ValeurJoueur% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurJoueur% = 14 : ' As est le plus fort !
v% = dll_call3("GetMyCardsInfo",CDprogramme%,ciGetCardSuitValue%,0)
ValeurProgramme% = bin_and(v%,65535) : ' valeur de la carte
if ValeurProgramme%=1 then ValeurProgramme% = 14 : ' As est le plus fort !
if ValeurProgramme%=ValeurJoueur% : ' bataille ?
inactive 1
active 2
message "Bataille !"
exit_sub
end_if
inactive 2
active 1
if ValeurProgramme%>ValeurJoueur% : ' le programme emporte la mise ?
message "Dommage ! Vous avez perdu la mise avec bataille."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST3%,caPreserveStack%,caAddCardAtEnd%) : ' placer les cartes de ma mise du joueur sous les cartes du tas du programme
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST3%,caPreserveStack%,caAddCardAtEnd%)
else : ' le joueur emporte la mise !
message "Super ! Vous avez gagné la mise avec bataille."
res% = dll_call2("ManageMyCardsCard",CDjoueur%,mcShowCardDeck%) : ' carte face cachée
res% = dll_call2("ManageMyCardsCard",CDprogramme%,mcShowCardDeck%)
res% = dll_call4("MoveMyCardsStackToStack",ST4%,ST1%,caPreserveStack%,caAddCardAtEnd%) : ' placer les cartes de ma mise du programme sous les cartes du tas du joueur
res% = dll_call4("MoveMyCardsStackToStack",ST2%,ST1%,caPreserveStack%,caAddCardAtEnd%)
end_if
comptage()
if text$(81)="0"
inactive 1
active 2
message "Bataille !"
exit_sub
end_if
if text$(83)="0"
message "BRAVO - vous avez gagné !"
inactive 1
inactive 2
exit_sub
end_if
end_sub
| |
| | | | Yannick
Nombre de messages : 8611
Age : 53
Localisation : Bretagne
Date d'inscription : 15/02/2010
| | Sujet: re Lun 28 Nov 2016 - 2:15 | |
| J' ai placé un zip "MesCartes.zip" sur mon webdav. 52 cartes+emplacement vide+2 dos. C' est du basique, même très basique. Je n' ai pas arrondi les angles des cartes et le fond est blanc mais bon...c' est pour la démo. | |
| | | | Klaus
Nombre de messages : 12301
Age : 75
Localisation : Ile de France
Date d'inscription : 29/12/2009
| | Sujet: Re: Démonstration de CARDS.DLL Lun 28 Nov 2016 - 8:14 | |
| Meri. Je charge et fais des essais avec. | |
| | | | Contenu sponsorisé
| | Sujet: Re: Démonstration de CARDS.DLL | |
| |
| | | | | | Démonstration de CARDS.DLL | |
|
Sujets similaires | |
|
| | Permission de ce forum: | Vous ne pouvez pas répondre aux sujets dans ce forum
| |
| |
| |
