The ccrp control does not use the newstyle flag; it was created ages before
that became available -- Brad uses subclassing magic to put a button on the
ccrp browse dialog to create the new folder.
--
Randy Birch
MS MVP Visual Basic
http://vbnet.mvps.org/
Please reply to the newsgroups so all can participate.
Thorsten Albers said:
From: "Thorsten Albers" <
[email protected]>
Date: Sun, 19 Nov 2006 13:51:01 -0800
Lines: 1
To let us be able to help you please post your code (the code which
performs the call to SHBrowseForFolder() as well as the main code parts of
you hook procedure). It is very likely that the problem is buried somewhere
in this code.
Thanks. Hope you can help.
I downloaded VB code from several places with SHBrowseForFolder and
NEWDIALOGSTYLE. None will work. They're all the same as my code. I
downloaded the BrowseDialog Server from
http://ccrp.mvps.org and that works.
Dim reportpath$, a$
reportpath = RegFunGetValue(HKEY_CURRENT_USER, regkey, "reportpath", "")
If right(reportpath, 1) = "\" Then reportpath = left(reportpath,
Len(reportpath) - 1)
On Error Resume Next
a = IIf(Len(reportpath) = 0, "", Dir(reportpath, vbDirectory))
If Err <> 0 Then a = ""
On Error GoTo 0
If Len(a) = 0 Or prompt Then
a = BrowseForFolderByPath(SBCMilesWork.hWnd, _
IIf(Len(reportpath) = 0, FolderLocation(0,
CSIDL_DESKTOP), reportpath), _
"Report Path", _
"Choose path for report files", _
True, _
False, _
False)
Private Const MAX_PATH = 260
Private Const WM_USER = &H400&
Private Const BIF_STATUSTEXT = &H4&
Private Const BIF_RETURNONLYFSDIRS = &H1&
Private Const BIF_DONTGOBELOWDOMAIN = &H2&
Private Const BIF_SHAREABLE = &H80
Private Const BIF_NEWDIALOGSTYLE = &H40
Private Const BIF_UAHINT = &H100
Private Const BIF_VALIDATE = &H20
Private Const BIF_NONEWFOLDERBUTTON = &H200
Private Const BIF_EDITBOX = &H10
Private Const BIF_USENEWUI As Long = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BFFM_INITIALIZED = &H1&
Private Const BFFM_SELCHANGED = &H2&
Private Const BFFM_IUNKNOWN = &H5&
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
ByVal lParam 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
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Public Declare Function SetWindowText Lib "User32.dll" Alias
"SetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String) As Long
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 Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private startfolder$, title$
Public Function BrowseForFolderByPath$(hWnd&, _
StartPath$, _
WindowCaption$, _
Description$, _
ShowCreate As Boolean, _
ShowEdit As Boolean, _
ShowHint As Boolean)
Dim idlist&, sbuf$, BI As BrowseInfo
startfolder = StartPath & vbNullChar
title = WindowCaption
With BI
.hWndOwner = hWnd
.lpszTitle = lstrcat(Description, vbNullChar)
'.ulFlags = BIF_RETURNONLYFSDIRS Or _
BIF_STATUSTEXT Or _
IIf(ShowCreate, 0, BIF_NONEWFOLDERBUTTON) Or _
IIf(ShowEdit, BIF_EDITBOX, 0) Or _
IIf(ShowHint, BIF_UAHINT, 0)
.ulFlags = BIF_RETURNONLYFSDIRS Or _
BIF_STATUSTEXT Or _
BIF_NEWDIALOGSTYLE Or _
IIf(ShowCreate, 0, BIF_NONEWFOLDERBUTTON) Or _
IIf(ShowEdit, BIF_EDITBOX, 0) Or _
IIf(ShowHint, BIF_UAHINT, 0)
.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)
End With
idlist = SHBrowseForFolder(BI)
If idlist _
Then
sbuf = String(MAX_PATH, 0)
SHGetPathFromIDList idlist, sbuf
sbuf = left(sbuf, InStr(sbuf, vbNullChar) - 1)
BrowseForFolderByPath = sbuf
CoTaskMemFree idlist
Else
BrowseForFolderByPath = ""
End If
End Function
Private Function BrowseCallbackProc&(ByVal hWnd&, ByVal uMsg&, ByVal lp&,
ByVal pData&)
Dim sbuf$
On Error Resume Next
'Debug.Print "hwnd=" & hWnd & " uMsg=" & uMsg & " lp=" & lp & " pData=" &
pData
Select Case uMsg
Case BFFM_INITIALIZED
SendMessage hWnd, BFFM_SETSELECTION, 1, startfolder
If Len(title) > 0 Then SetWindowText hWnd, title
Case BFFM_SELCHANGED
sbuf = Space(MAX_PATH)
If SHGetPathFromIDList(lp, sbuf) = 1 Then SendMessage hWnd,
BFFM_SETSTATUSTEXT, 0, sbuf
End Select
BrowseCallbackProc = 0
End Function
Private Function GetAddressofFunction&(add&)
GetAddressofFunction = add
End Function
