- 日時： 2014/12/02 12:45
- 名前： 魔界の仮面弁士
- ***********************************************************************************
* カテゴリー：[ダイアログ][][]
* キーワード： ファイルを開く, Unicode, , , ,
***********************************************************************************
Option Explicit
Private Declare Function MessageBoxW Lib "USER32" (ByVal hWnd As OLE_HANDLE, ByVal pszText As OLE_HANDLE, ByVal pszCaption As OLE_HANDLE, ByVal uType As VbMsgBoxStyle) As VbMsgBoxResult
Private Declare Function GetOpenFileNameW Lib "comdlg32" (ByRef pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long '[DWORD]
hwndOwner As Long '[HWND]
hInstance As Long '[HINSTANCE]
lpstrFilter As Long '[LPCTSTR]
lpstrCustomFilter As Long '[LPTSTR]
nMaxCustFilter As Long '[DWORD]
nFilterIndex As Long '[DWORD]
lpstrFile As Long '[LPTSTR]
nMaxFile As Long '[DWORD]
lpstrFileTitle As Long '[LPTSTR]
nMaxFileTitle As Long '[DWORD]
lpstrInitialDir As Long '[LPCTSTR]
lpstrTitle As Long '[LPCTSTR]
flags As Long '[DWORD]
nFileOffset As Integer '[WORD]
nFileExtension As Integer '[WORD]
lpstrDefExt As Long '[LPCTSTR]
lCustData As Long '[LPARAM]
lpfnHook As Long '[LPOFNHOOKPROC]
lpTemplateName As Long '[LPCTSTR]
pvReserved As Long '[void *]
dwReserved As Long '[DWORD]
FlagsEx As Long '[DWORD]
End Type
'Unicode 対応版「メッセージボックス」
Public Function MsgBoxW(ByVal sMessage As String, Optional ByVal style As VbMsgBoxStyle = vbOKOnly, Optional ByVal sCaption As String = vbNullString) As VbMsgBoxResult
Dim h As OLE_HANDLE
If Not Screen.ActiveForm Is Nothing Then
h = Screen.ActiveForm.hWnd
End If
sMessage = sMessage & vbNullChar
If StrPtr(sCaption) = 0 Then
sCaption = App.EXEName & vbNullChar
Else
sCaption = sCaption & vbNullChar
End If
MsgBoxW = MessageBoxW(h, StrPtr(sMessage), StrPtr(sCaption), style)
End Function
'Unicode 対応版「FileOpen ダイアログ」
' filterPattern は "テキストファイル|
Public Function DlgShowOpen(ByVal initialDirectory As String, ByVal filterPattern As String, Optional ByVal dialogTitle As String = vbNullString) As String
Const OFN_FILEMUSTEXIST As Long = &H1000
Const OFN_HIDEREADONLY As Long = &H4
Const OFN_EX_NOPLACESBAR As Long = &H1
Dim ofnFlags As Long
ofnFlags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
Dim strFile As String
strFile = String(512, 0)
Dim strFileFilter As String
strFileFilter = Replace(filterPattern, "|", vbNullChar) & String(2, 0)
If StrPtr(initialDirectory) <> 0 Then
initialDirectory = initialDirectory & vbNullChar
End If
If StrPtr(dialogTitle) <> 0 Then
dialogTitle = dialogTitle & vbNullChar
End If
Dim udtOFN As OPENFILENAME
With udtOFN
.lStructSize = Len(udtOFN)
If Screen.ActiveForm Is Nothing Then
.hwndOwner = 0&
Else
.hwndOwner = Screen.ActiveForm.hWnd
End If
.hInstance = App.hInstance
.lpstrFilter = StrPtr(strFileFilter)
.nFilterIndex = 1
.lpstrFile = StrPtr(strFile) 'パス取得用バッファ
.nMaxFile = Len(strFile)
.lpstrInitialDir = StrPtr(initialDirectory)
.lpstrTitle = StrPtr(dialogTitle)
.flags = ofnFlags
'.FlagsEx = OFN_EX_NOPLACESBAR
.FlagsEx = 0&
.nFileOffset = 0
.nFileExtension = 0
.nMaxCustFilter = 0&
.lpstrFileTitle = 0&
.nMaxFileTitle = 0&
.lpstrCustomFilter = 0&
.nMaxCustFilter = 0&
.lpstrDefExt = 0&
.lCustData = 0&
.lpfnHook = 0&
.lpTemplateName = 0&
.pvReserved = 0&
.dwReserved = 0&
End With
Dim lngResult As Long
lngResult = GetOpenFileNameW(udtOFN)
If lngResult = 0& Then
'キャンセルされた場合
DlgShowOpen = vbNullString
Else
DlgShowOpen = Split(strFile & vbNullChar, vbNullChar, 2, vbBinaryCompare)(0)
End If
End Function
Private Sub Command1_Click()
Dim s As String
s = DlgShowOpen("C:\Program Files\", "実行ファイル|*.exe|設定ファイル|*.ini;*.inf|全てのファイル|*.*")
If s = "" Then
MsgBox "キャンセル", vbExclamation
Else
MsgBoxW s, vbInformation
End If
End Sub
|
Unicode対応版「ファイルを開く」ダイアログ(VB6.0)