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