PureBasic

Forums PureBasic
Nous sommes le Lun 26/Aoû/2019 9:01

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 
Auteur Message
 Sujet du message: Gliser-déposer avec plusieurs listes
MessagePosté: Dim 21/Oct/2018 12:37 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2169
Localisation: 50200 Coutances
Bonjour à tous,

bien que ce soit un jeu que j'ai créé pour mes petits enfants, j'ai préféré le placer dans les applications.

Ayant solliciter votre aide bienveillante, je me suis auto corrigé et je poste mon travail
Code:
; Les mots avec le son [o] : o, au, eau

EnableExplicit

Enumeration Fenetres
  #Fenetre_principale
EndEnumeration

Enumeration Gadgets
  #Txt_Titre
  #Txt_Signature
 
  #Lst_Cible_1
  #Lst_Cible_2
  #Lst_Cible_3
 
  #Lst_Source
 
  #Btn_Quitter
  #Btn_Suivant
EndEnumeration

Enumeration Polices
  #Police
  #Police_Gras
EndEnumeration

#Nb_Donnees = 8
#Nb_Series = 4

Global Evenement, i, j, Serie = 1, Texte$, Dim Mot.s(#Nb_Donnees), Dim Verif.b(#Nb_Donnees)

LoadFont(#Police, "Arial Nova", 20)
LoadFont(#Police_Gras, "Arial Nova", 20, #PB_Font_Bold)
SetGadgetFont(#PB_Default, FontID(#Police))

Declare Programme_principal()
Declare Lire_Donnees(Serie)
Declare Compliment(Note.b = 0)

Lire_Donnees(Serie)

Procedure Lire_Donnees(Serie)
  Protected$ Nom, Consonnes, Voyelles
  Select Serie
    Case 1
      Restore S1
    Case 2
      Restore S2
    Case 3
      Restore S3
    Case 4
      Restore S4
  EndSelect
 
  i = 0
  While i <= #Nb_Donnees
    Read$ Mot(i)
    Verif(i) = #False
    i + 1
  Wend
 
  Programme_principal()
EndProcedure

Procedure Valider()   
  i = 0
  While i <= #Nb_Donnees
   
    If Verif(i) = #False
      If GetGadgetItemText(#Lst_Cible_1, i) = Mot(i)
        Verif(i) = #True
        Break
      Else
        i - 1
        Break
      EndIf
     
      If GetGadgetItemText(#Lst_Cible_2, i) = Mot(i)
        Verif(i) = #True
        Break
      Else
        i - 1
        Break
      EndIf
     
      If GetGadgetItemText(#Lst_Cible_3, i) = Mot(i)
        Verif(i) = #True
        Break
      Else
        i - 1
        Break
      EndIf
    EndIf
    i + 1
  Wend
EndProcedure

Procedure Verifier_mot(Texte$)
  Protected Resultat$, Place, Mot$
 
  Mot$ = Texte$
 
  If FindString(Texte$, "eau", 1)
    DragPrivate(3)
  ElseIf FindString(Texte$, "au", 1)
    DragPrivate(2)
  ElseIf FindString(Texte$, "o", 1) Or FindString(Texte$, "ô", 1)
    DragPrivate(1)
  EndIf
EndProcedure

Procedure Suivant()
  Select EventType()
    Case #PB_EventType_LeftClick
      If Serie < #Nb_Series
        Serie + 1
        Lire_Donnees(Serie)
      Else
        HideGadget(#Btn_Suivant, #True) 
      EndIf
  EndSelect   
EndProcedure

Procedure Quitter()
  Select EventType()
    Case #PB_EventType_LeftClick
      CloseWindow(#Fenetre_principale)
      End
  EndSelect   
EndProcedure

Procedure Programme_principal()
  If OpenWindow(#Fenetre_principale, 0, 0, 670, 570, "", #PB_Window_BorderLess | #PB_Window_ScreenCentered)
    TextGadget(#Txt_Titre, 20, 20, 670, 40, "Les mots avec le son [o] : o, au, eau", #PB_Text_Center)
   
    ListIconGadget(#Lst_Cible_1, 20, 70, 150, 390, "o", 145)
    ListIconGadget(#Lst_Cible_2, 180, 70, 150, 390, "au", 145)
    ListIconGadget(#Lst_Cible_3, 340, 70, 150, 390, "eau", 145)
   
    ListIconGadget(#Lst_Source, 500, 70, 150, 390, "o, au, eau", 145)
   
    TextGadget(#Txt_Signature, 20, 460, 670, 40, "Ce logiciel a été conçu et réalisé par Micoute", #PB_Text_Center)
   
    ButtonGadget(#Btn_Quitter, 10, 510, 200, 40, "Quitter")
    ButtonGadget(#Btn_Suivant, 450, 510, 200, 40, "Suivant")
   
    ;remplir la liste source
    i = 0
    While i <= ArraySize(Mot())
      AddGadgetItem(#Lst_Source, i, Mot(i))
      i + 1
    Wend
   
    ; Activer maintenant le transfert sur les gadgets cibles
    EnableGadgetDrop(#Lst_Cible_1, #PB_Drop_Private, #PB_Drag_Copy, 1)
    EnableGadgetDrop(#Lst_Cible_2, #PB_Drop_Private, #PB_Drag_Copy, 2)
    EnableGadgetDrop(#Lst_Cible_3, #PB_Drop_Private, #PB_Drag_Copy, 3)
   
    ;Polices
    SetGadgetFont(#Txt_Titre, FontID(#Police_Gras))
    SetGadgetFont(#Txt_Signature, FontID(#Police_Gras))
    SetGadgetFont(#Btn_Quitter, FontID(#Police_Gras))
   
    ;événements liés
    BindGadgetEvent(#Btn_Quitter, @Quitter())
    BindGadgetEvent(#Btn_Suivant, @Suivant())
  EndIf
EndProcedure

;-boucle
Repeat
  Evenement = WaitWindowEvent()
 
  ; L'événement DragStart sur les gadgets sources, initie un glisser-déposer
  If Evenement = #PB_Event_Gadget And EventType() = #PB_EventType_DragStart
   
    Select EventGadget()
      Case #Lst_Source
        Texte$ = GetGadgetItemText(#Lst_Source, GetGadgetState(#Lst_Source))
        Verifier_mot(Texte$)
        Debug GetGadgetState(#Lst_Source) 
    EndSelect
   
    ; L'événement de dépose sur les gadgets cibles, reçoit les données déposées
  ElseIf Evenement = #PB_Event_GadgetDrop
    Select EventGadget()
       
      Case #Lst_Cible_1
          AddGadgetItem(#Lst_Cible_1, -1, Texte$)
       
      Case #Lst_Cible_2
          AddGadgetItem(#Lst_Cible_2, -1, Texte$)
       
      Case #Lst_Cible_3
          AddGadgetItem(#Lst_Cible_3, -1, Texte$)
       
        Valider()
    EndSelect
   
  EndIf
 
Until Evenement = #PB_Event_CloseWindow

DataSection
  S1:
  Data$ "cochon", "haut", "sceau", "botte", "veau", "faute", "pauvre", "bureau", "gros"
  S2:
  Data$ "anneau", "enclos", "capot", "peau", "judo", "aube", "préau", "joyau", "faucon"
  S3:
  Data$ "galop", "étau", "cadeau", "kimono", "vélo", "noyau", "fléau", "beau", "aubois"
  S4:
  Data$ "gauche", "tuyau", "ciseau", "Meaux", "sirop", "copine", "beau", "faux", "rôti"
EndDataSection

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Gliser-déposer avec plusieurs listes
MessagePosté: Dim 21/Oct/2018 13:30 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 09/Oct/2005 16:51
Messages: 8745
tu as vu que l'erreur est impossible ? On ne peut pas lacher un mot sur la mauvaise case...

_________________
~~~~Règles du forum ~~~~
.: Ar-S :. Tour + portable W10 x64 PB 5.4x / 5.6x
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
RESIZER GOLD : Mon logiciel de redimensionnement par lot 100% PB


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Gliser-déposer avec plusieurs listes
MessagePosté: Dim 21/Oct/2018 15:50 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 2169
Localisation: 50200 Coutances
Tout à fait, mais je vais rendre l'application plus intelligente pour éviter de placer plusieurs fois le même terme.

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 3 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 7 invités


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye