dポイントプレゼントキャンペーン実施中!

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

A 回答 (2件)

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
    • good
    • 1
この回答へのお礼

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

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

こんにちは


descriptionではダメなのでしょうか
    • good
    • 0
この回答へのお礼

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

よろしくお願いします

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

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!