|
ありがとうございます。
そうでしたか。
代替案として
https://qiita.com/otagaisama-1/items/b0804b9d6d37d82950f7
このページの方法をVBに翻訳して試しているのですが、
ダイアログは表示されるものの、フォルダーを選択してOKボタンを押しても
If Not hr.Equals(0) Then
Return System.Windows.Forms.DialogResult.Abort
End If
のところでReturnになってしまい、うまくいきません。
どこを修正すれば良いでしょうか?
以下はコードです。
よろしくお願い致します。
Imports System
Imports System.Runtime.InteropServices
' https://qiita.com/otagaisama-1/items/b0804b9d6d37d82950f7
Public Class FolderSelectDialog
Public Property Path As String
Public Property Title As String
Public Overloads Function ShowDialog() As System.Windows.Forms.DialogResult
Return Me.ShowDialog(IntPtr.Zero)
End Function
Public Overloads Function ShowDialog(ByVal owner As System.Windows.Forms.IWin32Window) As System.Windows.Forms.DialogResult
Return Me.ShowDialog(owner.Handle)
End Function
Public Overloads Function ShowDialog(ByVal owner As IntPtr) As System.Windows.Forms.DialogResult
Dim dlg = CType(New FileOpenDialogInternal(), IFileOpenDialog)
Try
dlg.SetOptions((FOS.FOS_PICKFOLDERS Or FOS.FOS_FORCEFILESYSTEM))
Dim item As IShellItem = Nothing
If Not String.IsNullOrEmpty(Me.Path) Then
Dim idl As IntPtr
Dim atts As UInteger = 0
If (NativeMethods.SHILCreateFromPath(Me.Path, idl, atts) = 0) Then
If (NativeMethods.SHCreateShellItem(IntPtr.Zero, IntPtr.Zero, idl, item) = 0) Then
dlg.SetFolder(item)
End If
End If
End If
If Not String.IsNullOrEmpty(Me.Title) Then
dlg.SetTitle(Me.Title)
End If
Dim hr As UInteger = dlg.Show(owner)
If hr.Equals(NativeMethods.ERROR_CANCELLED) Then
Return System.Windows.Forms.DialogResult.Cancel
End If
If Not hr.Equals(0) Then
Return System.Windows.Forms.DialogResult.Abort
End If
dlg.GetResult(item)
Dim outputPath As String = ""
item.GetDisplayName(SIGDN.SIGDN_FILESYSPATH, outputPath)
Me.Path = outputPath
Return System.Windows.Forms.DialogResult.OK
Finally
Marshal.FinalReleaseComObject(dlg)
End Try
End Function
<ComImport(), Guid("DC1C5A9C-E88A-4dde-A5A1-60F82A20AEF7")>
Private Class FileOpenDialogInternal
End Class
' not fully defined と記載された宣言は、支障ない範囲で端折ってあります。
<ComImport(), Guid("42f85136-db7e-439c-85f1-e4075d135fc8"),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Private Interface IFileOpenDialog
<PreserveSig()>
Function Show(ByVal hwndParent As IntPtr) As UInt32
Sub SetFileTypes()
' not fully defined
Sub SetFileTypeIndex()
' not fully defined
Sub GetFileTypeIndex()
' not fully defined
Sub Advise()
' not fully defined
Sub Unadvise()
Sub SetOptions(ByVal fos As FOS)
Sub GetOptions()
' not fully defined
Sub SetDefaultFolder()
' not fully defined
Sub SetFolder(ByVal psi As IShellItem)
Sub GetFolder()
' not fully defined
Sub GetCurrentSelection()
' not fully defined
Sub SetFileName()
' not fully defined
Sub GetFileName()
' not fully defined
Sub SetTitle(ByVal pszTitle As String)
Sub SetOkButtonLabel()
' not fully defined
Sub SetFileNameLabel()
' not fully defined
Sub GetResult(ByRef ppsi As IShellItem)
Sub AddPlace()
' not fully defined
Sub SetDefaultExtension()
' not fully defined
Sub Close()
' not fully defined
Sub SetClientGuid()
' not fully defined
Sub ClearClientData()
Sub SetFilter()
' not fully defined
Sub GetResults()
' not fully defined
Sub GetSelectedItems()
End Interface
<ComImport(), Guid("43826D1E-E718-42EE-BC55-A1E261C37BFE"),
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Private Interface IShellItem
Sub BindToHandler()
' not fully defined
Sub GetParent()
' not fully defined
Sub GetDisplayName(ByVal sigdnName As SIGDN, ByRef ppszName As String)
Sub GetAttributes()
' not fully defined
Sub Compare()
End Interface
Private Enum SIGDN As UInteger
SIGDN_FILESYSPATH = 2147844096
End Enum
<Flags()>
Private Enum FOS
FOS_FORCEFILESYSTEM = 64
FOS_PICKFOLDERS = 32
End Enum
Private Class NativeMethods
Public Declare Function SHILCreateFromPath Lib "shell32.dll" (ByVal pszPath As String, ByRef ppIdl As IntPtr, ByRef rgflnOut As UInteger) As Integer
Public Declare Function SHCreateShellItem Lib "shell32.dll" (ByVal pidlParent As IntPtr, ByVal psfParent As IntPtr, ByVal pidl As IntPtr, ByRef ppsi As IShellItem) As Integer
Public Const ERROR_CANCELLED As UInteger = 2147943623
End Class
End Class
|