caraf_g
asked on
A component for Browse for Folder?
Having hacked away at Shell32.dll 's version of SHBrowseForFolder I'm about
to throw in the towel...
The problem with the above is that
1 - I cannot control where the dialog is going to appear
2 - I cannot set a startup folder, so the thing always pops up with focus on
"My Computer" and everything collapsed.
Apart from that, it just doesn't look nice.
The MSDN Help tantalisingly mentions the above method under the heading of "Browse for a Folder the Non-COM Way", which seems to indicate that there also must be a "Browse for a Folder the COM Way"?
It even mentions it:
"In a later article, you can compare it to the COM way, with a guided tour of SHDOCVW.DLL and the powerful shell features it provides."
Guess what, the "later article" is nowhere to be found. I'm about ready to fly over to Seattle and strangle Bill myself.
Anyone?
I'm not interested in solutions creating a dialog myself with Drive/File and Dir listboxes. The "common dialog" is out there, I want to use it.
to throw in the towel...
The problem with the above is that
1 - I cannot control where the dialog is going to appear
2 - I cannot set a startup folder, so the thing always pops up with focus on
"My Computer" and everything collapsed.
Apart from that, it just doesn't look nice.
The MSDN Help tantalisingly mentions the above method under the heading of "Browse for a Folder the Non-COM Way", which seems to indicate that there also must be a "Browse for a Folder the COM Way"?
It even mentions it:
"In a later article, you can compare it to the COM way, with a guided tour of SHDOCVW.DLL and the powerful shell features it provides."
Guess what, the "later article" is nowhere to be found. I'm about ready to fly over to Seattle and strangle Bill myself.
Anyone?
I'm not interested in solutions creating a dialog myself with Drive/File and Dir listboxes. The "common dialog" is out there, I want to use it.
CommonDialog1.InitDir = "C:\"
CommonDialog1.CancelError = True
CommonDialog1.Filter = "All files(*.*)|*.*"
CommonDialog1.ShowOpen
CommonDialog1.CancelError = True
CommonDialog1.Filter = "All files(*.*)|*.*"
CommonDialog1.ShowOpen
ASKER
Sorry, Juilette..
I'm looking for Browse For FOLDER, not an Open File dialog!
I'm looking for Browse For FOLDER, not an Open File dialog!
I'm using this
' Form code, add 1 textbox
Option Explicit
Private Sub Form_Click()
On Error Resume Next
Dim strResult As String, prompt As String
prompt = "Copy modules to Folder: " & Text1.Text
strResult = BrowseForFolder(hwnd, Text1.Text, prompt)
If Len(strResult) > 0 Then
Text1.Text = strResult
End If
End Sub
' module code
Option Explicit
'common to both methods
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib _
"shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv 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 Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode'calls for NT.
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
'If the lParam parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED'mess age.
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
'specific to the PIDL method'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Private Declare Function SHSimpleIDListFromPath Lib _
"shell32" Alias "#162" _
(ByVal szPath As String) As Long 'specific to the STRING method
Private Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
Private Function BrowseCallbackProcStr(ByVa l hwnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse STRING method.
'On initialization, set the dialog's 'pre-selected folder from the pointer
'to the path allocated as bi.lParam,
'passed back to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
True, ByVal StrFromPtrA(lpData))
Case Else:
End Select
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse PIDL method.
'On initialization, set the dialog's
'pre-selected folder using the pidl
'set as the bi.lParam, and passed back
'to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
False, ByVal lpData)
Case Else:
End Select
End Function
Private Function FARPROC(pfn As Long) As Long
'A dummy procedure that receives and returns
'the value of the AddressOf operator.
'Obtain and set the address of the callback
'This workaround is needed as you can't assign
'AddressOf directly to a member of a user-
'defined type, but you can assign it to another
'long and use that (as returned here)
FARPROC = pfn
End Function
Private Function StrFromPtrA(lpszA As Long) As String
'Returns an ANSII string from a pointer to an ANSII string.
Dim sRtn As String
sRtn = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal sRtn, ByVal lpszA)
StrFromPtrA = sRtn
End Function
Public Function BrowseForFolder(hwndOwner As Long, sSelPath As String, sPrompt As String) As String
Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH
With BI
.hOwner = hwndOwner
.pidlRoot = 0
.lpszTitle = sPrompt
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
lpSelPath = LocalAlloc(LPTR, Len(sSelPath))
MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
.lParam = lpSelPath
End With
pidl = SHBrowseForFolder(BI)
If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call LocalFree(lpSelPath)
End Function
' Form code, add 1 textbox
Option Explicit
Private Sub Form_Click()
On Error Resume Next
Dim strResult As String, prompt As String
prompt = "Copy modules to Folder: " & Text1.Text
strResult = BrowseForFolder(hwnd, Text1.Text, prompt)
If Len(strResult) > 0 Then
Text1.Text = strResult
End If
End Sub
' module code
Option Explicit
'common to both methods
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib _
"shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv 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 Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode'calls for NT.
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
'If the lParam parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED'mess
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
'specific to the PIDL method'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Private Declare Function SHSimpleIDListFromPath Lib _
"shell32" Alias "#162" _
(ByVal szPath As String) As Long 'specific to the STRING method
Private Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
Private Function BrowseCallbackProcStr(ByVa
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse STRING method.
'On initialization, set the dialog's 'pre-selected folder from the pointer
'to the path allocated as bi.lParam,
'passed back to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
True, ByVal StrFromPtrA(lpData))
Case Else:
End Select
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse PIDL method.
'On initialization, set the dialog's
'pre-selected folder using the pidl
'set as the bi.lParam, and passed back
'to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
False, ByVal lpData)
Case Else:
End Select
End Function
Private Function FARPROC(pfn As Long) As Long
'A dummy procedure that receives and returns
'the value of the AddressOf operator.
'Obtain and set the address of the callback
'This workaround is needed as you can't assign
'AddressOf directly to a member of a user-
'defined type, but you can assign it to another
'long and use that (as returned here)
FARPROC = pfn
End Function
Private Function StrFromPtrA(lpszA As Long) As String
'Returns an ANSII string from a pointer to an ANSII string.
Dim sRtn As String
sRtn = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal sRtn, ByVal lpszA)
StrFromPtrA = sRtn
End Function
Public Function BrowseForFolder(hwndOwner As Long, sSelPath As String, sPrompt As String) As String
Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH
With BI
.hOwner = hwndOwner
.pidlRoot = 0
.lpszTitle = sPrompt
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
lpSelPath = LocalAlloc(LPTR, Len(sSelPath))
MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
.lParam = lpSelPath
End With
pidl = SHBrowseForFolder(BI)
If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call LocalFree(lpSelPath)
End Function
shlwapi.dll: useful functions
http://codeguru.developer.com/bbs/wt/showpost.pl?Board=vb&Number=9201&page=1&view=collapsed&sb=5
>>>
I've also added a couple of extra calls to the class module (StripToRoot, Compact (eg. c:\.....\test.exe) and StripExtension)
- I just can't believe that I've missed this functionality for so long !, time to rewrite lot's of old legacy code I think !
<<<
http://codeguru.developer.com/bbs/wt/showpost.pl?Board=vb&Number=9201&page=1&view=collapsed&sb=5
>>>
I've also added a couple of extra calls to the class module (StripToRoot, Compact (eg. c:\.....\test.exe) and StripExtension)
- I just can't believe that I've missed this functionality for so long !, time to rewrite lot's of old legacy code I think !
<<<
ameba wrote:
>shlwapi.dll: useful functions
but you mentioned the other sh... dll
>with a guided tour of SHDOCVW.DLL
Sorry.
>shlwapi.dll: useful functions
but you mentioned the other sh... dll
>with a guided tour of SHDOCVW.DLL
Sorry.
ASKER
Ok, Ameba... excellent so far...
How can I make the dialog appear in a particular location rather than where it wants to?
How can I make the dialog appear in a particular location rather than where it wants to?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Exactly, that's what I'm trying to avoid...
I've also posted this in devx, and some guy just came back with this comment:
"You need to pass a callback procedure in the .pFunc element of your
structure. Then, in the callback, you'll receive the message
BFFM_INITIALIZED. You can use this message to move the window
whereever you want it."
Does that make sense to you?
I've also posted this in devx, and some guy just came back with this comment:
"You need to pass a callback procedure in the .pFunc element of your
structure. Then, in the callback, you'll receive the message
BFFM_INITIALIZED. You can use this message to move the window
whereever you want it."
Does that make sense to you?
ASKER
<doh>
Just use MoveWindow API in the callback routine. Gotcha!
Just use MoveWindow API in the callback routine. Gotcha!
ASKER
;-)
caraf_g,
Take a look at the following references:
HOWTO: Browse for Folders from the Current Directory
http://support.microsoft.com/support/kb/articles/Q179/3/78.ASP
Browse for a Folder the COM Way
http://msdn.microsoft.com/library/periodic/period99/html/08vcd/vc99h8.htm
Browse for a Folder the Non-COM Way
http://msdn.microsoft.com/library/periodic/period99/html/vc99c1.htm
HOWTO: Select a Directory Without the Common Dialog Control
http://support.microsoft.com/support/kb/articles/Q179/4/97.ASP
Cheers!
Take a look at the following references:
HOWTO: Browse for Folders from the Current Directory
http://support.microsoft.com/support/kb/articles/Q179/3/78.ASP
Browse for a Folder the COM Way
http://msdn.microsoft.com/library/periodic/period99/html/08vcd/vc99h8.htm
Browse for a Folder the Non-COM Way
http://msdn.microsoft.com/library/periodic/period99/html/vc99c1.htm
HOWTO: Select a Directory Without the Common Dialog Control
http://support.microsoft.com/support/kb/articles/Q179/4/97.ASP
Cheers!
ASKER
mcrider, thanks for your references.
Just a quick question; how do you manage to find these? I find searching microsoft.com a nightmare, and I can't seem to be able to find what I'm looking for?
Just a quick question; how do you manage to find these? I find searching microsoft.com a nightmare, and I can't seem to be able to find what I'm looking for?
I use this URL as a starting point:
http://search.microsoft.com/us/dev/?MSCOMTB=ICP_SEARCH%20MSDN
Then I enable searching of "Additional Developer Content", "Knowledge Base",
and "Product Information"
This basically searches the entire online developers network...
Cheers!
http://search.microsoft.com/us/dev/?MSCOMTB=ICP_SEARCH%20MSDN
Then I enable searching of "Additional Developer Content", "Knowledge Base",
and "Product Information"
This basically searches the entire online developers network...
Cheers!
ASKER
Yes, I've been there too. So the only conclusion is that somehow I must not be able to phrase my searches correctly. What search criteria did you enter to come up with the above list?
ASKER
In the mean time, back at the ranch...
ameba, I've modified your code slightly, so now in the browseforfolder procedure you pass in an "Owner" window and a relative Left and Top position. The Browse For Folder dialog is then positioned nicely.
Modified code:
(.bas Module)
Option Explicit
'common to both methods
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib _
"shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv 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 Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode'calls for NT.
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
'If the lParam parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED'mess age.
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
'specific to the PIDL method'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Private Declare Function SHSimpleIDListFromPath Lib _
"shell32" Alias "#162" _
(ByVal szPath As String) As Long 'specific to the STRING method
Private Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private mlngLeft As Long
Private mlngTop As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Function BrowseCallbackProcStr(ByVa l hwnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse STRING method.
'On initialization, set the dialog's 'pre-selected folder from the pointer
'to the path allocated as bi.lParam,
'passed back to the callback as lpData param.
Dim orgPos As RECT
Select Case uMsg
Case BFFM_INITIALIZED
GetWindowRect hwnd, orgPos
MoveWindow hwnd, mlngLeft, mlngTop, orgPos.Right - orgPos.Left, orgPos.Bottom - orgPos.Top, True
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
True, ByVal StrFromPtrA(lpData))
Case Else:
End Select
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse PIDL method.
'On initialization, set the dialog's
'pre-selected folder using the pidl
'set as the bi.lParam, and passed back
'to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
False, ByVal lpData)
Case Else:
End Select
End Function
Private Function FARPROC(pfn As Long) As Long
'A dummy procedure that receives and returns
'the value of the AddressOf operator.
'Obtain and set the address of the callback
'This workaround is needed as you can't assign
'AddressOf directly to a member of a user-
'defined type, but you can assign it to another
'long and use that (as returned here)
FARPROC = pfn
End Function
Private Function StrFromPtrA(lpszA As Long) As String
'Returns an ANSII string from a pointer to an ANSII string.
Dim sRtn As String
sRtn = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal sRtn, ByVal lpszA)
StrFromPtrA = sRtn
End Function
Public Function BrowseForFolder(objOwner As Object, _
sSelPath As String, _
sPrompt As String, _
lngLeft As Long, _
lngTop As Long) As String
Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH
Dim lngAO As Long
Dim lngScaleBorder As Long
Dim objWork As Object
Set objWork = objOwner
mlngTop = lngTop
mlngLeft = lngLeft
On Error Resume Next
Do While True
lngScaleBorder = (objWork.Width - objWork.ScaleWidth) / 2
mlngTop = mlngTop + objWork.Top + objWork.Height - objWork.ScaleHeight - lngScaleBorder
mlngLeft = mlngLeft + objWork.Left + lngScaleBorder
If objWork.Container Is Nothing Then
Exit Do
End If
Set objWork = objWork.Container
Loop
mlngTop = (mlngTop + lngTop) / Screen.TwipsPerPixelY
mlngLeft = (mlngLeft + lngLeft) / Screen.TwipsPerPixelX
With BI
.hOwner = objOwner.hwnd
.pidlRoot = 0
.lpszTitle = sPrompt
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
lpSelPath = LocalAlloc(LPTR, Len(sSelPath))
MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
.lParam = lpSelPath
End With
pidl = SHBrowseForFolder(BI)
If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call LocalFree(lpSelPath)
End Function
ameba, I've modified your code slightly, so now in the browseforfolder procedure you pass in an "Owner" window and a relative Left and Top position. The Browse For Folder dialog is then positioned nicely.
Modified code:
(.bas Module)
Option Explicit
'common to both methods
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHBrowseForFolder Lib _
"shell32.dll" Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib _
"shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv 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 Sub MoveMemory Lib "kernel32" _
Alias "RtlMoveMemory" _
(pDest As Any, _
pSource As Any, _
ByVal dwLength As Long)
Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
'Constants ending in 'A' are for Win95 ANSI
'calls; those ending in 'W' are the wide Unicode'calls for NT.
'Sets the status text to the null-terminated
'string specified by the lParam parameter.
'wParam is ignored and should be set to 0.
Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)
'If the lParam parameter is non-zero, enables the
'OK button, or disables it if lParam is zero.'(docs erroneously said wParam!)
'wParam is ignored and should be set to 0.
Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
'Selects the specified folder. If the wParam
'parameter is FALSE, the lParam parameter is the
'PIDL of the folder to select , or it is the path
'of the folder if wParam is the C value TRUE (or 1).
'Note that after this message is sent, the browse
'dialog receives a subsequent BFFM_SELECTIONCHANGED'mess
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
'specific to the PIDL method'Undocumented call for the example. IShellFolder's
'ParseDisplayName member function should be used instead.
Private Declare Function SHSimpleIDListFromPath Lib _
"shell32" Alias "#162" _
(ByVal szPath As String) As Long 'specific to the STRING method
Private Declare Function LocalAlloc Lib "kernel32" _
(ByVal uFlags As Long, _
ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" _
(ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" _
(lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" _
(lpString As Any) As Long
Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private mlngLeft As Long
Private mlngTop As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Function BrowseCallbackProcStr(ByVa
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse STRING method.
'On initialization, set the dialog's 'pre-selected folder from the pointer
'to the path allocated as bi.lParam,
'passed back to the callback as lpData param.
Dim orgPos As RECT
Select Case uMsg
Case BFFM_INITIALIZED
GetWindowRect hwnd, orgPos
MoveWindow hwnd, mlngLeft, mlngTop, orgPos.Right - orgPos.Left, orgPos.Bottom - orgPos.Top, True
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
True, ByVal StrFromPtrA(lpData))
Case Else:
End Select
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal lParam As Long, _
ByVal lpData As Long) As Long
'Callback for the Browse PIDL method.
'On initialization, set the dialog's
'pre-selected folder using the pidl
'set as the bi.lParam, and passed back
'to the callback as lpData param.
Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hwnd, BFFM_SETSELECTIONA, _
False, ByVal lpData)
Case Else:
End Select
End Function
Private Function FARPROC(pfn As Long) As Long
'A dummy procedure that receives and returns
'the value of the AddressOf operator.
'Obtain and set the address of the callback
'This workaround is needed as you can't assign
'AddressOf directly to a member of a user-
'defined type, but you can assign it to another
'long and use that (as returned here)
FARPROC = pfn
End Function
Private Function StrFromPtrA(lpszA As Long) As String
'Returns an ANSII string from a pointer to an ANSII string.
Dim sRtn As String
sRtn = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal sRtn, ByVal lpszA)
StrFromPtrA = sRtn
End Function
Public Function BrowseForFolder(objOwner As Object, _
sSelPath As String, _
sPrompt As String, _
lngLeft As Long, _
lngTop As Long) As String
Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH
Dim lngAO As Long
Dim lngScaleBorder As Long
Dim objWork As Object
Set objWork = objOwner
mlngTop = lngTop
mlngLeft = lngLeft
On Error Resume Next
Do While True
lngScaleBorder = (objWork.Width - objWork.ScaleWidth) / 2
mlngTop = mlngTop + objWork.Top + objWork.Height - objWork.ScaleHeight - lngScaleBorder
mlngLeft = mlngLeft + objWork.Left + lngScaleBorder
If objWork.Container Is Nothing Then
Exit Do
End If
Set objWork = objWork.Container
Loop
mlngTop = (mlngTop + lngTop) / Screen.TwipsPerPixelY
mlngLeft = (mlngLeft + lngLeft) / Screen.TwipsPerPixelX
With BI
.hOwner = objOwner.hwnd
.pidlRoot = 0
.lpszTitle = sPrompt
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
lpSelPath = LocalAlloc(LPTR, Len(sSelPath))
MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
.lParam = lpSelPath
End With
pidl = SHBrowseForFolder(BI)
If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call LocalFree(lpSelPath)
End Function
one word search: SHBrowseForFolder
You should get about 29 hits.
Cheers!
You should get about 29 hits.
Cheers!
ASKER
..and the code in the form. I added a picture box on it so I could choose between either the form or the picturebox as the "owner" of the dialog, by commenting one or the other line out.
' module code
Option Explicit
Private Sub Form_Click()
On Error Resume Next
Dim strResult As String, prompt As String
prompt = "Copy modules to Folder: " & Text1.Text
'strResult = BrowseForFolder(Me, Text1.Text, prompt, 0, 0)
strResult = BrowseForFolder(Picture1, Text1.Text, prompt, 0, 0)
If Len(strResult) > 0 Then
Text1.Text = strResult
End If
End Sub
' module code
Option Explicit
Private Sub Form_Click()
On Error Resume Next
Dim strResult As String, prompt As String
prompt = "Copy modules to Folder: " & Text1.Text
'strResult = BrowseForFolder(Me, Text1.Text, prompt, 0, 0)
strResult = BrowseForFolder(Picture1, Text1.Text, prompt, 0, 0)
If Len(strResult) > 0 Then
Text1.Text = strResult
End If
End Sub
Thanks for your points.
I keep this out of my projects as black box. Now I know where to go to update my dll.
I keep this out of my projects as black box. Now I know where to go to update my dll.
ASKER
ameba,
I have another question.
In the code the following values are defined
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
I'm currently using NT but I'm using BFFM_SETSELECTIONA
BFFM_SETSELECTIONW is used in Unicode (?) How do I know when I need to use one rather than the other?
I have another question.
In the code the following values are defined
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
I'm currently using NT but I'm using BFFM_SETSELECTIONA
BFFM_SETSELECTIONW is used in Unicode (?) How do I know when I need to use one rather than the other?
I use Win95 and BFFM_SETSELECTIONA.
I don't think you will ever need BFFM_SETSELECTIONW.
Another sample for Browse dialog
http://www.mvps.org/btmtz/
I don't think you will ever need BFFM_SETSELECTIONW.
Another sample for Browse dialog
http://www.mvps.org/btmtz/
Hello,
I am not sure if this will get anyone sent an email, I hope so. Awarding points are no problem, but I wanted to give this to you guys first so since I have been reading your post here. I have been struggling SHBrowseForFolder for a little while now. I am afraid I know the answer to my question, but you guys seem to be in the know on this stuff so I thought I would ask. I have used several samples from around the web and they work great except doing exactly what I need done. I want to browse a particular directory structure on a REMOTE computer. I have the callback working, but if I put, for example, "\\Remote Computer\" the directory structure comes back with the Network Neighborhood Root directory! If I do a local directory like "C:\Program Files\" then it works. Can you guys help me solve this one?
Kevin
I am not sure if this will get anyone sent an email, I hope so. Awarding points are no problem, but I wanted to give this to you guys first so since I have been reading your post here. I have been struggling SHBrowseForFolder for a little while now. I am afraid I know the answer to my question, but you guys seem to be in the know on this stuff so I thought I would ask. I have used several samples from around the web and they work great except doing exactly what I need done. I want to browse a particular directory structure on a REMOTE computer. I have the callback working, but if I put, for example, "\\Remote Computer\" the directory structure comes back with the Network Neighborhood Root directory! If I do a local directory like "C:\Program Files\" then it works. Can you guys help me solve this one?
Kevin
You most likely need to create a share on the remote computer and add it to the directory structure you want to view. For example,
\\Remote Computer\ShareName
Or if the user has sufficient rights, you could use the administrative share...
\\Remote Computer\c$
Note that you may need to create a share (above called "Share Name"). In NT, this is done by right clicking on a directory, selecting properties, and then selecting the "Sharing" tab. This dialog allows you to create a share.
\\Remote Computer\ShareName
Or if the user has sufficient rights, you could use the administrative share...
\\Remote Computer\c$
Note that you may need to create a share (above called "Share Name"). In NT, this is done by right clicking on a directory, selecting properties, and then selecting the "Sharing" tab. This dialog allows you to create a share.
Good point, but I tried that. I have Admin rights on the remote machine that I am working with, but still no luck. I can use the Common Dialog control and get into the Directory structure that way, so I don't think it is a network thing, I would use the Common Dialog control to do this, but I want to provide a way for the User to select a directory not a file.
'using API open commondialogue box and read file content into text box
'
'put this in a bas module
'
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOPENFILENAME As OPENFILENAME) As Long
'
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As String
lpstrFileTitle As String
nMaxFileTitle As String
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
'
'
'use in an event
'
' Call the Open File dialog box and look for *.txt files
Dim filebox As OPENFILENAME ' structure that sets the dialog box
Dim fname As String ' will receive selected file's name
Dim retval As Long ' return value
' Configure how the dialog box will look
filebox.lStructSize = Len(filebox) ' the size of the structure
filebox.hwndOwner = Form1.hWnd ' handle of the form calling the function
filebox.lpstrTitle = "Open File" ' text displayed in the box's title bar
' The next line sets up the file types drop-box
filebox.lpstrFilter = "Text Files" & vbNullChar & "*.txt" & vbNullChar & "All Files" & vbNullChar & "*.*" & vbNullChar & vbNullChar
filebox.lpstrFile = Space(255) ' initalize buffer that receives path and filename of file
filebox.nMaxFile = 255 ' length of file and pathname buffer
filebox.lpstrFileTitle = Space(255) ' initialize buffer that receives filename of file
filebox.nMaxFileTitle = 255 ' length of filename buffer
' Allow only existing files and hide the read-only check box
filebox.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
' Execute the dialog box
retval = GetOpenFileName(filebox)
If retval <> 0 Then ' if the dialog box completed successfully
' Remove null space from the file name
fname = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
Dim filenum As Integer
filenum = FreeFile
Dim strFile As String
'read the file in question and output it's content to text1 textbox
Open fname For Input As #1
Text1.Text = Input(LOF(1), 1)
Close #1
End If