Visual Basic

Imports System
Imports System.IO
Imports System.Runtime.CompilerServices
Imports System.Runtime.InteropServices
Imports System.Windows.Forms

Public Class OpenFolderDialog
Implements IDisposable

' Gets/sets folder in which dialog will be open.
Public Property InitialFolder() As String
Get
    Return m_InitialFolder
End Get
Set(ByVal value As String)
    m_InitialFolder = value
End Set
End Property
Private m_InitialFolder As String

' Gets/sets directory in which dialog will be open if there is no recent directory available.
Public Property DefaultFolder() As String
Get
    Return m_DefaultFolder
End Get
Set(ByVal value As String)
    m_DefaultFolder = value
End Set
End Property
Private m_DefaultFolder As String

' Gets selected folder.
Public Property Folder() As String
Get
    Return m_Folder
End Get
Private Set(ByVal value As String)
    m_Folder = value
End Set
End Property
Private m_Folder As String

Public Function ShowDialog(ByVal owner As IWin32Window) As DialogResult
If Environment.OSVersion.Version.Major >= 6 Then
    Return ShowVistaDialog(owner)
Else
    Return ShowLegacyDialog(owner)
End If
End Function

Private Function ShowVistaDialog(ByVal owner As IWin32Window) As DialogResult
Dim frm = DirectCast(New NativeMethods.FileOpenDialogRCW(), NativeMethods.IFileDialog)
Dim options As UInteger
frm.GetOptions(options)
options = options Or NativeMethods.FOS_PICKFOLDERS Or NativeMethods.FOS_FORCEFILESYSTEM Or NativeMethods.FOS_NOVALIDATE Or NativeMethods.FOS_NOTESTFILECREATE Or NativeMethods.FOS_DONTADDTORECENT
frm.SetOptions(options)
If Me.InitialFolder IsNot Nothing Then
    Dim directoryShellItem As NativeMethods.IShellItem
    Dim riid = New Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE")
    'IShellItem
    If NativeMethods.SHCreateItemFromParsingName(Me.InitialFolder, IntPtr.Zero, riid, directoryShellItem) = NativeMethods.S_OK Then
        frm.SetFolder(directoryShellItem)
    End If
End If
If Me.DefaultFolder IsNot Nothing Then
    Dim directoryShellItem As NativeMethods.IShellItem
    Dim riid = New Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE")
    'IShellItem
    If NativeMethods.SHCreateItemFromParsingName(Me.DefaultFolder, IntPtr.Zero, riid, directoryShellItem) = NativeMethods.S_OK Then
        frm.SetDefaultFolder(directoryShellItem)
    End If
End If

If frm.Show(owner.Handle) = NativeMethods.S_OK Then
    Dim shellItem As NativeMethods.IShellItem
    If frm.GetResult(shellItem) = NativeMethods.S_OK Then
        Dim pszString As IntPtr
        If shellItem.GetDisplayName(NativeMethods.SIGDN_FILESYSPATH, pszString) = NativeMethods.S_OK Then
            If pszString <> IntPtr.Zero Then
                Try
                    Me.Folder = Marshal.PtrToStringAuto(pszString)
                    Return DialogResult.OK
                Finally
                    Marshal.FreeCoTaskMem(pszString)
                End Try
            End If
        End If
    End If
End If
Return DialogResult.Cancel
End Function

Private Function ShowLegacyDialog(ByVal owner As IWin32Window) As DialogResult
Using frm = New SaveFileDialog()
    frm.CheckFileExists = False
    frm.CheckPathExists = True
    frm.CreatePrompt = False
    frm.Filter = "|" & Guid.Empty.ToString()
    frm.FileName = "any"
    If Me.InitialFolder IsNot Nothing Then
        frm.InitialDirectory = Me.InitialFolder
    End If
    frm.OverwritePrompt = False
    frm.Title = "Select Folder"
    frm.ValidateNames = False
    If frm.ShowDialog(owner) = DialogResult.OK Then
        Me.Folder = Path.GetDirectoryName(frm.FileName)
        Return DialogResult.OK
    Else
        Return DialogResult.Cancel
    End If
