PureBasic

Code : Tout sélectionner

Procedure.l Triage(Liste.l, Colonne.l, File.s)
  ; Cette procedure permet de connaître la position à laquelle ajouté un élément dans une liste
  ; Elle trie les éléments de manière à placer les fichiers comme si il était dans un arbre
  ; Liste : Numéro de la liste
  ; Colonne : Colonne qui sert de référence
  ; File : nom du fichier à ajouté et que l'on souhaite placé correctement dans la liste
  
  File = "#\" + LCase(File)
  Path.s = GetPathPart(Left(File, Len(File) - 1))
  Debug "Path = " + path
  ExistPath.s = ""
  Index = 1
  Depart = 0
  NbElement = CountGadgetItems(Liste) - 1
  Fin = NbElement
  Debug depart
  Debug fin
  
  ; La première partie du code consiste à connaitre la partie du nom du fichier qui existe déjà 
  ; dans la liste. puis de connaitre la plage dans laquelle cette partie de fichier est présente (par exemple du 2 au 5ième éléments de la liste)

  Repeat
    Partie1.s = StringField(Path, Index, "\")
    Debug "Partie1 = " + partie1
    If Partie1 <> ""
      Test_Ok = 0
      For n = Depart To Fin
        File2.s = LCase("#\" + GetGadgetItemText(liste, n, Colonne))
        Debug "File2 = " + File2
        Partie2.s = StringField(GetPathPart(File2), Index, "\")
        Debug "Partie2 = " + partie2 + "   (index="+ Str(index) + ")"
        If Test_Ok = 0 And Partie1 = Partie2
          Test_Ok = 1
          Depart2 = n
        EndIf
        If Partie1 = Partie2
          Fin2 = n
        EndIf
      Next
      Debug "Depart2 = " + Str(Depart2)
      Debug "Fin2 = " + Str(Fin2)
      Depart = Depart2
      Fin = Fin2
    EndIf
    ExistPath2.s = ExistPath + Partie1 + "\"
    If Partie1 <> "" And FindString(LCase("#\" + GetGadgetItemText(liste, Depart, Colonne)), ExistPath2, 1) = 1
      ExistPath = ExistPath2
      Index + 1
    EndIf
  Until Partie1 = "" Or FindString(LCase("#\" + GetGadgetItemText(liste, Depart, Colonne)), ExistPath2, 1) = 0
  
  ; On affiche ici les résultats de la première partie de l'algo
  Debug ">> Depart = " + Str(depart)
  Debug ">> Fin = " + Str(fin)
  Debug ">> ExistPath = " + ExistPath
  
  ; la deuxième partie du code consiste à placé le fichier parmi ceux qui possède un morceau identique
  ; donc les dossiers en premier et les fichiers après
  ; la comparaison s'effectue uniquement sur la partie de l'adresse du fichiers ou dossier qui suit la partie déjà existante du fichiers ou dossiers
  
  Partie1.s = StringField(File, Index, "\")
  Type1.s = Mid(File, Len(ExistPath + Partie1) + 1, 1)
  Debug "Index = " + Str(Index)
  Debug "Partie1 = " + partie1
  Debug File
  Debug ExistPath + Partie1
  Debug "Type1 = '" + type1 + "'"
  
  Depart = Depart - 1
  Repeat
    Depart + 1
    File2.s = LCase("#\" + GetGadgetItemText(liste, Depart, Colonne))
    Partie2.s = StringField(File2, Index, "\")
    Longueur.l = Len(ExistPath + Partie2)
    If Longueur < Len(File2)
      Type2.s = Mid(File2, Longueur + 1, 1)
    Else
      Type2.s = Mid(File2, Longueur, 1)
      If Type2 <> "\" : Type2 = "" : EndIf
    EndIf
    Debug "File2 = " + File2
    Debug "Partie2 = " + Partie2
    Debug "Type2 = '" + Type2 + "'"
  Until (Type1 = Type2 And Partie1 <= Partie2) Or (Type1 = "\" And Type2 = "") Or Depart > Fin Or Depart > NbElement
  
  Debug ">> Depart = " + Str(depart)
  Debug "--------------------"
  
  ProcedureReturn Depart
EndProcedure





Procedure ListIconGadgetXP(GadgetID.l, x.l, y.l, tx.l, ty.l, colonne.s, largeur.l, options.l)
  ListIconGadget(GadgetID, x, y, tx, ty, colonne, largeur, options)
  #LVM_SETEXTENDEDLISTVIEWSTYLE = 4150 : #LVS_EX_SUBITEMIMAGES = 2
  hImageListS.l = SHGetFileInfo_("c:\", 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)
  ImageList_SetBkColor_(hImageListS, #CLR_NONE)
  SendMessage_(GadgetID(GadgetID), #LVM_SETIMAGELIST, #LVSIL_SMALL, hImageListS)
  SendMessage_(GadgetID(GadgetID), #LVM_SETEXTENDEDLISTVIEWSTYLE, #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
EndProcedure

Procedure AddGadgetItemXP(GadgetID.l, Pos.l, Texte.s, IconPath.s)
  SHGetFileInfo_(IconPath, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX | #SHGFI_SMALLICON)
  If Pos = -1
    Pos = CountGadgetItems(GadgetID) + 1
  EndIf
  
  Structure LVITEM
    mask.l
    iItem.l
    iSubitem.l
    state.l
    stateMask.l
    pszText.l
    cchTextMax.l
    iImage.l
    lParam.l
    iIndent.l
    iGroupId.l
    cColumns.l
    puColumns.l
  EndStructure
  
  var.LVITEM
  Var\mask = #LVIF_IMAGE | #LVIF_TEXT
  Var\iSubItem = 0
  Var\iItem = Pos
  Var\pszText = @Texte
  Var\iImage = InfosFile\iIcon
  Sendmessage_(GadgetID(GadgetID), #LVM_INSERTITEM, 0, @Var)
EndProcedure

Procedure Open_Window()
  
  If OpenWindow(0, 0, 0, 500, 200, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "Ajouter des fichiers par glisser déposer")
    DragAcceptFiles_(WindowID(), #TRUE) ; activez le glisser déposer
    SetWindowPos_(WindowID(), -1, 0, 0, 0, 0, #SWP_NOSIZE | #SWP_NOMOVE) ; fenêtre toujours au premier plan
    If CreateGadgetList(WindowID())
      ListIconGadgetXP(1, 0, 0, 500, 200, "Fichiers", 495, 0) ; crée une listicongadget avec icônes systèmes
    EndIf
  EndIf
EndProcedure


Procedure DragAndDrop()
  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
      If Right(filename, 1) <> "\" : filename = filename + "\" : EndIf
    EndIf
    
    ; Attention, un dossier doit obligatoirement se finir par un \ sinon l'algo plante
    Position = Triage(1, 0, Filename)
    AddGadgetItemXP(1, Position, filename, filename)
    
  Next
  DragFinish_(dropped)
EndProcedure

;- debut du programme
Open_Window()

Repeat
  Event = WaitWindowEvent()
  
  If Event = #WM_DROPFILES : DragAndDrop() : EndIf
  
Until Event = #PB_EventCloseWindow

End