32507


Fortranを用いてWindowsのフォルダの選択ダイアログを表示する方法を探しております。使用環境はIntelコンパイラになります。ExamplesのGetOpenFileNameなどの例を参考にしようとしておりましたが、現状でフォルダを選択して閉じるダイアログを表示する方法の検討もついておりません。  
どなたか本件に関してお知恵をお持ちの方がいらっしゃいましたら、お知恵を拝借したく存じます。何卒、よろしくお願い申し上げます。


CC BY-SA 3.0
2017-02-06T05:23:40.883
32418
2017-02-08T13:52:29.117
2017-02-07T03:51:56.333
2808
20528
question
windows fortran
Fortranでフォルダの選択ダイアログを表示する方法について


フォルダー選択ダイアログは Intel
の提供するインターフェースに存在しないので、自分で必要な定数やインターフェースを定義すれば何とかなる。ネットでググると出てくる C による win32
API
をコピペしてきて、Fortran用に書き直せばよい。しかし定数等も自分で定義しないと駄目なのでだるい。整数のバイト数の宣言はどうせ４または８なので適当に書いておけば大抵は何とかなる。

あと、shell32.libをリンカのところに付け足しておく必要がある。

以下の例では、コンソールアプリケーションから、フォルダー選択のダイアログが開いて、何か選択するとその名前が出る。フルパス名は、返り値を別の関数APIに入れてゲットできるようだが、めんどくさいので自分で何とかしてくれｗ

[code]

    program folder
      use ifwinty
      implicit none
      integer, parameter :: BIF_RETURNONLYFSDIRS  = Z'00000001'
      integer, parameter :: BIF_DONTGOBELOWDOMAIN = Z'00000002'
      ! 以下略
    
      character(len = *), parameter :: buf = "選べ！"C
      type :: t_browseinfo  
        sequence
        integer(HANDLE) :: hwndOwner = NULL               !// 親ウィンドウのハンドル
        integer(LPINT)  :: pidlRoot  = NULL               !// ルートにする場所を指定。
        integer(LPSTR)  :: pszDisplayName                 !// 選択されたフォルダ名（フルパスではない）が格納される。
        integer(LPCSTR) :: lpszTitle                      !// ダイアログに表示するメッセージ
        integer(UINT)   :: ulFlags = BIF_RETURNONLYFSDIRS !// どのフォルダを選択させるかのオプション
        integer(UINT)   :: lpfn = NULL                    !// 
        integer(HANDLE) :: lParam = 0                     !// 
        integer :: iImage = 0                             !//  
      end type t_browseinfo
      type(t_browseinfo) :: test
    
      interface
        integer function SHBrowseForFolder(t)
          !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHBrowseForFolder' :: SHBrowseForFolder
          import
          integer(LPINT) :: t
        end function
      end interface
    
      character(len = 512) :: buff
      integer:: status
    ! 
      test%lpszTitle = loc("選べ！"C)
      test%pszDisplayName = loc(buff)
      status = SHBrowseForFolder(loc(test))
      print *, 'status=', status
      print *, buff(:index(buff, ""C))
    end program folder
    
[/code]


CC BY-SA 3.0
2017-02-06T19:14:45.153
32440
2017-02-06T19:14:45.153
20539
32418
answer


補足：  
フルパスが採れるようにしたから、編集の仕方がよく分からないので付け足しておく。  
（前回は夜中に寝ながら書いたので、日本語もおかしくてすまんかった。許してたもれ。）

WIN32 API 引数のポインタは、番地は固定なので intent(in) にした。（内容的には、in のも out のもあるが･･･）

なお LINKER->入力->追加の依存ファイル の所に shell32.lib ole32.lib が必要。

[code]

    program folder
      use ifwinty
      implicit none
      integer, parameter :: BIF_RETURNONLYFSDIRS  = Z'00000001'
      integer, parameter :: BIF_DONTGOBELOWDOMAIN = Z'00000002'
      ! 以下略
    
      type :: t_browseinfo  
        sequence
        integer(HANDLE) :: hwndOwner = NULL               !// 親ウィンドウのハンドル
        integer(LPINT)  :: pidlRoot  = NULL               !// ルートにする場所を指定。
        integer(LPSTR)  :: pszDisplayName                 !// 選択されたフォルダ名（フルパスではない）が格納される。
        integer(LPCSTR) :: lpszTitle                      !// ダイアログに表示するメッセージ
        integer(UINT)   :: ulFlags = BIF_RETURNONLYFSDIRS !// どのフォルダを選択させるかのオプション
        integer(UINT)   :: lpfn = NULL                    !// 
        integer(HANDLE) :: lParam = 0                     !// 
        integer         :: iImage = 0                     !//  
      end type t_browseinfo
      type(t_browseinfo) :: test
    
      interface
        integer function SHBrowseForFolder(t)
          !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHBrowseForFolder' :: SHBrowseForFolder
          import
          integer(LPINT), intent(in) :: t
        end function SHBrowseForFolder
    
        integer function SHGetPathFromIDList(pidl, pszPath)
          !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'SHGetPathFromIDList' :: SHGetPathFromIDList
          import
          integer(LPINT), intent(in) :: pidl
          integer(LPINT), intent(in) :: pszPath
        end function SHGetPathFromIDList
    
        integer function CoTaskMemFree(pv)
          !DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'CoTaskMemFree' :: CoTaskMemFree
          import
          integer(LPINT), intent(in) :: pv
        end function CoTaskMemFree
      end interface
    
      character(len = *), parameter :: msg = "選べ！"C
      character(len = 512) :: buff, path
      integer(LPINT) :: status
      integer(BOOL)  :: iret
    ! 
      test%lpszTitle = loc(msg)
      test%pszDisplayName = loc(buff)
      status = SHBrowseForFolder(loc(test))
    !  print *, 'status=', status
      if (status /= 0) then
        iret = SHGetPathFromIDList(status, loc(path))
        print *, path(:index(path, ""C))
        print *, buff(:index(buff, ""C))
        iret = CoTaskMemFree(status)
      else
        print *, '--no folder was selected--'
      end if  
    end program folder
    
[/code]


CC BY-SA 3.0
2017-02-08T13:52:29.117
32507
2017-02-08T13:52:29.117
20571
32418
answer