[Résolu] Glisser-déposer avec plusieurs listes

Vous débutez et vous avez besoin d'aide ? N'hésitez pas à poser vos questions
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

[Résolu] Glisser-déposer avec plusieurs listes

Message par Micoute »

Bonjour à tous,

je viens encore vous solliciter à cause d'un problème, toujours pour l'éducation de mes petits enfants, je souhaiterais faire un logiciel de Drag And Drop avec plusieurs listes, mais je ne vois pas la solution et je ne sais pas non plus si c'est faisable.

je vous joins le programme pour que vous en preniez connaissance et je vous remercie d'avance pour l'aide précieuse que vous allez me prêter.

pour l'instant, il n'est pas terminé, mais j'ai prévu plusieurs série de mots.

Code : Tout sélectionner

; 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
EndEnumeration

Enumeration Polices
  #Police
  #Police_Gras
EndEnumeration

#Nb_Donnees = 8
#Nb_Series = 4

Global Evenement, i, j, Serie, Score, Texte$, indexCible1, indexCible2, indexCible3, TypeMot, 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) And indexCible1 = i
        Verif(i) = #True
        Compliment(#True)
        Break
      Else
        RemoveGadgetItem(#Lst_Cible_1, i)
        Compliment(#False)
        i - 1
        Break
      EndIf
      
      If GetGadgetItemText(#Lst_Cible_2, i) = Mot(i) And indexCible2 = i
        Verif(i) = #True
        Compliment(#True)
        Break
      Else
        RemoveGadgetItem(#Lst_Cible_2, i)
        Compliment(#False)
        i - 1
        Break
      EndIf
      
      If GetGadgetItemText(#Lst_Cible_3, i) = Mot(i) And indexCible3 = i
        Verif(i) = #True
        Compliment(#True)
        Break
      Else
        RemoveGadgetItem(#Lst_Cible_2, i)
        Compliment(#False)
        i - 1
        Break
      EndIf
    EndIf 
    i + 1
  Wend
EndProcedure

Procedure Verifier_mot(Texte$)
  Protected Resultat$, Place, Mot$
  
  Mot$ = Texte$
  
  boucle:
  If Resultat$ = ""
    i = 1
    While i <= Len(Texte$)
      place = FindString(Texte$, "o", 1)
      Resultat$ = Mid(Texte$, Place, 1)
      If Resultat$ = "o"
        TypeMot = 1
        Debug Resultat$
        Break
      EndIf  
      i + 1
    Wend  
  ElseIf Resultat$ <> "o"
    i = 1
    While i <= Len(Texte$)
      Place = FindString(Texte$, "eau", 1)
      Resultat$ = Mid(Texte$, Place, 3)
      If Resultat$ = "eau"
        TypeMot = 3
        Debug Resultat$
        Break
      EndIf  
      i + 1
    Wend
  ElseIf Resultat$ <> "eau"
    i = 1
    While i <= Len(Texte$)
      Place = FindString(Texte$, "au", 1)
      Resultat$ = Mid(Texte$, Place, 2)
      If Resultat$ = "au"
        TypeMot = 2
        Debug Resultat$
        Break
      EndIf  
      i + 1
    Wend
  ElseIf Texte$ = ""
    Mot$ = Right(Mot$, Len(Mot$) - 1)
    Goto boucle
  EndIf
  
  ;Debug Resultat$
  ProcedureReturn TypeMot
EndProcedure

Procedure Compliment(Note.b = 0)
  If Note = #True
    Score + 10
    MessageRequester("Bien", "C'est une excellente réponse"+#CRLF$+
                             #CRLF$+
                             "Ton score est de " + Score + " points", #PB_MessageRequester_Info)
  Else
    Score - 5
    MessageRequester("Pas glop !!!", "Réponse complètement fausse"+#CRLF$+
                                     "Regarde ta réponse"+#CRLF$+
                                     "et clique sur le bouton Ok"+#CRLF$+
                                     "pour redonner une nouvelle réponse"+#CRLF$+
                                     #CRLF$+
                                     "Tu as perdu 5 points, ton score est de " + Score, #PB_MessageRequester_Info)
  EndIf

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, 560, "", #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, 290, 510, 200, 40, "Quitter")
    
    ;Attributions 
    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_Text, #PB_Drag_Copy)
    EnableGadgetDrop(#Lst_Cible_2, #PB_Drop_Text, #PB_Drag_Copy)
    EnableGadgetDrop(#Lst_Cible_3, #PB_Drop_Text, #PB_Drag_Copy)
    
    ;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())
  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))
        DragText(Texte$)   
    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
        Verifier_mot(Texte$) 
        If TypeMot = 1
          AddGadgetItem(#Lst_Cible_1, -1, EventDropText())
          indexCible1 = CountGadgetItems(#Lst_Cible_1) - 1
        EndIf
        
      Case #Lst_Cible_2
        If TypeMot = 2
          AddGadgetItem(#Lst_Cible_2, -1, EventDropText())
          indexCible2 = CountGadgetItems(#Lst_Cible_2) - 1
        EndIf
        
      Case #Lst_Cible_3
        If TypeMot = 3
          AddGadgetItem(#Lst_Cible_3, -1, EventDropText())
          indexCible3 = CountGadgetItems(#Lst_Cible_3) - 1
        EndIf
        
        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
Dernière modification par Micoute le mar. 23/oct./2018 7:11, modifié 1 fois.
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Avatar de l’utilisateur
Ar-S
Messages : 9478
Inscription : dim. 09/oct./2005 16:51
Contact :

Re: Gliser-déposer avec plusieurs listes

Message par Ar-S »

Bonjour Micoute.
Je n'ai pas testé en profondeur mais ton drag & drop marche... Il te suffit de mettre quelques debug pour le voir.
Donc ce qui pine est très probablement ta procédure Verifier_mot(Texte$)
~~~~Règles du forum ~~~~
⋅.˳˳.⋅ॱ˙˙ॱ⋅.˳Ar-S ˳.⋅ॱ˙˙ॱ⋅.˳˳.⋅
W11x64 PB 6.x
Section HORS SUJET : ICI
LDV MULTIMEDIA : Dépannage informatique & mes Logiciels PB
UPLOAD D'IMAGES : Uploader des images de vos logiciels
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Gliser-déposer avec plusieurs listes

Message par Micoute »

Merci Ar-s de t'être penché sur mon programme, certes il fonctionne mais il en voie tout sur la première liste, ce que je cherche à faire c'est que ça envoie sur la liste adéquate selon les critères choisis, car c'est avant un logiciel d'apprentissage ou révision.

Bon dimanche
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
boby
Messages : 261
Inscription : jeu. 07/juin/2007 22:54

Re: Gliser-déposer avec plusieurs listes

Message par boby »

Code : Tout sélectionner

EnableExplicit

Declare DragEvent()
Declare DropEvent()

OpenWindow(0,0,0,300,300,"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
ListIconGadget(1,10,10,50,200,"col1",50)
ListIconGadget(2,70,10,50,200,"col2",50)
ListIconGadget(3,130,10,50,200,"col3",50)
ListIconGadget(4,190,10,50,200,"col4",50)

EnableGadgetDrop(1,#PB_Drop_Text,#PB_Drag_Copy)
EnableGadgetDrop(2,#PB_Drop_Text,#PB_Drag_Copy)
EnableGadgetDrop(3,#PB_Drop_Text,#PB_Drag_Copy)

AddGadgetItem(4,-1,"text1")
AddGadgetItem(4,-1,"text2")
AddGadgetItem(4,-1,"text3")
AddGadgetItem(4,-1,"text4")

BindGadgetEvent(4,@DragEvent())
BindEvent(#PB_Event_GadgetDrop,@DropEvent())

Procedure DragEvent()
  If Event() = #PB_Event_Gadget And EventType() = #PB_EventType_DragStart
    Debug "Drag start"
    DragText(GetGadgetItemText(4,GetGadgetState(4)),#PB_Drag_Copy)
  EndIf
EndProcedure

Procedure DropEvent()
  Select EventGadget()
    Case 1
      Debug EventDropText() + " dropé sur col1"
    Case 2
      Debug EventDropText() + " dropé sur col2"
    Case 3
      Debug EventDropText() + " dropé sur col3"
  EndSelect
EndProcedure

Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
En éspèrant répondre à ta question.
Avatar de l’utilisateur
Micoute
Messages : 2522
Inscription : dim. 02/oct./2011 16:17
Localisation : 35520 La Mézière

Re: Gliser-déposer avec plusieurs listes

Message par Micoute »

Oui, ça répond à ma question, au moins pour le principe,

EnableGadgetDrop(#Txt_1, #PB_Drop_Private, #PB_Drag_Copy, 1) : EnableGadgetDrop(#Txt_2, #PB_Drop_Private, #PB_Drag_Copy, 2), sont plus efficaces dans ce cas précis.

Merci de t'être penché sur mon problème
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce RTX 3080 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.73 PB 6.00 LTS (x64)
Un homme doit être poli, mais il doit aussi être libre !
Répondre