求助！请问，在IVF下如何实现选择文件夹的对话框？

楚香饭

QuickWin 很方便的。

以下是一个例子

[Fortran] 纯文本查看 复制代码

program www_fcode_cn
  implicit none
  integer :: i
  character( Len = 512 ) :: c
  i = SelectFile( c )
  if ( i /=0 ) write(*,*) "Your select: " , trim(c)
contains

  Integer Function SelectFile( c )  !// 弹出选择文件对话框，等待用户选择输入文件
    use comdlg32 , only : GetOpenFileName , T_OPENFILENAME , OFN_FileMustExist
    use user32   , only : GetForegroundWindow
    use , intrinsic :: ISO_C_Binding , sz => c_null_char
    Implicit None
    character(Len=*) , Intent( OUT ) :: c
    Type(T_OPENFILENAME) :: ofn !// 定义打开文件对话框派生类型
    Character(Len=*),Parameter:: filter_spec = "ASCII文件" //sz// "*.txt" //sz//&
                                               "所有文件" //sz// "*.*"  //sz// &
                                               sz 
    Character(Len=*),Parameter:: cTitle = '请选择文件'//sz
    Character(Len=512) :: file_spec
    file_spec             = sz
    ofn%lStructSize       = c_sizeof(ofn)
    ofn%hwndOwner         = GetForegroundWindow()
    ofn%hInstance         = 0
    ofn%lpstrFilter       = transfer(c_loc(filter_spec),1)!// 指定文件过滤器
    ofn%lpstrCustomFilter = 0
    ofn%nMaxCustFilter    = 1
    ofn%nFilterIndex      = 1 !// 指定初始的 文件过滤器 序号
    ofn%lpstrFile         = transfer(c_loc(file_spec),1)
    ofn%nMaxFile          = c_sizeof(file_spec)
    ofn%nMaxFileTitle     = 0
    ofn%lpstrInitialDir   = 0
    ofn%lpstrTitle        = transfer(c_loc(cTitle),1) !// 指定打开文件对话框的标题
    ofn%Flags             = OFN_FileMustExist
    ofn%lpstrDefExt       = 0
    ofn%lpfnHook          = 0
    ofn%lpTemplateName    = 0
    SelectFile = GetOpenFileName( ofn )
    If ( SelectFile == 0) return
    c = file_spec( 1 : index( file_spec , sz ) - 1 )
  End Function SelectFile

end program www_fcode_cn

楚香饭

你有两个选择。
简单的，先或的一个文件名，然后获得这个文件名所在的路径

[Fortran] 纯文本查看 复制代码

i = index( filename , "\" , back=.true. )
path = filename( 1 : i-1 )

另一个选择，就是用复杂一点的方法。

[Fortran] 纯文本查看 复制代码

Module SHBrowseForFolder_Mod
  use Shell32
  use , intrinsic :: ISO_C_Binding , sz => c_null_char
  Implicit None
  type T_BROWSEINFO
    integer         hwndOwner
    integer         pidlRoot
    integer         pszDisplayName
    type(C_PTR)     lpszTitle
    integer         ulFlags
    integer         lpfn
    integer         lParam
    integer         iImage
  end type
  INTERFACE
    Integer Function SHBrowseForFolder( lpbi )
    !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHBrowseForFolderA' :: SHBrowseForFolder
      import
      type(C_PTR) :: lpbi
    End Function SHBrowseForFolder
    Integer Function SHGetPathFromIDList( pidl , pszPath )
    !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHGetPathFromIDListA' :: SHGetPathFromIDList
    !DEC$ ATTRIBUTES REFERENCE :: pszPath
      INTEGER , value :: pidl 
      Character(len=*) :: pszPath
    End Function SHGetPathFromIDList 
  END INTERFACE 

End Module SHBrowseForFolder_Mod

program www_fcode_cn
  implicit none
  integer :: i
  character( Len = 512 ) :: c
  i = SelectPath( c )
  if ( i /= 0 ) write(*,*) "You Select :" , trim(c)

contains

  Integer Function SelectPath( c )
    use SHBrowseForFolder_Mod
    use user32  , only : GetForegroundWindow
    character( Len = * ) , Intent( OUT ) :: c
    Type(T_BROWSEINFO) :: ofn
    Character(Len=512) :: file_spec 
    Character(Len=64)  :: cTitle
    file_spec           = sz
    cTitle              = "您好，请选择文件夹："//sz
    SelectPath          = 0
    ofn%hwndOwner       = GetForegroundWindow()
    ofn%pidlRoot        = 0
    ofn%pszDisplayName  = 0
    ofn%lpszTitle       = c_Loc(cTitle)
    ofn%ulFlags         = 0 
    ofn%lpfn            = 0
    ofn%lParam          = 0
    ofn%iImage          = 0
    SelectPath = SHBrowseForFolder( c_loc(ofn) )
    If ( SelectPath == 0 ) return
    SelectPath = SHGetPathFromIDList( SelectPath , file_spec )
    c = file_spec( 1 : index( file_spec , sz ) - 1 )
  End Function SelectPath
end program www_fcode_cn