Skip to content
Snippets Groups Projects
getopenfilename.f90 3.44 KiB
Newer Older
Petra Lasch-Born's avatar
Petra Lasch-Born committed
!*****************************************************************!
!*                                                               *!
!*              4C (FORESEE) Simulation Model                    *!
!*                                                               *!
!*                                                               *!
!*                    Subroutines for:                           *!
!*                   - windows shell -                           *!
!*                                                               *!
!*  contains:                                                    *!
!*   FileOpen                                                    *!
!*                                                               *!
!*                  Copyright (C) 1996-2018                      *!
!*     Potsdam Institute for Climate Impact Reserach (PIK)       *!
!*          Authors and contributors see AUTHOR file             *!
!*  This file is part of 4C and is licensed under BSD-2-Clause   *!
!*                   See LICENSE file or under:                  *!
!*     http://www.https://opensource.org/licenses/BSD-2-Clause   *!
!*                           Contact:                            *!
!*       https://gitlab.pik-potsdam.de/XXXXXXXXXXXXXXXXXXXXX     *!
!*                                                               *!
!*****************************************************************!

Subroutine FileOpen (file_spec, filter_spec)

! Following example of calling the Win32 API routine GetOpenFileName

use comdlg32
!use dflib  ! In case QuickWin is used
implicit none

! Declare structure used to pass and receive attributes
!
type(T_OPENFILENAME) ofn

! Declare filter specification.  This is a concatenation of
! pairs of null-terminated strings.  The first string in each pair
! is the file type name, the second is a semicolon-separated list
! of file types for the given name.  The list ends with a trailing
! null-terminated empty string.
!
character*(*) :: filter_spec 

! Declare string variable to return the file specification.
! Initialize with an initial filespec, if any - null string
! otherwise

character*512 :: file_spec
integer status,ilen
ofn%lStructSize = SIZEOF(ofn)
ofn%hwndOwner = NULL  ! For non-console applications,
                      ! set this to the Hwnd of the
                      ! Owner window.  For QuickWin
                      ! and Standard Graphics projects,
                      ! use GETHWNDQQ(QWIN$FRAMEWINDOW)
                      !
ofn%hInstance = NULL  ! For Win32 applications, you
                      ! can set this to the appropriate
                      ! hInstance
                      !
ofn%lpstrFilter = loc(filter_spec)
ofn%lpstrCustomFilter = NULL
ofn%nMaxCustFilter = 0
ofn%nFilterIndex = 1 ! Specifies initial filter value
ofn%lpstrFile = loc(file_spec)
ofn%nMaxFile = sizeof(file_spec)
ofn%nMaxFileTitle = 0
ofn%lpstrInitialDir = NULL  ! Use Windows default directory
ofn%lpstrTitle = loc(""C)
ofn%Flags = OFN_PATHMUSTEXIST
ofn%lpstrDefExt = loc("txt"C)
ofn%lpfnHook = NULL
ofn%lpTemplateName = NULL

! Call GetOpenFileName and check status
do
    status = GetOpenFileName(ofn)
    if (status .eq. 0) then
      write(*,'(A)',advance='no') '  No file name specified' 
      write(*,'(A)',advance='no') '  Program aborted' 
      PAUSE
      STOP

    else
      ! Get length of file_spec by looking for trailing NUL
      ilen = INDEX(file_spec,CHAR(0))
    
       exit
    end if
enddo

end Subroutine fileopen