コモンダイアログ


  ライブラリ関数名一覧

1) OpenFolderDlg
2) OpenFileDlg
3) SaveFileDlg

  COMMONDLG.bas




  

' ******************************************************
' OPENFILENAME 構造体
' ******************************************************
Type OPENFILENAME
        lStructSize As Long         ' 76
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type

' ******************************************************
' 開く
' ******************************************************
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( _
    pOpenfilename As OPENFILENAME _
) As Long

' ******************************************************
' 保存する
' ******************************************************
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" ( _
    pOpenfilename As OPENFILENAME _
) As Long

Global Const OFN_READONLY = &H1
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_SHOWHELP = &H10
Global Const OFN_ENABLEHOOK = &H20
Global Const OFN_ENABLETEMPLATE = &H40
Global Const OFN_ENABLETEMPLATEHANDLE = &H80
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_EXTENSIONDIFFERENT = &H400
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_SHAREAWARE = &H4000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOTESTFILECREATE = &H10000
Global Const OFN_NONETWORKBUTTON = &H20000
Global Const OFN_NOLONGNAMES = &H40000
Global Const OFN_EXPLORER = &H80000
Global Const OFN_NODEREFERENCELINKS = &H100000
Global Const OFN_LONGNAMES = &H200000

' -----------------------------------------
' フォルダの参照ダイアログ
' -----------------------------------------
Type BROWSEINFO
      hwndOwner As Long
      pidlRoot As Long
      pszDisplayName As String
      lpszTitle As String
      ulFlags As Long
      lpfn As Long
      lParam As Long
      iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" ( _
    lpBROWSEINFO As BROWSEINFO _
) As Long
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" ( _
    ByVal pidl As Long, _
    ByVal pszPath As String _
) As Long
Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)

' ******************************************************
' フォルダの選択ダイアログ
' ******************************************************
Public Function OpenFolderDlg( _
    strTitle As String, _
    hOwner As Long, _
    strPath As String _
) As Boolean

    Dim bi As BROWSEINFO
    Dim lpi As Long
    Dim strGetPath As String * 512

    bi.hwndOwner = hOwner
    bi.pidlRoot = 0
    bi.lpszTitle = strTitle
    bi.ulFlags = 1
    bi.lpfn = 0
    bi.lParam = 0
    bi.iImage = 0

    lpi = SHBrowseForFolder(bi)

    If lpi <> 0 Then
        Call SHGetPathFromIDList(lpi, strGetPath)
        strPath = Left(strGetPath, InStr(strGetPath, Chr(0)) - 1)
        CoTaskMemFree lpi
        OpenFolderDlg = True
        Exit Function
    End If

    OpenFolderDlg = False

End Function

' ******************************************************
' ファイルを開くダイアログ
' ******************************************************
Public Function OpenFileDlg( _
    strTitle As String, _
    hOwner As Long, _
    strFilter As String, _
    nCutFilterIndex As Long, _
    strPath As String _
) As Boolean

    Dim ofn As OPENFILENAME
    Dim ret As Long
    Dim strFilePath As String * 512
    Dim strFilterWork As Variant
    Dim I As Integer

    If strPath <> "" Then
        strFilePath = strPath & String(512, Chr(0))
    End If
    
    ofn.lStructSize = LenB(ofn)
    ofn.hwndOwner = hOwner
    ofn.hInstance = App.hInstance
    strFilterWork = Split(strFilter, ",")
    ofn.lpstrFilter = ""
    For I = 0 To UBound(strFilterWork)
        ofn.lpstrFilter = ofn.lpstrFilter & strFilterWork(I) & Chr(0)
    Next
    ofn.lpstrFilter = ofn.lpstrFilter & Chr(0)
    ofn.nFilterIndex = nCutFilterIndex
    ofn.lpstrFile = strFilePath
    ofn.nMaxFile = 512
    ofn.lpstrTitle = strTitle
    ofn.flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
    ret = GetOpenFileName(ofn)
    If ret <> 0 Then
        OpenFileDlg = True
        strPath = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, Chr(0)) - 1)
    Else
        OpenFileDlg = False
    End If

End Function

