Drag n Drop d'un seul fichier.. j'y arrive po !

[Ar-S]

Salut salut,

voilà mon soucis.

J'ai trouvé un code de flype proposé par le soldat inconnu qui permet le "glissé déposé", j'ai aussi trouvé ce code que j'essaye d'arranger pour qu'il respecte certaine conditions.
C'est évidement là que ça pine.

Voilà le code :

Code : Tout sélectionner

 ;Original source code by James L.Boyd;
; Cleaned and reposted be LarsG

Procedure.l DropFiles()
ProcedureReturn EventwParam()
EndProcedure

Procedure.s GetDropFile(*dropFiles, index)
bufferNeeded = DragQueryFile_(*dropFiles, index, 0, 0)
For a = 1 To bufferNeeded: buffer$ + " ": Next ; Short by one character!
DragQueryFile_(*dropFiles, index, buffer$, bufferNeeded+1)
ProcedureReturn buffer$
EndProcedure

Procedure FreeDropFiles(*dropFiles)
DragFinish_(*dropFiles)
EndProcedure


If OpenWindow(0, 200, 200, 300, 100, "Drag 'n' drop", #PB_Window_SystemMenu)
DragAcceptFiles_(WindowID(0), 1)
Repeat
Select WaitWindowEvent()
Case #WM_DROPFILES
*dropped = DropFiles()
f$ = ""
If files = 0 
f$ + GetDropFile(*dropped, files) + Chr (13)
MessageRequester("Drag 'n' Drop", Chr (13) + f$)
FreeDropFiles(*dropped)
Else
  MessageRequester ("info","Vous ne pouvez déposer qu'un seul fichier")
EndIf  

Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Quit = 1
EndIf

End

Voilà ce que je voudrais faire

- J'essaye de faire en sorte que le glissé déposé n'autorise qu'un seul fichier.
- Si plus d'un fichier est glissé-déposé, alors un messagerequester apparait pour dire qu'il ne faut glisser deposer qu'un fichier.
- Si un seul fichier est glissé-déposé, alors son nom est inscrit dans Fichier$ et Path$ = GetPathPart(Fichier$)

J'avoue ne pas trop comprendre le fonctionnement de ce code. Et je n'ai rien trouvé dans l'aide sur DragQueryFile.

[lionel_om]

Moi j'étais partis de ce code qd j'avais fait un D&D :

Code : Tout sélectionner

      ElseIf Event = #WM_DROPFILES ; Glisser déposer
        dropped.l = EventwParam()
        num.l = DragQueryFile_(dropped, - 1, "", 0)
        For index = 0 To num - 1
          size.l = DragQueryFile_(dropped, index, 0, 0)
          FileName.s = Space(size)
          DragQueryFile_(dropped, index, FileName, size + 1)
          If FileSize(FileName) = - 2
            CreateShellLink(FileName, Dossier + GetFilePart(FileName + ".lnk"), "", "", "", #SW_SHOWNORMAL, 0, FileName, 0)
            AddGadgetItemXP(#Liste, - 1, GetFilePart(FileName + ".lnk"), Dossier + GetFilePart(FileName + ".lnk"))
          EndIf
        Next
        DragFinish_(dropped)
      EndIf

La source complète est ici : Un code du Soldat Inconnu il me semble

Lio

[Flype]

à noter que la dernière version de pb (4.10 beta) a toutes les fonctions pour faire du drag n drop.

[Ar-S]

à noter que la dernière version de pb (4.10 beta) a toutes les fonctions pour faire du drag n drop.

Vouai mais bon pour la 4.10 j'attendrai une version de Japbe qui compil

[Flype]

bah franchement je n'ai pas eu le moindre probleme avec pb4.10b/jaPBe3.7.5.642.


en tout cas voici un exemple pour ton probleme :



en pb4.10b

Code : Tout sélectionner

Define fichier.s, chemin.s

If OpenWindow(0, 200, 200, 300, 100, "Drag'n'Drop", #PB_Window_SystemMenu)
  
  EnableWindowDrop(0, #PB_Drop_Files, #PB_Drag_Move)
  
  Repeat
    
    Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
        
        Break
        
      Case #PB_Event_WindowDrop
        
        fichier = EventDropFiles()
        
        If CountString(fichier, #LF$) 
          
          MessageRequester("Avertissement", "Vous ne pouvez déposer qu'un seul fichier !", #MB_ICONWARNING)
          
        Else
          
          chemin = GetPathPart(fichier)
          
          MessageRequester("Information", chemin + #LF$ + #LF$ + fichier, #MB_ICONINFORMATION)
          
        EndIf
        
    EndSelect
    
  ForEver
  
EndIf

End

et en imitant le principe avec pb4.02 et - :

Code : Tout sélectionner

Procedure.l EnableWindowDrop2(window.l, accept.l)
  ProcedureReturn DragAcceptFiles_(WindowID(window), accept)
EndProcedure

Procedure.s EventDropFiles2()
  
  Protected hDrop.l, liste.s, fichier.s{#MAX_PATH}
  
  hDrop = EventwParam()
  
  If hDrop
    
    For i = 1 To DragQueryFile_(hDrop, -1, 0, 0) 
      
      liste + Left(fichier, DragQueryFile_(hDrop, 0, @fichier, #MAX_PATH)) + #LF$
      
    Next
    
    DragFinish_(hDrop)
    
  EndIf
  
  ProcedureReturn liste
  
EndProcedure

Define fichier.s, chemin.s

If OpenWindow(0, 200, 200, 300, 100, "Drag'n'Drop", #PB_Window_SystemMenu)
  
  EnableWindowDrop2(0, #True)
  
  Repeat
    
    Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
        Break
        
      Case #WM_DROPFILES
        
        fichier = EventDropFiles2()
        
        If CountString(fichier, #LF$) > 1
          
          MessageRequester("Avertissement", "Vous ne pouvez déposer qu'un seul fichier !", #MB_ICONWARNING)
          
        Else
          
          chemin = GetPathPart(fichier)
          
          MessageRequester("Information", chemin + #LF$ + #LF$ + fichier, #MB_ICONINFORMATION)
          
        EndIf
        
    EndSelect
    
  ForEver
  
EndIf

End

[Ar-S]

Je te remercie, je vais étudire ça d'ici lundi (j'espere)...
J'ai eu un gros crash en installant ubuntu, du coup je dois reinstalelr ton mes softs xp... et demain chuis de mariage... autant dire que le script est en pause