End Using
End Function

Public Sub Dispose() Implements IDisposable.Dispose
End Sub
'just to have possibility of Using statement.
End Class

Friend Module NativeMethods

#Region "Constants"

Public Const FOS_PICKFOLDERS As UInteger = &H20
Public Const FOS_FORCEFILESYSTEM As UInteger = &H40
Public Const FOS_NOVALIDATE As UInteger = &H100
Public Const FOS_NOTESTFILECREATE As UInteger = &H10000
Public Const FOS_DONTADDTORECENT As UInteger = &H2000000

Public Const S_OK As UInteger = &H0

Public Const SIGDN_FILESYSPATH As UInteger = &H80058000UI

#End Region

#Region "COM"

<ComImport(), ClassInterface(ClassInterfaceType.None), TypeLibType(TypeLibTypeFlags.FCanCreate), Guid("DC1C5A9C-E88A-4DDE-A5A1-60F82A20AEF7")>
Friend Class FileOpenDialogRCW
End Class


<ComImport(), Guid("42F85136-DB7E-439C-85F1-E4075D135FC8"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Friend Interface IFileDialog
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
<PreserveSig()>
Function Show(<[In](), [Optional]()> ByVal hwndOwner As IntPtr) As UInteger
'IModalWindow 

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetFileTypes(<[In]()> ByVal cFileTypes As UInteger, <[In](), MarshalAs(UnmanagedType.LPArray)> ByVal rgFilterSpec As IntPtr) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetFileTypeIndex(<[In]()> ByVal iFileType As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetFileTypeIndex(ByRef piFileType As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function Advise(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal pfde As IntPtr, ByRef pdwCookie As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function Unadvise(<[In]()> ByVal dwCookie As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetOptions(<[In]()> ByVal fos As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetOptions(ByRef fos As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Sub SetDefaultFolder(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem)

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetFolder(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetFolder(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetCurrentSelection(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetFileName(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszName As String) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetFileName(<MarshalAs(UnmanagedType.LPWStr)> ByRef pszName As String) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetTitle(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszTitle As String) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetOkButtonLabel(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszText As String) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetFileNameLabel(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszLabel As String) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetResult(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function AddPlace(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem, ByVal fdap As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetDefaultExtension(<[In](), MarshalAs(UnmanagedType.LPWStr)> ByVal pszDefaultExtension As String) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function Close(<MarshalAs(UnmanagedType.[Error])> ByVal hr As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetClientGuid(<[In]()> ByRef guid As Guid) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function ClearClientData() As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function SetFilter(<MarshalAs(UnmanagedType.[Interface])> ByVal pFilter As IntPtr) As UInteger
End Interface

<ComImport(), Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE"), InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Friend Interface IShellItem
<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function BindToHandler(<[In]()> ByVal pbc As IntPtr, <[In]()> ByRef rbhid As Guid, <[In]()> ByRef riid As Guid, <Out(), MarshalAs(UnmanagedType.[Interface])> ByRef ppvOut As IntPtr) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetParent(<MarshalAs(UnmanagedType.[Interface])> ByRef ppsi As IShellItem) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetDisplayName(<[In]()> ByVal sigdnName As UInteger, ByRef ppszName As IntPtr) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function GetAttributes(<[In]()> ByVal sfgaoMask As UInteger, ByRef psfgaoAttribs As UInteger) As UInteger

<MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)>
Function Compare(<[In](), MarshalAs(UnmanagedType.[Interface])> ByVal psi As IShellItem, <[In]()> ByVal hint As UInteger, ByRef piOrder As Integer) As UInteger
End Interface

#End Region

<DllImport("shell32.dll", CharSet:=CharSet.Unicode, PreserveSig:=False)>
Public Function SHCreateItemFromParsingName(
 <MarshalAs(UnmanagedType.LPWStr)> ByVal pszPath As String,
 ByVal pbc As IntPtr,
 <MarshalAs(UnmanagedType.LPStruct)> ByVal riid As Guid,
 <MarshalAs(UnmanagedType.Interface, IidParameterIndex:=2)> ByRef ppv As IShellItem) As Integer
End Function
End Module

Using frm = New OpenFolderDialog()
frm.InitialFolder = "E:\"
frm.DefaultFolder = "E:\"
If frm.ShowDialog(Me) = DialogResult.OK Then
    MessageBox.Show(Me, frm.Folder)
End If
End Using

WindowsApplication1.NativeMethods::SHCreateItemFromParsingName' has unbalanced the stack. This is likely because the managed PInvoke signature does not match the unmanaged target signature. Check that the calling convention and parameters of the PInvoke signature match the target unmanaged signature.'

Sub TestForLoop()
    ' Declare a list of rectangles and add 2 rectangles to it
    Dim lstRectangles As New List(Of Rectangle)
    lstRectangles.Add(New Rectangle(100, 200, 1000, 2000))
    lstRectangles.Add(New Rectangle(500, 700, 1500, 2000))

    ' This is the number used to scale the rectangle
    Dim gScale As Single = 0.1

    ' Before doing changes, write the rectangles dimensions to debug window.
    ShowRectDimensions("Before scaling:               ", lstRectangles)
    Debug.WriteLine("")

    ' Jump thru the elements, update and scale each rectangles dimensions. 
    For Each rect As Rectangle In lstRectangles
        With rect
            rect = New Rectangle(CInt(.Left * gScale), CInt(.Top * gScale),
                                 CInt(.Width * gScale), CInt(.Height * gScale))
            ' Write the changes to debug window while looping thru the list.
            Debug.WriteLine("Result inside For Each Loop:  {0}x{1},{2}x{3}", .Left, .Top, .Width, .Height)
        End With
    Next

    ' After the loop, write the rectangles dimensions to debug window once again.
    ShowRectDimensions("Result outside For Each Loop: ", lstRectangles)
    Debug.WriteLine("")


    ' Go thru the list, update and scale each rectangles dimension. 
    For i As Integer = 0 To lstRectangles.Count - 1
        With lstRectangles(i)
            lstRectangles(i) = New Rectangle(CInt(.Left * gScale), CInt(.Top * gScale),
                                             CInt(.Width * gScale), CInt(.Height * gScale))
            ' Write the changes to debug window while looping thru the list.
            Debug.WriteLine("Result inside For Next Loop:  {0}x{1},{2}x{3}", .Left, .Top, .Width, .Height)
        End With
    Next

    ' After the loop, write the rectangles dimensions to debug window once again.
    ShowRectDimensions("Result outside For Next Loop: ", lstRectangles)
    Debug.WriteLine("")
End Sub

' Created this sub to save some repetition. It writes the dimensions of the rectangles in a list.
Private Sub ShowRectDimensions(sText As String, lstRectangles As List(Of Rectangle))
    For Each rect As Rectangle In lstRectangles
        With rect
            Debug.WriteLine("{0}{1}x{2},{3}x{4}", sText, CStr(.Left), CStr(.Top), CStr(.Width), CStr(.Height))
        End With
    Next
End Sub

Before scaling:               100x200,1000x2000
Before scaling:               500x700,1500x2000

Result inside For Each Loop:  10x20,100x200
Result inside For Each Loop:  50x70,150x200
Result outside For Each Loop: 100x200,1000x2000
Result outside For Each Loop: 500x700,1500x2000

Result inside For Next Loop:  100x200,1000x2000
Result inside For Next Loop:  500x700,1500x2000
Result outside For Next Loop: 10x20,100x200
Result outside For Next Loop: 50x70,150x200