' ******************************************************
' ファイルを保存するダイアログ
' ******************************************************
Public Function SaveFileDlg( _
    strTitle As String, _
    hOwner As Long, _
    strFilter As String, _
    nCutFilterIndex As Long, _
    strPath As String _
) As Boolean

    Dim ofn As OPENFILENAME
    Dim ret As Long
    Dim strFilePath As String * 512
    Dim strFilterWork As Variant
    Dim I As Integer

    If strPath <> "" Then
        strFilePath = strPath & String(512, Chr(0))
    End If

    ofn.lStructSize = LenB(ofn)
    ofn.hwndOwner = hOwner
    ofn.hInstance = App.hInstance
    strFilterWork = Split(strFilter, ",")
    ofn.lpstrFilter = ""
    For I = 0 To UBound(strFilterWork)
        ofn.lpstrFilter = ofn.lpstrFilter & strFilterWork(I) & Chr(0)
    Next
    ofn.lpstrFilter = ofn.lpstrFilter & Chr(0)
    ofn.nFilterIndex = nCutFilterIndex
    ofn.lpstrFile = strFilePath
    ofn.nMaxFile = 512
    ofn.lpstrTitle = strTitle
    ofn.flags = OFN_HIDEREADONLY
    ret = GetSaveFileName(ofn)
    If ret <> 0 Then
        SaveFileDlg = True
        strPath = Left(ofn.lpstrFile, InStr(ofn.lpstrFile, Chr(0)) - 1)
    Else
        SaveFileDlg = False
    End If

End Function

  

  実行サンプル

  

Private Sub Command1_Click()

    Dim strFilePath As String
    
    If OpenFileDlg( _
            "ファイルのオープン", _
            Me.hWnd, _
            "テキスト,*.txt,全て,*.*", _
            1, _
            strFilePath _
        ) Then
        Call MsgBox(strFilePath)
    End If

End Sub

  




yahoo  google  MSDN  MSDN(us)  WinFAQ  Win Howto  tohoho  ie_DHTML  vector  wdic  辞書  天気 


[PROvbFunction]
CCBot/2.0 (https://commoncrawl.org/faq/)
19/04/22 15:11:55
InfoBoard Version 1.00 : Language=Perl

BatchHelper COMprog CommonSpec Cprog CprogBase CprogSAMPLE CprogSTD CprogSTD2 CprogWinsock Cygwin GameScript HTML HTMLcss InstallShield InstallShieldFunc JScript JScriptSAMPLE Jsfuncs LLINK OldProg OracleGold OracleSilver PRO PRObrowser PROc PROconePOINT PROcontrol PROftpclient PROjscript PROmailer PROperl PROperlCHAT PROphp PROphpLesson PROphpLesson2 PROphpLesson3 PROphpfunction PROphpfunctionArray PROphpfunctionMisc PROphpfunctionString PROsql PROvb PROvbFunction PROvbString PROvbdbmtn PROvbonepoint PROwebapp PROwin1POINT PROwinSYSTEM PROwinYOROZU PROwindows ProjectBoard RealPHP ScriptAPP ScriptMaster VBRealtime Vsfuncs a1root access accreq adsi ajax amazon argus asp aspSample aspVarious aspdotnet aw2kinst cappvariety centura ckeyword classStyle cmaterial cmbin cmdbapp cmenum cmlang cmlistbox cmstd cmstdseed cmtxt cs daz3d db dbCommon dbaccess dnettool dos download flex2 flex3 flex4 framemtn framereq freeWorld freesoft gimp ginpro giodownload google hdml home hta htmlDom ie9svg install java javaSwing javascript jetsql jquery jsp jspTest jspVarious lightbox listasp listmsapi listmsie listmsiis listmsnt listmspatch listmsscript listmsvb listmsvc memo ms msde mysql netbeans oraPlsql oracle oracleWiper oraclehelper orafunc other panoramio pear perl personal pgdojo pgdojo_cal pgdojo_holiday pgdojo_idx pgdojo_ref pgdojo_req php phpVarious phpguide plsql postgres ps r205 realC realwebapp regex rgaki ruby rule sboard sc scprint scquest sdb sdbquest seesaa setup sh_Imagick sh_canvas sh_dotnet sh_google sh_tool sh_web shadowbox shgm shjquery shvbs shweb sjscript skadai skywalker smalltech sperl sqlq src systemdoc tcpip tegaki three toolbox twitter typeface usb useXML vb vbdb vbsfunc vbsguide vbsrc vpc wcsignup webanymind webappgen webclass webparts webtool webwsh win8 winofsql wmi work wp youtube