Publicité
+ Répondre à la discussion
Affichage des résultats 1 à 6 sur 6
  1. #1
    Membre régulier
    Inscrit en
    janvier 2005
    Messages
    104
    Détails du profil
    Informations forums :
    Inscription : janvier 2005
    Messages : 104
    Points : 81
    Points
    81

    Par défaut Selection de répertoire : valeur par défaut + bouton "créer"

    Bonjour,

    Dans une appli j'ouvre une fenêtre qui permet à l'utilisateur de choisir un répertoire. Il y a un répertoire racine, et un répertoire sélectionné par défaut.

    Pour cela j'utilise ce code (source : Tofalu sur ce forum)

    Code :
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
     
    Option Compare Database
     
    Private Const BIF_RETURNONLYFSDIRS = 1
    Private Const BIF_DONTGOBELOWDOMAIN = 2
    Private Const BFFM_INITIALIZED = 1
    Private Const WM_USER = &H400
    Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
     
    Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
    Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
        ByVal lpBuffer As String) As Long
    Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
        ByVal lpString2 As String) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
                                  (ByVal hWnd As Long, ByVal wMsg As Long, _
                                  ByVal wParam As Long, lParam As Any) As Long
     
    Private Declare Function SHGetIDListFromPath Lib "SHELL32.DLL" Alias "#162" (ByVal szPath As String) As Long
     
    Private Type BrowseInfo
        hWndOwner As Long
        pIDLRoot As Long
        pszDisplayName As Long
        lpszTitle As Long
         ulFlags As Long
        lpfnCallback As Long
        lParam As Long
        iImage As Long
    End Type
     
    Function adr(n As Long) As Long
    adr = n
    End Function
     
    Public Function BrowseCallbackProc(ByVal hWnd As Long, _
                                                          ByVal uMsg As Long, _
                                                          ByVal lParam As Long, _
                                                          ByVal lpData As Long) As Long
      If uMsg = BFFM_INITIALIZED Then
          Call SendMessage(hWnd, BFFM_SETSELECTIONA, False, ByVal lpData)
      End If
    End Function
     
    Public Function SelectFolder(Title As String, Handle As Long, DefaultFolder As String) As String
     
    Dim lpIDList As Long
    Dim strBuffer As String
    Dim strTitle As String
    Dim tBrowseInfo As BrowseInfo
     
     
    strTitle = Title
     
    With tBrowseInfo
        .hWndOwner = Handle
        .lpszTitle = lstrcat(strTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN 
        .lpfnCallback = adr(AddressOf BrowseCallbackProc)
        .lParam = SHGetIDListFromPath(StrConv(DefaultFolder, vbUnicode))
        .pIDLRoot = SHGetIDListFromPath(StrConv("C:\", vbUnicode))
    End With
     
    lpIDList = SHBrowseForFolder(tBrowseInfo)
     
    If (lpIDList) Then
        strBuffer = String(260, vbNullChar)
        SHGetPathFromIDList lpIDList, strBuffer
        SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If
     
    End Function
    Ca fonctionne bien, mais quand j'essaye de rajouter un bouton de création de répertoire, avec ce code (source : Arkham46 sur ce forum aussi) ...

    Code :
    1
    2
    3
    4
    5
    6
     
    Private Const BIF_NEWDIALOGSTYLE As Long = &H40
     
    ...
     
    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN + BIF_NEWDIALOGSTYLE
    Le bouton est bien créé, le répertoire racine ("C:\") est toujours bon, mais le répertoire par défaut n'est plus selectionné.

    Quelqu'un sait pourquoi ?
    Merci pour votre aide.

  2. #2
    Rédacteur/Modérateur
    Avatar de Dolphy35
    Homme Profil pro Morgan BILLY
    couteau Suisse
    Inscrit en
    octobre 2004
    Messages
    4 373
    Détails du profil
    Informations personnelles :
    Nom : Homme Morgan BILLY
    Âge : 36
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : couteau Suisse
    Secteur : Industrie

    Informations forums :
    Inscription : octobre 2004
    Messages : 4 373
    Points : 10 344
    Points
    10 344

    Par défaut

    Salut,

    Si tu veux ton répertoire par défaut enlève cette ligne :

    Code :
    .pIDLRoot = SHGetIDListFromPath(StrConv("C:\", vbUnicode))
    Dolphy

  3. #3
    Membre régulier
    Inscrit en
    janvier 2005
    Messages
    104
    Détails du profil
    Informations forums :
    Inscription : janvier 2005
    Messages : 104
    Points : 81
    Points
    81

    Par défaut

    Salut,

    Merci pour la suggestion, mais quand j'enlève cette ligne, je n'ai pas de répertoire par défaut quand même

    Grosso modo, j'aimerais avoir trois choses en même temps :
    - une racine pour mon arborescence (pIDLRoot)
    - un répertoire qui sera sélectionné par défaut (lParam)
    - un bouton de création de répertoires

    Et les résultats suivants :

    Racine + Répertoire par défaut : OK
    Racine + Bouton de création : OK
    Racine + Répertoire par défaut + Bouton de création : je n'ai que le bouton et la racine
    Répertoire par défaut + Bouton de création : je n'ai que le bouton

    Apparament, à partir du moment ou je rajoute ce bouton, le répertoire par défaut n'est plus pris en compte.

    Je pige pas

  4. #4
    Rédacteur/Modérateur
    Avatar de Dolphy35
    Homme Profil pro Morgan BILLY
    couteau Suisse
    Inscrit en
    octobre 2004
    Messages
    4 373
    Détails du profil
    Informations personnelles :
    Nom : Homme Morgan BILLY
    Âge : 36
    Localisation : France, Ille et Vilaine (Bretagne)

    Informations professionnelles :
    Activité : couteau Suisse
    Secteur : Industrie

    Informations forums :
    Inscription : octobre 2004
    Messages : 4 373
    Points : 10 344
    Points
    10 344

    Par défaut

    re,

    effectivement je n'avais pas bien compris ton souhait

    en passant le répertoire dans le DefaultFolder, cela fonctionne et en ne mettant pas pIDLRoot mais tu as toute l'arborescence des disques. Tu ne veux que le disque sélectionné dans pIDLRoot qui s'affiche dans la fenêtre ?

    Code :
    MsgBox SelectFolder("test", Me.hWnd, "D:\Mes documents")
    Dolphy

  5. #5
    Membre régulier
    Inscrit en
    janvier 2005
    Messages
    104
    Détails du profil
    Informations forums :
    Inscription : janvier 2005
    Messages : 104
    Points : 81
    Points
    81

    Par défaut

    Oui en effet j'ai besoin de limiter l'arbre à un disque, les utilisateurs n'ayant pas le droit de toucher au reste.

    En fait, l'idéal serait même de restreindre le tout à un seul répertoire (celui que je voulais prendre par défaut), et ainsi juste utiliser pIDLRoot. Mais quand j'essaie de passer "C:\essai" au lieu de "C:\" à pIDLRoot, la fonction SHBrowseForFolder me renvoie "Folder C:\essai cannot be used. Please select another folder."

    Cette API est bien mystérieuse pour moi

  6. #6
    Invité régulier
    Inscrit en
    février 2012
    Messages
    21
    Détails du profil
    Informations forums :
    Inscription : février 2012
    Messages : 21
    Points : 8
    Points
    8

    Par défaut

    Bonjour à tous,

    Je déterre un peu (beaucoup?) le sujet...
    Cela fait quelques jours que je n'arrive pas à régler cette question de "lParam"...
    Le tutoriel de SilkyRoad a été utilisé (merci à lui!) comme référence.
    La fenetre de recherche fonctionne parfaitement, mais je souhaiterais "pré-définir" un dossier lors de son ouverture.
    Seulement, je n'arrive pas du tout à régler le "lParam"...
    L'erreur d'execution 13 s'affiche : incompatibilité de type.

    Mon code plante à cette ligne précise :
    Code :
    1
    2
    3
    4
    5
    With tBrowseInfo
        .lpszTitle = lstrcat(szTitle, "")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
        .lParam = SHGetPathFromIDList(StrConv(szPath, vbUnicode), "")
    End With
    La fonction SHGetPathFromIDList est définie comme suite :
    Code :
    Private Declare Function SHGetPathFromIDList Lib "SHELL32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
    Si vous avez des idées n'hésitez pas à faire signe!

Liens sociaux

Règles de messages

  • Vous ne pouvez pas créer de nouvelles discussions
  • Vous ne pouvez pas envoyer des réponses
  • Vous ne pouvez pas envoyer des pièces jointes
  • Vous ne pouvez pas modifier vos messages
  •