SHBrowseForFolder

Category: Files/Folders

Date: 03-28-2012

Return to Index


 
'Compilable Example:
'Credit: Jose Roca
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
 
#Include "WIN32API.Inc"
 
' ****************************************************************************************
' Browse for folder dialog procedure
' ****************************************************************************************
 
Function BrowseForFolderProc (ByVal hWnd As Dword, ByVal wMsg As Dword, ByVal wParam As Dword, ByVal lParam As LongAs Long
 
   Local szBuffer As Asciiz * %MAX_PATH
 
   If wMsg = %BFFM_INITIALIZED Then
      SendMessage hWnd, %BFFM_SETSELECTION, %TRUE, lParam
   ElseIf wMsg = %BFFM_SELCHANGED Then
      SHGetPathFromIDList ByVal wParam, szBuffer
      If IsFalse wParam Or _                            ' No id number
            IsFalse Len(szBuffer) Or _                     ' No name
            IsFalse (GetAttr(szBuffer) And %SubDir) Or _   ' Not a real subdir
            Mid$(szBuffer, 2, 1) <> ":Then               ' Not a local or mapped drive
         SendMessage hWnd, %BFFM_ENABLEOK, %FALSE, %FALSE
         Beep
      ElseIf (GetAttr(szBuffer) And %System) And Right$(szBuffer,2) <> ":\Then ' exclude system folders, allow root directories
         SendMessage hWnd, %BFFM_ENABLEOK, %FALSE, %FALSE
         Beep
      End If
   End If
 
End Function
   ' ****************************************************************************************
 
   ' ****************************************************************************************
   ' Browse for folder dialog
   ' ****************************************************************************************
 
Function BrowseForFolder (hWnd As Dword, strTitle As String, StartFolder As StringAs String
 
   Local szBuffer   As Asciiz * %MAX_PATH
   Local bi         As BROWSEINFO
   Local lpIDList   As Long
 
   bi.hWndOwner    = hWnd
   bi.lpszTitle    = StrPtr(strTitle)
   bi.ulFlags      = %BIF_ReturnOnlyFSDirs Or %BIF_DontGoBelowDomain Or %BIF_UseNewUI Or %BIF_ReturnFSAncestors
   bi.lpfnCallback = CodePtr(BrowseForFolderProc)
   bi.lParam       = StrPtr(StartFolder)
   lpIDList        = SHBrowseForFolder(bi)
 
   If IsTrue lpIDList And SHGetPathFromIDList(ByVal lpIDList, szBuffer) Then
      Function = szBuffer
      CoTaskMemFree lpIDList
   End If
 
End Function
   ' ****************************************************************************************
 
   Declare CallBack Function ShowDIALOG1Proc()
 
CallBack Function ShowDIALOG1Proc()
   Local A1 As Long
 
   Select Case As Long CbMsg
      Case %WM_InitDialog
         ? BrowseForFolder(0, "Choose a folder", "C:\PBWIN80\SAMPLES\")
 
   End Select
 
End Function
 
Function ShowDIALOG1(ByVal hParent As DwordAs Long
   Local lRslt As Long
   Local X&, Y&
 
   Local hDlg As Dword
 
   Dialog New hParent, "Test Repository", 181, 78, 389, 387, %WS_Popup Or _
      %WS_Border Or %WS_DlgFrame Or %WS_SysMenu Or %WS_MinimizeBox Or _
      %WS_MaximizeBox Or %WS_ClipSiblings Or %WS_Visible Or %DS_ModalFrame _
      Or %DS_SetForeground Or %DS_3DLook Or %DS_NoFailCreate Or _
      %DS_SetFont, %WS_Ex_Windowedge Or %WS_Ex_ControlParent Or _
      %WS_Ex_Left Or %WS_Ex_LtrReading Or %WS_Ex_RightScrollbar, To hDlg
 
   Dialog Show Modal hDlg, Call ShowDIALOG1Proc To lRslt
 
   Function = lRslt
End Function
 
Function PBMain () As Long
 
   ShowDIALOG1 %HWND_Desktop
 
End Function
 
'gbs_00848
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm