[VB2008] structure BrowseInfo + repertoire par défaut
Salut,
Je migre un code vb6 en vb.net, et j'utilise l'api SHBrowseForFolder pour choisir un dossier. Cette api fonctionne avec la structure BrowseInfo tel qu'expliqué dans ce post de 2005 à ce sujet mais sous ACCESS, donc vb6 grosso modo :
http://www.developpez.net/forums/d25...rtoire-racine/
C'est la façon dont mon code est fait en vb6 et il fonctionne parfaitement (avec repertoire par défaut grace à fonction callback)
Je tente cependant desespérément de migrer ça en vb.net, je suis passé par le système de delegate en lieu et place de adressof mais sans résultat.
Voici mon code :
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
| Option Strict Off
Option Explicit On
Module mdlFolder
Delegate Function BrowseCallbackProcDlg(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Private Structure BrowseInfo
Dim hWndOwner As Long
Dim pIDLRoot As Long
Dim pszDisplayName As Long
Dim lpszTitle As String
Dim ulFlags As Long
Dim lpfnCallback As BrowseCallbackProcDlg
Dim lParam As Long
End Structure
Private Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "SHELL32.DLL" Alias "SHBrowseForFolderA" (ByRef lpBrowseInfo As BrowseInfo) As Long
Private Declare Function SHGetIDListFromPath Lib "SHELL32.DLL" Alias "#162" (ByVal szPath As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Long) As Long
Public Function GetFolderName(ByRef lngHandle_I As Long, ByVal strDefaultDirectory_I As String) As String
Dim lngIDList As Long
Dim strBuffer As String
Dim tBrowseInfo As new BrowseInfo()
Dim dlgCallBack As BrowseCallbackProcDlg
Const BIF_RETURNONLYFSDIRS As Short = 1
GetFolderName = ""
'Initialisation de la structure
dlgCallBack = new BrowseCallbackProcDlg(AddressOf BrowseCallbackProc)
With tBrowseInfo
.hWndOwner = lngHandle_I
.lpszTitle = "Sélectionner le répertoire"
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfnCallback = dlgCallBack
.lParam = SHGetIDListFromPath(Convert.ToString(strDefaultDirectory_I))
End With
'Affichage de la fenêtre de sélection du répertoire
lngIDList = SHBrowseForFolder(tBrowseInfo)
'Récupération du répertoire sélectionné
If lngIDList Then
strBuffer = Space(512)
SHGetPathFromIDList(lngIDList, strBuffer)
GetFolderName = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
End If
End Function
Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Const BFFM_INITIALIZED As Short = 1
Const WM_USER As Long = &H400
Const BFFM_SETSELECTIONA As Decimal = (WM_USER + 102)
If uMsg = BFFM_INITIALIZED Then Call SendMessage(hWnd, BFFM_SETSELECTIONA, 0, lpData)
End Function
End Module |
La dialog box se lance bien, mais à aucun moment elle ne passe dans BrowseCallbackProc (point d'arret)
si vous avez une idée ...
merci, bonne journée
seb
