[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] 纯文本查看 复制代码
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