「フォルダの参照」ダイアログのタイトル変更

VB2005　で「フォルダの参照」ダイアログのタイトル文言を任意に変更したいのですが，どうすればいいでしょう？
他のコモンダイアログには　Text　というメンバーがあり，自由に変更できるようですが，「フォルダの参照」ダイアログには見当たりません。
よろしくお願いします。

No.2 回答者： 1050YEN 回答日時： 2007/09/19 04:53

APIでフォルダの選択のダイアログを表示し、コールバック関数の中で、自力で書き換えるしかないように思います。

FolderBrowserDialogクラス
に似せた
FolderBrowserDlgクラス
を自作してみました。

注意
※サンプルですので、バグがあっても、見なかったことにしてください。
※OSがWin98以下でも使用する場合は、サンプルのBIF_XXXX系のパラメータの一部が使用できません。
　ですので、Win98以下の環境でも稼動をサポートするのであれば、それようのコードを追加しなければなりません。


こういう制限があることを承知でダイアログタイトルを変更したいのであれば、どうぞサンプルを流用してください。
私なら、もしこれが業務アプリならば、ここまでやらなければいけないタイトルの変更は避けます。





'----------------------------------------
'クラス：FolderBrowserDlg
'----------------------------------------
Imports System.Runtime.InteropServices
Public Class FolderBrowserDlg

#Region "宣言"

#Region "フォルダ表示APIのコールバック用"
　　Private Delegate Function BFFCALLBACK(ByVal hwnd As IntPtr, ByVal uMsg As Integer, ByVal lParam As IntPtr, ByVal lpData As IntPtr) As Integer
#End Region

#Region "API関連"
　　Private Const MAX_PATH As Integer = 260
　　Private Const BFFM_INITIALIZED As Integer = 1
　　Private Const BFFM_SELCHANGED As Integer = 2
　　Private Const BFFM_VALIDATEFAILED As Integer = 3

　　Private Const WM_USER As Integer = &H400
　　Private Const BFFM_SETSTATUSTEXTA As Integer = (WM_USER + 100)
　　Private Const BFFM_ENABLEOK As Integer = (WM_USER + 101)
　　Private Const BFFM_SETSELECTION As Integer = (WM_USER + 102)

　　Private Enum BIF
　　　　BIF_RETURNONLYFSDIRS = &H1
　　　　BIF_DONTGOBELOWDOMAIN = &H2
　　　　BIF_STATUSTEXT = &H4
　　　　BIF_RETURNFSANCESTORS = &H8
　　　　BIF_EDITBOX = &H10
　　　　BIF_VALIDATE = &H20
　　　　BIF_NEWDIALOGSTYLE = &H40
　　　　BIF_USENEWUI = &H50
　　　　BIF_BROWSEINCLUDEURLS = &H80
　　　　BIF_UAHINT = &H100
　　　　BIF_NONEWFOLDERBUTTON = &H200
　　　　BIF_NOTRANSLATETARGETS = &H400
　　　　BIF_BROWSEFORCOMPUTER = &H1000
　　　　BIF_BROWSEFORPRINTER = &H2000
　　　　BIF_BROWSEINCLUDEFILES = &H4000
　　　　BIF_SHAREABLE = &H8000
　　End Enum
　　<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)> Private Structure BROWSEINFO
　　　　Public hWndOwner As IntPtr
　　　　Public pidlRoot As System.Environment.SpecialFolder
　　　　Public pszDisplayName As IntPtr
　　　　<MarshalAs(UnmanagedType.LPTStr)> Public lpszTitle As String
　　　　Public ulFlags As BIF
　　　　<MarshalAs(UnmanagedType.FunctionPtr)> Public lpfn As BFFCALLBACK
　　　　Public lParam As IntPtr
　　　　Public iImage As Integer
　　End Structure

　　<DllImport("shell32.dll", CharSet:=CharSet.Auto)> Private Shared Function SHBrowseForFolder(ByRef bi As BROWSEINFO) As IntPtr
　　End Function
　　<DllImport("shell32.dll", CharSet:=CharSet.Auto)> Private Shared Function SHGetPathFromIDList(ByVal pidl As IntPtr, ByVal pszPath As System.Text.StringBuilder) As Integer
　　End Function
　　<DllImport("user32.dll", CharSet:=CharSet.Auto)> Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
　　End Function
　　<DllImport("user32.dll", CharSet:=CharSet.Auto)> Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByRef lParam As System.Text.StringBuilder) As Integer
　　End Function
　　<DllImport("user32.dll", CharSet:=CharSet.Auto)> Private Shared Function SetWindowText(ByVal hWnd As IntPtr, ByVal lpString As System.Text.StringBuilder) As Integer
　　End Function
#End Region

#End Region

　　Private udtBrowseInfo As BROWSEINFO = New BROWSEINFO

#Region "インストラクタ"
　　''' <summary>
　　''' インストラクタ
　　''' </summary>
　　''' <remarks></remarks>
　　Public Sub New()
　　　　With Me
　　　　　　.RootFolder = Environment.SpecialFolder.Desktop
　　　　　　.Description = "解説文"
　　　　　　.SelectedPath = ""
　　　　End With

