Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
'Credit: Jose Roca
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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 Long) As 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 String) As 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 Dword) As 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
http://www.garybeene.com/sw/gbsnippets.htm