2021/12/06(Mon) 19:21:26 編集(投稿者)
モジュール OpenFileDialogEx.vb
'----- ここから
Imports System.Runtime.InteropServices
Imports System.Text
Module OpenFileDialogEx
Private Delegate Function WNDENUMPROC(ByVal hWnd As IntPtr, ByVallparam As IntPtr) As Boolean
<DllImport("user32.dll")>
Private Function EnumWindows(lpEnumFunc As WNDENUMPROC, lparam As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<DllImport("user32.dll")>
Private Function EnumChildWindows(ByVal hwndParent As Integer, ByVal lpEnumFunc As WNDENUMPROC, ByVal lParam As Integer) As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Function GetWindowText(hWnd As IntPtr, lpString As StringBuilder, nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Function GetWindowTextLength(hWnd As IntPtr) As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto, SetLastError:=True)>
Private Function GetClassName(hWnd As IntPtr, lpClassName As StringBuilder, nMaxCount As Integer) As Integer
End Function
<DllImport("user32.dll")>
Private Function SetForegroundWindow(hWnd As IntPtr) As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
Private Structure KEYBDINPUT
Public wVk As Short
Public wScan As Short
Public dwFlags As Integer
Public time As Integer
Public dwExtraInfo As IntPtr
End Structure
<StructLayout(LayoutKind.Sequential, Size:=28)>
Private Structure INPUT
Public type As Integer
Public ki As KEYBDINPUT
End Structure
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Function SendInput(ByVal nInputs As Integer, ByVal pInputs() As INPUT, ByVal cbsize As Integer) As Integer
End Function
<DllImport("user32.dll", CharSet:=CharSet.Auto)>
Private Function MapVirtualKey(ByVal wCode As Integer, ByVal wMapType As Integer) As Integer
End Function
Private Const WM_KEYDOWN As Integer = &H100
Private Const WM_KEYUP As Integer = &H101
Private Const VK_HOME As Integer = &H24
Private Const KEYEVENTF_KEYUP As Integer = &H2 'キーアップ キーダウン = 0
Private Const KEYEVENTF_EXTENDEDKEY As Integer = &H1 'スキャンコードは拡張コード
Private Const INPUT_KEYBOARD As Integer = 1 'キーボードイベントを発生させます
Private isCancel As Boolean = False
Private DialogTitle As String = ""
Public Function ShowDialogEx(target As OpenFileDialog) As DialogResult
'ダイアログの非同期取得
isCancel = False
If target.Title.Length = 0 Then
DialogTitle = "開く"
Else
DialogTitle = target.Title
End If
Dim taskShowDialog = Task.Run(
Sub()
Do Until isCancel
Application.DoEvents()
System.Threading.Thread.Sleep(500)
EnumWindows(New WNDENUMPROC(AddressOf EnumWindowsProc), IntPtr.Zero)
Loop
End Sub
)
'ダイアログの表示
Dim result As DialogResult = target.ShowDialog()
'ダイアログの非同期取得を終了させる
Do Until taskShowDialog.IsCompleted
isCancel = True
Application.DoEvents()
System.Threading.Thread.Sleep(250)
Loop
Return result
End Function
Private Function EnumWindowsProc(ByVal hWnd As IntPtr, ByVal lparam As IntPtr) As Boolean
If isCancel = False Then
'ウィンドウのタイトルの長さを取得する
Dim textLen As Integer = GetWindowTextLength(hWnd)
If textLen > 0 Then
'ウィンドウのクラス名を取得する
Dim csb As New StringBuilder(256)
GetClassName(hWnd, csb, csb.Capacity)
If csb.ToString() = "#32770" Then
'ウィンドウのタイトル名を取得する
Dim tsb As New StringBuilder(textLen + 1)
GetWindowText(hWnd, tsb, tsb.Capacity)
If tsb.ToString() = DialogTitle Then
EnumChildWindows(hWnd, New WNDENUMPROC(AddressOf EnumChildProc), IntPtr.Zero)
End If
End If
End If
End If
'すべてのウィンドウを列挙する
Return True
End Function
Private Function EnumChildProc(ByVal hWnd As IntPtr, ByVal lparam As IntPtr) As Boolean
If isCancel = False Then
'クラス名取得
Dim csb As New StringBuilder(256)
GetClassName(hWnd, csb, csb.Capacity)
If csb.ToString() = "ComboBoxEx32" Then
SetForegroundWindow(hWnd)
WindowToSendInput(VK_HOME)
isCancel = True
End If
End If
Return True
End Function
Private Sub WindowToSendInput(ByVal wVK As Short)
Dim pInputs() As INPUT
ReDim pInputs(0 To 1)
pInputs(0).type = INPUT_KEYBOARD
With pInputs(0).ki
.wVk = wVK 'キーコードを指定
.wScan = CShort(MapVirtualKey(wVK, 0)) 'スキャンコードを指定
.dwFlags = KEYEVENTF_EXTENDEDKEY Or 0 'キーダウン
.time = 100
.dwExtraInfo = IntPtr.Zero
End With
pInputs(1).type = INPUT_KEYBOARD
With pInputs(1).ki
.wVk = pInputs(0).ki.wVk 'キーコードを指定
.wScan = pInputs(0).ki.wScan 'スキャンコードを指定
.dwFlags = KEYEVENTF_EXTENDEDKEY Or KEYEVENTF_KEYUP 'キーアップ
.time = 100
.dwExtraInfo = IntPtr.Zero
End With
SendInput(pInputs.Length, pInputs, Marshal.SizeOf(GetType(INPUT)))
End Sub
End Module
'----- ここまで
※フォーカス移動が抜けていたので追加しました