Eine Neue Datei hochladen

source_code/version2.2_windows/getopenfilename.f90

+!*****************************************************************!
+!*                                                               *!
+!*              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
+