22 Jan 2026 11:46
(Edited: 23 Jan 2026 2:16)
#32744
When %cd was introduced in 2023, I spent a several weeks trying out the capabilities and integrating this into my code. I used get_filtered_file@() extensively, so I wanted a solution that would easily integrate (minimal changes). What follows is what I've been using now for nearly 3 years with nary a glitch. Since this was integrated into my existing code, there were a few specific function calls I had to remove from what you see here. If I didn't catch them all, I apologize. If some of the IF statements look a bit odd, it's because I had some debugging code that is not useful to you (application specific).
logical function GET_FILTERED_FILE_NEW(title,file,path,filternames,filterspecs,nfilters,mustexist,caller_window_parameters)
use mswin
! --- These parameters are used for file selections from a dialog
INTEGER,PARAMETER:: FILE_CAN_EXIST = 0 ! not required for the file to be present on the system (might be created as part of the processing)
INTEGER,PARAMETER:: FILE_MUST_EXIST = 1 ! system must find the file to return the name/values
INTEGER,PARAMETER:: FILE_SAVE_AS_SYSVERIFY = 2 ! uses the system verification, then applies the extent after the fact if needed (not necessarily the right thing)
INTEGER,PARAMETER:: FILE_SAVE_AS_NOVERIFY = 3 ! save as dialog, but with no verification
INTEGER,PARAMETER:: FILE_SAVE_AS_ALTVERIFY = 4 ! SAVE AS dialog, then with verification AFTER the extent has been added
integer*4 :: nfilters,mustexist ! can_exist = 0,must_exist=1,save_as = 2, save anyway = 3
integer(7) :: caller_window_parameters,window_handle
character*( * ) :: title,file,path,filternames(nfilters),filterspecs(nfilters)
! this function is an attempt to proceduralize the selecting of a file and applying a file extent semi-automatically in the process.
! there is a LOT of checking done in this function, and if you are using it, you may not need everything.
!!must_exist options FILE_CAN_EXIST = 0
!!must_exist options FILE_MUST_EXIST = 1
!!must_exist options FILE_SAVE_AS_SYSVERIFY = 2 ! do the save as dialog and verify that it is OK to overwrite
!!must_exist options FILE_SAVE_AS_NOVERIFY = 3 ! do the save as dialog but do not verify it is OK within the dialog; do it later
!!must_exist options FILE_SAVE_AS_ALTVERIFY = 4 ! do the save as dialog and verify that it is OK to overwrite AFTER extent post-pend is accomplished
! This uses the new (a/o August 2023) common dialog %cd
! %cd[] always returns from winio@ the flags for the dialog. By default, this is in the variable ii
! so, if the flags need to be changed (i.e. one removed) we use IAND and NOT(flag_name) along with II to accomplish the flag changing
! OFN_* enumerated types are found at: https://learn.microsoft.com/en-us/windows/win32/api/commdlg/ns-commdlg-openfilenamea
!
integer*4 :: i,ii,flags=z'00081004' ! OFN_EXPLORER(00080000)+OFN_FILEMUSTEXIST(00001000)+OFN_HIDEREADONLY(00000004) ! normal
! integer*4 :: i,ii,flags=z'00080006' ! OFN_EXPLORER(00080000) +OFN_HIDEREADONLY(00000004)+OFN_OVERWRITEPROMPT(00000002) ! [saving]
!
! more flags at the bottom of this function
logical*2 :: added_extent=.false.
integer*2:: i_2
character*260:: temp_file,short_file,temp_path,fullpath,file_only,file_extent,filt(1),spec(1),saved_cwd
character*260,external:: curdir@
character*(len(filterspecs(1))):: abcd
integer::n_index(nfilters),n_extent(1:1),filter_selected,all_files
integer:: x_pos=0,y_pos=0
integer,external:: log_mydata
integer,external:: button1,button2 ! for overwrite dialog alternate
integer(7),external:: get_global_handle
character*260:: local_directory ! directory attached at the start of this function
integer:: stack_value
saved_cwd = curdir@() ! just in case we need to do a different "attach"
GET_FILTERED_FILE_NEW = .false. ! initial value - no file selected
local_directory = curdir@()
do i = 1,nfilters ; n_index(i) = i ; end do ! initialize the integer array used to extract filter items
!temp_title = title
! make copies of all the information JIC we need to mess with it
temp_file = file
temp_path = path
short_file = ' '
filter_selected = 0 ! assume nothing is selected by extent
if(temp_file.eq.' '.and.nfilters.ge.1) filter_selected = 1 ! select the first filter if the file name is blank. Otherwise, let the system do it.
! Since not having a path name for the file means that a folder can be chosen IAW a set of rules that may not make sense,
! make a file-name-only file into a complete path by pre-pending the name of the folder, if a folder name has been given
if(index(temp_file,'\').eq.0) then ! this is just a file name. put a folder name in front of it
if(temp_path.ne.' ') then
i = len_trim(temp_path)
if(temp_path(i:i).ne.'\') then
temp_path = trim(temp_path)//'\'
endif
temp_file = trim(temp_path)//temp_file ! make a path so the designated folder is actually used.
endif
endif
if(temp_file(1:2).eq.'.\') then ! if root-relative, then use the current working directory to complete the relative part. makes things more definite!
temp_file = trim(saved_cwd)//temp_file(3:)
endif
! THE FOLLOWING SECTION EXTRACTS THE EXTENT OF THE FILE, IF POSSIBLE, TO SET THE FILTER INDEX IN USE FOR THAT FILE. Only valid if we have filters being used.
! If there is a PATH, then this will be used to set the initial directory. Otherwise, we'll use the supplied path from the caller
if(getfullpathname(temp_file,len(fullpath),fullpath,core4(0)).ne.0) then ! this should fail (==0) if the name is blank
continue
else
call attach@(local_directory,i_2)
!print *,'Undechiperable file name - getfullpathname',fullpath
return
endif
i=index(fullpath,'\',.true.) ! backscan to find the first backslash
if(i.ne.0) then ! we have a pointer to the name of the file itself
file_only = fullpath(i+1:) ! extract the file name
temp_path = fullpath(1:i)
temp_file = file_only
else
call attach@(local_directory,i_2)
!print *,'Undechiperable file name - after fullpath scan'
return
endif
if(nfilters.ge.1) then ! see which filter might be selected
i = index(file_only,'.',.true.) ! back scan the file name only for the decimal as the name of the extent
if(i.gt.1) then ! it does contain an extent and it doesn't start with a "."
file_extent = '*'//file_only(i:) ! grab the extent and the decimal and pre=pend the * for the comparison
call lcase@(file_extent) ! make it lower case to match the filters being supplied (if any)
! now that we have the file extent, find the specified extent in the list (if possible) and set the initial setting to this index
if(any(filterspecs(1:nfilters).eq.file_extent)) then
n_extent(1:1) = pack(n_index,filterspecs.eq.file_extent) ! we have to do a "vector" assignment because....
filter_selected = n_extent(1) !pick up only the one index we want to highlight
else
! DO NOTHING. wE CAN'T CHANGE ANYTHING
! IF WE MAKE IT MORE "ODD", WE COULD TAKE THE *.* TYPE TO THE TOP... AND REPLACE IT ALL AFTER THE FILE OPEN IS DONE OR ABORTED
! if(logging_file) write(log_mydata(log_level_setting),*))'g_f_f_c: extent[',trim(file_extent),'] did not match any existing pattern'
endif
! do i=1,nfilters
! if(logging_file) write(log_mydata(log_level_setting),*)'Selection ',int(i,1),':',trim(filternames(i)),' ',trim(filterspecs(i))
! end do
else
! there is no file extent
filter_selected = 1
endif
endif
!if(logging_file) write(log_mydata(log_level_setting),*)'On entry, Temp path:',trim(temp_path)
!if(logging_file) write(log_mydata(log_level_setting),*)'On entry, Temp file:',trim(temp_file)
call set_cursor_waiting@(0) ! this is required to make sure the cursor is released (allowing input)
! see if the handle given is really a valid window handle and use the global one if not.
if(.not.iswindow(caller_window_parameters)) then
window_handle = get_global_handle() ! this function gets the handle of the main window (could just set to 0)
if(.not.iswindow(window_handle)) then
continue
else
ii = winio@('%cd[hwndowner]&',window_handle)
endif
else
ii = winio@('%cd[hwndowner]&',caller_window_parameters)
endif
i = len_trim(title)
ii = winio@("%cd[title='"//title(1:i)//"']&")
flags = ii
ii = winio@('%cd[file]&',temp_file)
ii = winio@('%cd[shortfile]&',short_file)
if(temp_path(1:1).ne.'.') then ! JIC this path relative sneaks by
ii = winio@('%cd[initialdir]&',temp_path)! only set the initial dir if the path is not relative
endif
all_files = 0 ! assume that no "all files" filter has been set
do i=1,nfilters ! SET THE FILTER SPECIFICATIONS FOR THE DIALOG IN REAL-TIME (ALLOWS SYNTAX CHANGES, jic)
ii = winio@("%cd[filter='"//trim(filternames(i))//' ('//trim(filterspecs(i))//")']&")
if(index(filterspecs(i),'*.*').ne.0) then
all_files = i ! find the option that selects "all files" if any
endif
end do
if(filter_selected.eq.0) filter_selected = all_files ! if no extent on the file, use the "all files" filter, if any
ii = winio@('%cd[filter_item_selected]&',filter_selected) ! auto-select the appropriate filter. Zero says none is selected, so dialog chooses the first one if a list is given.
select case (mustexist) ! alter the FLAGS based on the kind of file opening
case (0)
! make this a "can exist"
ii = winio@('%cd[flags]&',iand(ii,not(OFN_FILEMUSTEXIST)))
case (1)
! no need to do anything here (file must exist)
case (2)
ii = winio@('%cd[saving]&') ! generate a Save As selection and check afterward if the filename exists, and verify the user wishes to use this if it does exist.
case (3,4)
ii = winio@('%cd[saving]&') ! generate a Save As selection, without system verification to overwrite
ii = winio@('%cd[flags]&',iand(ii,not(OFN_OVERWRITEPROMPT)))
end select
flags = ii ! save the current flag bits bewfore the dialog is created
call attach@(temp_path,i_2)
ii = winio@('%cd') ! open the dialog. Return zero if cancelled, returns non-zero if successful.
call attach@(local_directory,i_2)
if(ii.eq.0) then ! none of the input variables will have changed any values
call attach@(local_directory,i_2)
return ! do not change anything.
endif
GET_FILTERED_FILE_NEW = .true. ! a file was selected or a name entered, but we're not done yet
! this handles applying an extent to a file name only (i.e. typed in)
if(.not.(filter_selected.eq.all_files.or.filter_selected.eq.0)) then ! a valid filter has been specified, see if we can apply it
if(index(filterspecs(filter_selected),'*.*').eq.0) then ! pathological case, programming error
i = index(short_file,'.',.true.) ! back scan to look for an extent being present
if(i.eq.0) then ! there is no extent, so add the selected extent to the filename
file_extent = filterspecs(filter_selected)(2:) ! use the extent from the filter selected
temp_file = trim(temp_file)//file_extent ! make the file name with the extent
else
call set_suffix1@(temp_file,FILTERSPECS(filter_selected)(3:),added_extent) ! added_extent will be TRUE if the extent is already present
endif
endif
endif
! ask if OK to overwrite
if(mustexist.eq.FILE_SAVE_AS_ALTVERIFY) then
if(fexists@(temp_file,ii)) then
i = index(temp_file,'\',.true.)
ii = winio@('%ww[no_maxminbox,no_sysmenu]%si!&')
ii = winio@('%ca[Confirm Save As]&')
ii = winio@('%fn[Tahoma]%ts&',1.2d0)
ii = winio@('%bf'//trim(temp_file(i+1:))//'%`bf already exists.%2nlDo you want to replace it?&')
ii = winio@('%rj %^bt[Yes] %^bt[No]',button1,button2)
get_filtered_file_new = ii.eq.1 ! will return TRUE only if user agress to overwriiting the file
endif
endif
if(get_filtered_file_new) then ! only update the variables IFF we are supposed to return the name of the file to open.
i=index(temp_file,'\',.true.) ! backscan to find the first backslash
if(i.ne.0) then ! we have a pointer to the name of the file itself
file = temp_file
path = temp_file(1:i)
endif
endif
call attach@(local_directory,i_2)
return
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_ALLOWMULTISELECT = 512
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_CREATEPROMPT = 8192
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_ENABLEHOOK = 32
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_ENABLETEMPLATE = 64
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_ENABLETEMPLATEHANDLE = 128
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_EXTENSIONDIFFERENT = 1024
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_FILEMUSTEXIST = 4096
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_HIDEREADONLY = 4
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_NOCHANGEDIR = 8
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_NOLONGNAMES = 262144
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_NONETWORKBUTTON = 131072
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_NOREADONLYRETURN = 32768
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_NOTESTFILECREATE = 65536
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_NOVALIDATE = 256
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_OVERWRITEPROMPT = 2
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_PATHMUSTEXIST = 2048
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_READONLY = 1
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_SHAREAWARE = 16384
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_SHAREFALLTHROUGH = 2
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_SHARENOWARN = 1
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_SHAREWARN = 0
! Open Flags ! INTEGER(KIND=3), PARAMETER :: OFN_SHOWHELP = 16
end