C# と VB.NET の質問掲示板

わんくま同盟

ASP.NET、C++/CLI、Java 何でもどうぞ

C# と VB.NET の入門サイト

■96431 / 2階層)  フォルダーの選択ダイアログ
□投稿者/ sony (2回)-(2020/11/22(Sun) 19:14:00)
ありがとうございます。
そうでしたか。

代替案として
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


編集キー/

前の記事(元になった記事) 次の記事(この記事の返信)
←Re[1]: フォルダーの選択ダイアログ /Hongliang →Re[3]: フォルダーの選択ダイアログ /Hongliang
 
上記関連ツリー

フォルダーの選択ダイアログ / sony (20/11/22(Sun) 18:39) #96429
Re[1]: フォルダーの選択ダイアログ / Hongliang (20/11/22(Sun) 18:50) #96430
  └ フォルダーの選択ダイアログ / sony (20/11/22(Sun) 19:14) #96431 ←Now
    └ Re[3]: フォルダーの選択ダイアログ / Hongliang (20/11/22(Sun) 19:53) #96432
      └ Re[4]: フォルダーの選択ダイアログ / sony (20/11/22(Sun) 20:00) #96433
        └ Re[5]: フォルダーの選択ダイアログ / Hongliang (20/11/22(Sun) 20:24) #96434
          └ Re[6]: フォルダーの選択ダイアログ / sony (20/11/22(Sun) 20:43) #96435
            └ Re[7]: フォルダーの選択ダイアログ / Hongliang (20/11/22(Sun) 21:20) #96436
              └ Re[8]: フォルダーの選択ダイアログ / sony (20/11/22(Sun) 21:39) #96437
                └ Re[9]: フォルダーの選択ダイアログ / Hongliang (20/11/22(Sun) 22:06) #96438
                  └ Re[10]: フォルダーの選択ダイアログ / sony (20/11/22(Sun) 23:04) #96439 解決済み

上記ツリーを一括表示 / 上記ツリーをトピック表示
 
上記の記事へ返信