Controlli - CommonDialog con Directory e files ...




Option Explicit

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

Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_STATUSTEXT = &H4
Private Const MAX_PATH = 260
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
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

Public Function fBrowseForFolder(hWndOwner As Long, sPrompt As String) As String
'

' Opens the system dialog for browsing for a folder.

'

Dim iNull As Integer
Dim lpIDList As Long
Dim lResult As Long
Dim sPath As String
Dim udtBI As BrowseInfo

With udtBI
.hWndOwner = hWndOwner
.lpszTitle = lstrcat(sPrompt, "")

If Option1(0).Value Then ' Solo directory e Driver
.ulFlags = BIF_RETURNONLYFSDIRS
ElseIf Option1(1).Value Then ' Solo directory e Driver e Files
.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_BROWSEINCLUDEFILES
ElseIf Option1(2).Value Then ' computer
.ulFlags = BIF_BROWSEFORCOMPUTER
Else ' stampanti
.ulFlags = BIF_BROWSEFORPRINTER
End If
End With

lpIDList = SHBrowseForFolder(udtBI)

If lpIDList Then
sPath = String$(MAX_PATH, 0)
lResult = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)

iNull = InStr(sPath, vbNullChar)
If iNull Then sPath = Left$(sPath, iNull - 1)
End If

fBrowseForFolder = sPath
End Function

Private Sub cmdBrowse_Click()
Dim sStr As String

sStr = fBrowseForFolder(hWnd, "Click on an entry to select it.")
If sStr <> "" Then
MsgBox sStr, vbInformation, "Directory Browser"
End If
End Sub

Private Sub cmdQuit_Click()
Unload Me
End Sub

Private Sub Form_Load()
Option1(0).Value = True
End Sub













( controllicommondialogcondirectoryefiles.html )- by Paolo Puglisi - Modifica del 17/12/2023