| 投稿日 | ： 2007/02/14(Wed) 15:36 |
| 投稿者 | ： Edward |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^6: SHBrowseForFolderに[新しいフォルダ]ボタン |
以下の様な事をやっております。
BIF_NEWDIALOGSTYLE設定時のOKボタンのEnabled設定は
BFFM_SELCHANGEDイベントの中で以下の様な記述で出来たのですが
このイベント内でタイトルも変更したいと考えているのですが
難儀しております。何方か御指導いただけますようよろしくお願いいたします。
****.frm
Private Sub cmdFolder_Click()
Dim szPath As String
szPath = BrowseForFolder(txtPath.Text, Me.hWnd, "保存先")
End Sub
***.mod
Public Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal lpszPath As String) 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 Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpbi 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 hMem As Long)
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS As Long = &H1 'only file system directories
Private Const BIF_STATUSTEXT As Long = &H4 'include status area for callback
Private Const BIF_NEWDIALOGSTYLE As Long = &H40 'use the new dialog layout
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Private Const BFFM_ENABLEOK = (WM_USER + 101)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Type BrowseInfo
hwndOwner 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
Public Function BrowseForFolder(DefaultFolder As String, Parent As Long, Caption As String) As String
Dim bi As BrowseInfo
Dim sResult As String, nResult As Long
bi.hwndOwner = Parent
bi.pIDLRoot = 0
bi.pszDisplayName = String$(MAX_PATH, Chr$(0))
bi.lpszTitle = Caption
bi.ulFlags = BIF_RETURNONLYFSDIRS Or BIF_NEWDIALOGSTYLE
bi.lpfn = GetAddress(AddressOf BrowseCallbackProc)
bi.lParam = 0
bi.iImage = 0
nResult = SHBrowseForFolder(bi)
If nResult <> 0 Then
sResult = String(MAX_PATH, 0)
If SHGetPathFromIDList(nResult, sResult) Then
BrowseForFolder = Left$(sResult, InStr(sResult, Chr$(0)) - 1)
End If
CoTaskMemFree nResult
End If
End Function
Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
Dim strBuffer As String
Dim lngResult As Long
Select Case uMsg
Case BFFM_INITIALIZED
Case BFFM_SELCHANGED
strBuffer = String(MAX_PATH + 1, vbNullChar)
' 現在選択されているフォルダのパスを得る。
lngResult = SHGetPathFromIDList(lParam, strBuffer)
If lngResult <> 0 Then 'フォルダを選んでいる場合
Else 'フォルダ以外を選んでいる場合、OKボタンを使用不可にする。
Call SendMessage(hWnd, BFFM_ENABLEOK, 0, ByVal 0&)
End If
End Select
End Function
Private Function GetAddress(nAddress As Long) As Long
GetAddress = nAddress
End Function