FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC

Développement d'applications avec le langage Panoramic
 
AccueilAccueil  FAQFAQ  RechercherRechercher  S'enregistrerS'enregistrer  MembresMembres  GroupesGroupes  Connexion  
Derniers sujets
» Un petit "coucou" à tous les Panoramiciens !
par Yannick Aujourd'hui à 23:06

» mise a jour calculatrice
par joeeee2017 Aujourd'hui à 22:44

» Logiciel de soutien scolaire en langues.
par Pedro Alvarez Aujourd'hui à 16:52

» KGF_dll - nouvelles versions
par Klaus Aujourd'hui à 14:16

» Compilateur FBPano
par Ouf_ca_passe Aujourd'hui à 12:25

» double guillemets "" dans un EDIT
par Marc Hier à 23:43

» Documentation de KGF
par Klaus Lun 20 Nov 2017 - 22:52

» Zoom sur une portion d'écran
par JL35 Lun 20 Nov 2017 - 21:51

» Recherche d'une expression dans un source
par Marc Lun 20 Nov 2017 - 13:08

» Tracer une grille n'importe où sur l'écran
par JL35 Dim 19 Nov 2017 - 22:14

» TourD Version 2
par Klaus Sam 18 Nov 2017 - 23:58

» La métamatière et le peuple
par JL35 Ven 17 Nov 2017 - 21:18

» Capture d'une zone de l'écran total
par JL35 Ven 17 Nov 2017 - 18:41

» qui peut résoudre mon prb
par pascal10000 Jeu 16 Nov 2017 - 17:30

» évènements et objets système : listage automatique
par Jean Claude Jeu 16 Nov 2017 - 11:15

Navigation
 Portail
 Index
 Membres
 Profil
 FAQ
 Rechercher
Rechercher
 
 

Résultats par :
 
Rechercher Recherche avancée
Novembre 2017
LunMarMerJeuVenSamDim
  12345
6789101112
13141516171819
20212223242526
27282930   
CalendrierCalendrier

Partagez | 
 

 Démonstration de CARDS.DLL

Voir le sujet précédent Voir le sujet suivant Aller en bas 
Aller à la page : Précédent  1, 2, 3, 4, 5  Suivant
AuteurMessage
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Jeu 24 Nov 2016 - 3: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Jeu 24 Nov 2016 - 16: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 - 22:41, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
papydall

avatar

Nombre de messages : 5594
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Démonstration de CARDS.DLL   Jeu 24 Nov 2016 - 17:51

Tu as oublié de poster le code Sad
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Jeu 24 Nov 2016 - 22:42

Oups... voilà qui est corrigé !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Ven 25 Nov 2016 - 4: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
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Ven 25 Nov 2016 - 21: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Sam 26 Nov 2016 - 2: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Sam 26 Nov 2016 - 4: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
 
 
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
papydall

avatar

Nombre de messages : 5594
Age : 67
Localisation : Moknine (Tunisie) Entre la chaise et le clavier
Date d'inscription : 03/03/2012

MessageSujet: Re: Démonstration de CARDS.DLL   Sam 26 Nov 2016 - 7:02

Beau travail, merci Klaus et bonne continuation.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://papydall-panoramic.forumarabia.com/
Minibug

avatar

Nombre de messages : 2364
Age : 51
Localisation : Vienne (86)
Date d'inscription : 10/02/2012

MessageSujet: Re: Démonstration de CARDS.DLL   Sam 26 Nov 2016 - 13:43

J'ai hâte de voir la suite... Wink
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gpp.panoramic.free.fr
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Sam 26 Nov 2016 - 13: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...)
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Sam 26 Nov 2016 - 16: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 !
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Yannick

avatar

Nombre de messages : 7998
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Sam 26 Nov 2016 - 20: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... Embarassed
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Sam 26 Nov 2016 - 21: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Dim 27 Nov 2016 - 3: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Yannick

avatar

Nombre de messages : 7998
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Dim 27 Nov 2016 - 13: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Yannick

avatar

Nombre de messages : 7998
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: RE   Dim 27 Nov 2016 - 18: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 - 18:56, édité 1 fois
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Minibug

avatar

Nombre de messages : 2364
Age : 51
Localisation : Vienne (86)
Date d'inscription : 10/02/2012

MessageSujet: Re: Démonstration de CARDS.DLL   Dim 27 Nov 2016 - 18: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é...

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://gpp.panoramic.free.fr
Yannick

avatar

Nombre de messages : 7998
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Dim 27 Nov 2016 - 19: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...
Laughing
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Dim 27 Nov 2016 - 20: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 ?

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Jicehel

avatar

Nombre de messages : 5860
Age : 45
Localisation : 77500
Date d'inscription : 19/04/2011

MessageSujet: Re: Démonstration de CARDS.DLL   Dim 27 Nov 2016 - 23: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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Dim 27 Nov 2016 - 23: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...
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Lun 28 Nov 2016 - 0: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

Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Yannick

avatar

Nombre de messages : 7998
Age : 46
Localisation : Bretagne
Date d'inscription : 15/02/2010

MessageSujet: re   Lun 28 Nov 2016 - 4:15

J' ai placé un zip "MesCartes.zip" sur mon webdav.
52 cartes+emplacement vide+2 dos.
Embarassed 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.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur
Klaus

avatar

Nombre de messages : 10129
Age : 68
Localisation : Ile de France
Date d'inscription : 29/12/2009

MessageSujet: Re: Démonstration de CARDS.DLL   Lun 28 Nov 2016 - 10:14

Meri. Je charge et fais des essais avec.
Revenir en haut Aller en bas
Voir le profil de l'utilisateur http://klauspanoramic.comxa.com/index.html
Contenu sponsorisé




MessageSujet: Re: Démonstration de CARDS.DLL   

Revenir en haut Aller en bas
 
Démonstration de CARDS.DLL
Voir le sujet précédent Voir le sujet suivant Revenir en haut 
Page 4 sur 5Aller à la page : Précédent  1, 2, 3, 4, 5  Suivant
 Sujets similaires
-
» démonstration d'accordéon Roland sons bk7m
» Démonstration n°1 de TOONIC: un simple paysage
» Démos BK-7m
» ou d'ecouter les differents registres du fr18
» Explosif démo BK5 Roland

Permission de ce forum:Vous ne pouvez pas répondre aux sujets dans ce forum
FORUM DE DISCUSSION SUR LE LANGAGE PANORAMIC :: PANORAMIC :: Vos sources, vos utilitaires à partager-
Sauter vers: