Check this out : FolderBrowserDialogEx: A C# customization of FolderBrowserDialog
The code is in C#, Here is the VB Conversion
Imports System
Imports System.Collections.Generic
Imports System.Linq
Imports System.Text
Imports System.Drawing
Imports System.Runtime.InteropServices
Imports System.Windows.Forms
Imports System.Diagnostics
Namespace DaveChambers.FolderBrowserDialogEx
Public Class FolderBrowserDialogEx
#Region "Fields that mimic the same-named fields in FolderBrowserDialog"
Public Property RootFolder() As Environment.SpecialFolder
Get
Return m_RootFolder
End Get
Set
m_RootFolder = Value
End Set
End Property
Private m_RootFolder As Environment.SpecialFolder
Public Property SelectedPath() As String
Get
Return m_SelectedPath
End Get
Set
m_SelectedPath = Value
End Set
End Property
Private m_SelectedPath As String
Public Property ShowNewFolderButton() As Boolean
Get
Return m_ShowNewFolderButton
End Get
Set
m_ShowNewFolderButton = Value
End Set
End Property
Private m_ShowNewFolderButton As Boolean
Public Property StartPosition() As FormStartPosition
Get
Return m_StartPosition
End Get
Set
m_StartPosition = Value
End Set
End Property
Private m_StartPosition As FormStartPosition
#End Region
' Fields specific to CustomFolderBrowserDialog
Public Property Title() As String
Get
Return m_Title
End Get
Set
m_Title = Value
End Set
End Property
Private m_Title As String
Public Property ShowEditbox() As Boolean
Get
Return m_ShowEditbox
End Get
Set
m_ShowEditbox = Value
End Set
End Property
Private m_ShowEditbox As Boolean
' These are the control IDs used in the dialog
Private Structure CtlIds
Public Const PATH_EDIT As Integer = &H3744
'public const int PATH_EDIT_LABEL = 0x3748; // Only when BIF_NEWDIALOGSTYLE
Public Const TITLE As Integer = &H3742
Public Const TREEVIEW As Integer = &H3741
Public Const NEW_FOLDER_BUTTON As Integer = &H3746
Public Const IDOK As Integer = 1
Public Const IDCANCEL As Integer = 2
End Structure
<StructLayout(LayoutKind.Sequential, CharSet := CharSet.Unicode)> _
Public Structure InitData
' Titles shouldn't too long, should they?
<MarshalAs(UnmanagedType.ByValTStr, SizeConst := 128)> _
Public Title As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst := Win32.MAX_PATH)> _
Public InitialPath As String
Public ShowEditbox As Boolean
Public ShowNewFolderButton As Boolean
Public StartPosition As FormStartPosition
Public hParent As IntPtr
Public Sub New(dlg As FolderBrowserDialogEx, hParent As IntPtr)
' We need to make copies of these values from the dialog.
' I tried passing the dlg obj itself in this struct, but Windows will barf after repeated invocations.
Me.Title = dlg.Title
Me.InitialPath = dlg.SelectedPath
Me.ShowNewFolderButton = dlg.ShowNewFolderButton
Me.ShowEditbox = dlg.ShowEditbox
Me.StartPosition = dlg.StartPosition
Me.hParent = hParent
End Sub
End Structure
Public Sub New()
Title = "Browse For Folder"
' Default to same caption as std dialog
RootFolder = Environment.SpecialFolder.Desktop
SelectedPath = "c:\"
ShowEditbox = False
ShowNewFolderButton = False
StartPosition = FormStartPosition.WindowsDefaultLocation
End Sub
Public Function ShowDialog(owner As IWin32Window) As DialogResult
Dim initdata As New InitData(Me, owner.Handle)
Dim bi As New Win32.BROWSEINFO()
bi.iImage = 0
bi.hwndOwner = owner.Handle
If 0 <> Win32.SHGetSpecialFolderLocation(owner.Handle, CInt(Me.RootFolder), bi.pidlRoot) Then
bi.pidlRoot = IntPtr.Zero
End If
bi.lpszTitle = ""
bi.ulFlags = Win32.BIF_RETURNONLYFSDIRS
' do NOT use BIF_NEWDIALOGSTYLE or BIF_STATUSTEXT
If Me.ShowEditbox Then
bi.ulFlags = bi.ulFlags Or Win32.BIF_EDITBOX
End If
If Not Me.ShowNewFolderButton Then
bi.ulFlags = bi.ulFlags Or Win32.BIF_NONEWFOLDERBUTTON
End If
bi.lpfn = New Win32.BrowseCallbackProc(_browseCallbackHandler)
' Initialization data, used in _browseCallbackHandler
Dim hInit As IntPtr = Marshal.AllocHGlobal(Marshal.SizeOf(initdata))
Marshal.StructureToPtr(initdata, hInit, True)
bi.lParam = hInit
Dim pidlSelectedPath As IntPtr = IntPtr.Zero
Try
pidlSelectedPath = Win32.SHBrowseForFolder(bi)
Dim sb As New StringBuilder(256)
If Win32.SHGetPathFromIDList(pidlSelectedPath, sb) Then
SelectedPath = sb.ToString()
Return DialogResult.OK
End If
Finally
' Caller is responsible for freeing this memory.
Marshal.FreeCoTaskMem(pidlSelectedPath)
End Try
Return DialogResult.Cancel
End Function
Private Function _browseCallbackHandler(hDlg As IntPtr, msg As Integer, lParam As IntPtr, lpData As IntPtr) As Integer
Select Case msg
Case Win32.BFFM_INITIALIZED
' remove context help button from dialog caption
Dim lStyle As Integer = Win32.GetWindowLong(hDlg, Win32.GWL_STYLE)
lStyle = lStyle And Not Win32.DS_CONTEXTHELP
Win32.SetWindowLong(hDlg, Win32.GWL_STYLE, lStyle)
lStyle = Win32.GetWindowLong(hDlg, Win32.GWL_EXSTYLE)
lStyle = lStyle And Not Win32.WS_EX_CONTEXTHELP
Win32.SetWindowLong(hDlg, Win32.GWL_EXSTYLE, lStyle)
_adjustUi(hDlg, lpData)
Exit Select
Case Win32.BFFM_SELCHANGED
If True Then
Dim ok As Boolean = False
Dim sb As New StringBuilder(Win32.MAX_PATH)
If Win32.SHGetPathFromIDList(lParam, sb) Then
ok = True
Dim dir As String = sb.ToString()
Dim hEdit As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.PATH_EDIT)
Win32.SetWindowText(hEdit, dir)
#If UsingStatusText Then
' We're not using status text, but if we were, this is how you'd set it
Win32.SendMessage(hDlg, Win32.BFFM_SETSTATUSTEXTW, 0, dir)
#End If
#If SHBrowseForFolder_lists_links Then
' This check doesn't seem to be necessary - the SHBrowseForFolder dirtree doesn't seem to list links
Dim sfi As New Win32.SHFILEINFO()
Win32.SHGetFileInfo(lParam, 0, sfi, Marshal.SizeOf(sfi), Win32.SHGFI_PIDL Or Win32.SHGFI_ATTRIBUTES)
' fail if pidl is a link
If (sfi.dwAttributes And Win32.SFGAO_LINK) = Win32.SFGAO_LINK Then
ok = False
#End If
End If
End If
' if invalid selection, disable the OK button
If Not ok Then
Win32.EnableWindow(Win32.GetDlgItem(hDlg, CtlIds.IDOK), False)
End If
Exit Select
End If
End Select
Return 0
End Function
Private Sub _adjustUi(hDlg As IntPtr, lpData As IntPtr)
' Only do the adjustments if InitData was supplied
If lpData = IntPtr.Zero Then
Return
End If
Dim obj As Object = Marshal.PtrToStructure(lpData, GetType(InitData))
If obj Is Nothing Then
Return
End If
Dim initdata As InitData = DirectCast(obj, InitData)
' Only do the adjustments if we can find the dirtree control
Dim hTree As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.TREEVIEW)
If hTree = IntPtr.Zero Then
hTree = Win32.FindWindowEx(IntPtr.Zero, IntPtr.Zero, "SysTreeView32", IntPtr.Zero)
If hTree = IntPtr.Zero Then
' This usually means that BIF_NEWDIALOGSTYLE is enabled.
hTree = Win32.FindWindowEx(hDlg, IntPtr.Zero, "SHBrowseForFolder ShellNameSpace Control", IntPtr.Zero)
End If
End If
If hTree = IntPtr.Zero Then
Return
End If
' Prep the basic UI
Win32.SendMessage(hDlg, Win32.BFFM_SETSELECTIONW, 1, initdata.InitialPath)
Win32.SetWindowText(hDlg, initdata.Title)
If initdata.StartPosition = FormStartPosition.CenterParent Then
_centerTo(hDlg, initdata.hParent)
ElseIf initdata.StartPosition = FormStartPosition.CenterScreen Then
_centerTo(hDlg, Win32.GetDesktopWindow())
End If
' else we do nothing
' Prep the edit box
Dim rcEdit As New Win32.RECT()
Dim hEdit As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.PATH_EDIT)
If hEdit <> IntPtr.Zero Then
If initdata.ShowEditbox Then
Win32.GetWindowRect(hEdit, rcEdit)
Win32.ScreenToClient(hEdit, rcEdit)
Else
Win32.ShowWindow(hEdit, Win32.SW_HIDE)
End If
End If
' make the dialog larger
Dim rcDlg As Win32.RECT
Win32.GetWindowRect(hDlg, rcDlg)
rcDlg.Right += 40
rcDlg.Bottom += 30
If hEdit <> IntPtr.Zero Then
rcDlg.Bottom += (rcEdit.Height + 5)
End If
Win32.MoveWindow(hDlg, rcDlg, True)
Win32.GetClientRect(hDlg, rcDlg)
Dim vMargin As Integer = 10
' Accomodate the resizing handle's width
Dim hMargin As Integer = 10
' SystemInformation.VerticalScrollBarWidth;
' Move the Cancel button
Dim rcCancel As New Win32.RECT()
Dim hCancel As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.IDCANCEL)
If hCancel <> IntPtr.Zero Then
Win32.GetWindowRect(hCancel, rcCancel)
Win32.ScreenToClient(hDlg, rcCancel)
rcCancel = New Win32.RECT(rcDlg.Right - (rcCancel.Width + hMargin), rcDlg.Bottom - (rcCancel.Height + vMargin), rcCancel.Width, rcCancel.Height)
Win32.MoveWindow(hCancel, rcCancel, False)
End If
' Move the OK button
Dim rcOK As New Win32.RECT()
Dim hOK As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.IDOK)
If hOK <> IntPtr.Zero Then
Win32.GetWindowRect(hOK, rcOK)
Win32.ScreenToClient(hDlg, rcOK)
rcOK = New Win32.RECT(rcCancel.Left - (rcCancel.Width + hMargin), rcCancel.Top, rcOK.Width, rcOK.Height)
Win32.MoveWindow(hOK, rcOK, False)
End If
' Manage the "Make New Folder" button
Dim hBtn As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.NEW_FOLDER_BUTTON)
If Not initdata.ShowNewFolderButton Then
' Make sure this button is not visible
Win32.ShowWindow(hBtn, Win32.SW_HIDE)
ElseIf hBtn = IntPtr.Zero Then
' Create a button - button is only auto-created under BIF_NEWDIALOGSTYLE
' This is failing, and I don't know why!
hBtn = Win32.CreateWindowEx(&H50010000, "button", "&Make New Folder", &H4, hMargin, rcOK.Top, _
105, rcOK.Height, hDlg, New IntPtr(CtlIds.NEW_FOLDER_BUTTON), Process.GetCurrentProcess().Handle, IntPtr.Zero)
End If
' Position the path editbox and it's label
' We'll repurpose the Title (static) control as the editbox label
Dim treeTop As Integer = vMargin
If hEdit <> IntPtr.Zero Then
Dim xEdit As Integer = hMargin
Dim cxEdit As Integer = rcDlg.Width - (2 * hMargin)
Dim hLabel As IntPtr = Win32.GetDlgItem(hDlg, CtlIds.TITLE)
If hLabel <> IntPtr.Zero Then
Dim labelText As String = "Folder: "
Win32.SetWindowText(hLabel, labelText)
' This code obtains the required size of the static control that serves as the label for the editbox.
' All this GDI code is a bit excessive, but I figured "what the hell".
Dim hdc As IntPtr = Win32.GetDC(hLabel)
Dim hFont As IntPtr = Win32.SendMessage(hLabel, Win32.WM_GETFONT, IntPtr.Zero, IntPtr.Zero)
Dim oldfnt As IntPtr = Win32.SelectObject(hdc, hFont)
Dim szLabel As Size = Size.Empty
Win32.GetTextExtentPoint32(hdc, labelText, labelText.Length, szLabel)
Win32.SelectObject(hdc, oldfnt)
Win32.ReleaseDC(hLabel, hdc)
Dim rcLabel As New Win32.RECT(hMargin, vMargin + ((rcEdit.Height - szLabel.Height) / 2), szLabel.Width, szLabel.Height)
Win32.MoveWindow(hLabel, rcLabel, False)
xEdit += rcLabel.Width
cxEdit -= rcLabel.Width
End If
' Expand the folder tree to fill the dialog
rcEdit = New Win32.RECT(xEdit, vMargin, cxEdit, rcEdit.Height)
Win32.MoveWindow(hEdit, rcEdit, False)
treeTop = rcEdit.Bottom + 5
End If
Dim rcTree As New Win32.RECT(hMargin, treeTop, rcDlg.Width - (2 * hMargin), rcDlg.Bottom - (treeTop + (2 * vMargin) + rcOK.Height))
Win32.MoveWindow(hTree, rcTree, False)
End Sub
Private Sub _centerTo(hDlg As IntPtr, hRef As IntPtr)
Dim rcDlg As Win32.RECT
Win32.GetWindowRect(hDlg, rcDlg)
Dim rcRef As Win32.RECT
Win32.GetWindowRect(hRef, rcRef)
Dim cx As Integer = (rcRef.Width - rcDlg.Width) / 2
Dim cy As Integer = (rcRef.Height - rcDlg.Height) / 2
Dim rcNew As New Win32.RECT(rcRef.Left + cx, rcRef.Top + cy, rcDlg.Width, rcDlg.Height)
Win32.MoveWindow(hDlg, rcNew, True)
End Sub
End Class
End Namespace
'=======================================================
'Service provided by Telerik (www.telerik.com)
'Conversion powered by NRefactory.
'Twitter: @telerik, @toddanglin
'Facebook: facebook.com/telerik
'=======================================================
https://stackoverflow.com/questions/14927766
italiano
english
français
española
中国
日本の
العربية
Deutsch
한국어
Português
Russian