　　　　With udtBrowseInfo
　　　　　　.ulFlags = BIF.BIF_RETURNONLYFSDIRS Or BIF.BIF_NEWDIALOGSTYLE
　　　　　　.lpfn = AddressOf BrowseCallbackProc
　　　　　　.lParam = IntPtr.Zero
　　　　　　.iImage = 0
　　　　End With


　　End Sub
#End Region

#Region "ダイアログの表示"
　　''' <summary>
　　''' ダイアログの表示
　　''' </summary>
　　''' <param name="owner"></param>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Public Function ShowDialog(ByVal owner As System.Windows.Forms.IWin32Window) As Windows.Forms.DialogResult
　　　　Dim l_dlgRet As Windows.Forms.DialogResult = DialogResult.Cancel
　　　　With udtBrowseInfo
　　　　　　'ベースとなる親ハンドル
　　　　　　.hWndOwner = owner.Handle
　　　　End With

　　　　Dim lngRetValue As IntPtr = SHBrowseForFolder(udtBrowseInfo)
　　　　If lngRetValue.Equals(IntPtr.Zero) Then
　　　　　　GoTo PGMEND
　　　　End If

　　　　Dim l_strパス As String = ""
　　　　取得_選択フォルダ(lngRetValue, l_strパス)
　　　　Me.SelectedPath = l_strパス

　　　　l_dlgRet = DialogResult.OK
PGMEND:
　　　　Return l_dlgRet
　　End Function
#End Region

#Region "プロパティ"

#Region "プロパティ:ダイアログルート"
　　''' <summary>
　　''' ダイアログルート
　　''' </summary>
　　''' <value></value>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Public Property RootFolder() As System.Environment.SpecialFolder
　　　　Get
　　　　　　Return Me.udtBrowseInfo.pidlRoot
　　　　End Get
　　　　Set(ByVal value As System.Environment.SpecialFolder)
　　　　　　Me.udtBrowseInfo.pidlRoot = value
　　　　End Set
　　End Property
#End Region

#Region "プロパティ:新規フォルダ作成ボタンの表示/非表示"
　　''' <summary>
　　''' 新規フォルダ作成ボタンの表示/非表示
　　''' </summary>
　　''' <value></value>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Public Property ShowNewFolderButton() As Boolean
　　　　Get
　　　　　　Return (Me.udtBrowseInfo.ulFlags And BIF.BIF_NONEWFOLDERBUTTON) = 0
　　　　End Get
　　　　Set(ByVal value As Boolean)
　　　　　　If value Then
　　　　　　　　Me.udtBrowseInfo.ulFlags = Me.udtBrowseInfo.ulFlags And Not BIF.BIF_NONEWFOLDERBUTTON
　　　　　　Else
　　　　　　　　Me.udtBrowseInfo.ulFlags = Me.udtBrowseInfo.ulFlags Or BIF.BIF_NONEWFOLDERBUTTON
　　　　　　End If
　　　　End Set
　　End Property
#End Region

#Region "プロパティ:エディットコントロールの表示の表示/非表示"
　　''' <summary>
　　''' エディットコントロールの表示の表示/非表示
　　''' </summary>
　　''' <value></value>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Public Property ShowEditBox() As Boolean
　　　　Get
　　　　　　Return (Me.udtBrowseInfo.ulFlags And BIF.BIF_EDITBOX) = BIF.BIF_EDITBOX
　　　　End Get
　　　　Set(ByVal value As Boolean)
　　　　　　If value Then
　　　　　　　　Me.udtBrowseInfo.ulFlags = Me.udtBrowseInfo.ulFlags Or BIF.BIF_EDITBOX
　　　　　　Else
　　　　　　　　Me.udtBrowseInfo.ulFlags = Me.udtBrowseInfo.ulFlags And Not BIF.BIF_EDITBOX
　　　　　　End If
　　　　End Set
　　End Property
#End Region

#Region "プロパティ:解説文"
　　''' <summary>
　　''' 解説文
　　''' </summary>
　　''' <value></value>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Public Property Description() As String
　　　　Get
　　　　　　Dim l_sb As New System.Text.StringBuilder(Me.udtBrowseInfo.lpszTitle)
　　　　　　Return l_sb.ToString()
　　　　End Get
　　　　Set(ByVal value As String)
　　　　　　Dim l_sb As New System.Text.StringBuilder(value)
　　　　　　Me.udtBrowseInfo.lpszTitle = l_sb.ToString() & vbNullChar
　　　　End Set
　　End Property
#End Region

#Region "プロパティ:選択パス"
　　Private m_strSelectedPath As String = ""
　　''' <summary>
　　''' 選択パス
　　''' </summary>
　　''' <value></value>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Public Property SelectedPath() As String
　　　　Get
　　　　　　Return m_strSelectedPath
　　　　End Get
　　　　Set(ByVal value As String)
　　　　　　m_strSelectedPath = value
　　　　End Set
　　End Property
#End Region

#Region "プロパティ:タイトル"
　　Private m_strTitle As String = ""
　　''' <summary>
　　''' タイトル
　　''' </summary>
　　''' <value></value>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Public Property Title() As String
　　　　Get
　　　　　　Return m_strTitle
　　　　End Get
　　　　Set(ByVal value As String)
　　　　　　m_strTitle = value
　　　　End Set
　　End Property
#End Region

#End Region

#Region "コールバック関数"
　　''' <summary>
　　''' コールバック関数
　　''' </summary>
　　''' <param name="hwnd"></param>
　　''' <param name="uMsg"></param>
　　''' <param name="lParam"></param>
　　''' <param name="lpData"></param>
　　''' <returns></returns>
　　''' <remarks>APIでフォルダ選択を表示する構造体に、以下の関数ポインタを設定することにより、呼び出される</remarks>
　　Private Function BrowseCallbackProc(ByVal hwnd As IntPtr, ByVal uMsg As Integer, ByVal lParam As IntPtr, ByVal lpData As IntPtr) As Integer
　　　　Select Case uMsg
　　　　　　Case BFFM_INITIALIZED
　　　　　　　　'-- タイトル指定の設定
　　　　　　　　If (Me.Title.Length > 0) Then
　　　　　　　　　　Call SetWindowText(hwnd, New System.Text.StringBuilder(Me.Title))
　　　　　　　　End If

　　　　　　　　'-- 初期フォルダの設定
　　　　　　　　If (Me.SelectedPath.Length > 0) Then
　　　　　　　　　　Dim l_strパス As String = Me.SelectedPath & vbNullChar
　　　　　　　　　　Dim bytPortName() As Byte = System.Text.Encoding.Default.GetBytes(l_strパス)
　　　　　　　　　　Dim gch As GCHandle = GCHandle.Alloc(bytPortName, GCHandleType.Pinned)
　　　　　　　　　　Call SendMessage(hwnd, BFFM_SETSELECTION, 1, gch.AddrOfPinnedObject())
　　　　　　　　　　gch.Free()
　　　　　　　　End If

　　　　　　Case BFFM_SELCHANGED
　　　　　　　　'.ulFlags にBIF_NEWDIALOGSTYLEを設定すると、存在しないフォルダでも、OKボタンを押せてしまうのを防ぐ対応
　　　　　　　　If Not 取得_選択フォルダ(lParam) Then
　　　　　　　　　　Call SendMessage(hwnd, BFFM_ENABLEOK, 0, 0)
　　　　　　　　End If

　　　　End Select
　　End Function
#End Region

#Region "選択フォルダ取得関数"
　　''' <summary>
　　''' 取得_選択フォルダ
　　''' </summary>
　　''' <param name="pidl"></param>
　　''' <param name="p_strパス"></param>
　　''' <returns></returns>
　　''' <remarks></remarks>
　　Private Function 取得_選択フォルダ(ByVal pidl As IntPtr, ByRef p_strパス As String) As Boolean
　　　　Dim l_blnRet As Boolean

　　　　' 現在選択されているフォルダのパスを得る。
　　　　Dim l_sb As New System.Text.StringBuilder(MAX_PATH)
　　　　Dim l_intResult As Integer = SHGetPathFromIDList(pidl, l_sb)
　　　　If (l_intResult <> 0) Then
　　　　　　p_strパス = l_sb.ToString()
　　　　　　l_blnRet = True
　　　　End If
　　　　Return l_blnRet
　　End Function
　　Private Function 取得_選択フォルダ(ByVal pidl As IntPtr) As Boolean
　　　　Return 取得_選択フォルダ(pidl, "")
　　End Function
#End Region

End Class


'----------------------------------------
'フォーム：Form1
'----------------------------------------
Public Class Form1
　　Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
　　　　Dim l_obj As New FolderBrowserDlg()
　　　　l_obj.Title = "ダイアログのタイトル"
　　　　l_obj.Description = "フォルダの選択をさせるための説明"
　　　　l_obj.SelectedPath = "C:\Program Files"

　　　　'新規フォルダボタン
　　　　l_obj.ShowNewFolderButton = False
　　　　'エディットコントロールの表示
　　　　l_obj.ShowEditBox = True

　　　　'フォルダ選択を表示
　　　　If l_obj.ShowDialog(Me) = DialogResult.OK Then
　　　　　　'取得結果
　　　　　　MsgBox(l_obj.SelectedPath)
　　　　End If
　　End Sub
End Class

この回答へのお礼

回答ありがとうございます
タイトル変えるだけでこんなに大変なことになるならあきらめます。
大変ご苦労かけましてありがとうございました。

お礼日時：2007/09/19 11:48

No.1 回答者： sugao_chib 回答日時： 2007/09/18 18:08

こんにちは

descriptionではダメなのでしょうか

この回答へのお礼

Descriptionでは説明文だけなのでだめです
タイトルバーに好きな文字を表示したいのです
他のコモンダイアログだと　Title　とか　lpstrTitle　とかで設定できるみたいなのですが「フォルダ参照」にはありません

よろしくお願いします

お礼日時：2007/09/18 20:11