MODULE OFNMOD
!
      integer, parameter :: OFN_READONLY             = z'00000001'
      integer, parameter :: OFN_OVERWRITEPROMPT      = z'00000002'
      integer, parameter :: OFN_HIDEREADONLY         = z'00000004'
      integer, parameter :: OFN_NOCHANGEDIR          = z'00000008'
      integer, parameter :: OFN_SHOWHELP             = z'00000010'
      integer, parameter :: OFN_ENABLEHOOK           = z'00000020'
      integer, parameter :: OFN_ENABLETEMPLATE       = z'00000040'
      integer, parameter :: OFN_ENABLETEMPLATEHANDLE = z'00000080'
      integer, parameter :: OFN_NOVALIDATE           = z'00000100'
      integer, parameter :: OFN_ALLOWMULTISELECT     = z'00000200'
      integer, parameter :: OFN_EXTENSIONDIFFERENT   = z'00000400'
      integer, parameter :: OFN_PATHMUSTEXIST        = z'00000800'
      integer, parameter :: OFN_FILEMUSTEXIST        = z'00001000'
      integer, parameter :: OFN_CREATEPROMPT         = z'00002000'
      integer, parameter :: OFN_SHAREAWARE           = z'00004000'
      integer, parameter :: OFN_NOREADONLYRETURN     = z'00008000'
      integer, parameter :: OFN_NOTESTFILECREATE     = z'00010000'
      integer, parameter :: OFN_NONETWORKBUTTON      = z'00020000'
      integer, parameter :: OFN_NOLONGNAMES          = z'00040000'
!
      dll_import GetFocus
      dll_import CommDlgExtendedError
      dll_import GetOpenFileNameA
      dll_import GetSaveFileNameA
!
      integer :: GetFocus
      integer :: CommDlgExtendedError
      logical :: GetOpenFileNameA
      logical :: GetSaveFileNameA
!
!     This is the structure that is passed to the Win32 API common
!     dialog functions, "GetOpenFileName" and "GetSaveFileName."
!     In order to select the ASCII version of these two functions,
!     it is necessary to append an "A" on their names, as above.
!
      type t_openfilename
        sequence                           ! Packs structure to byte level
        integer(4) :: lStructSize          ! Struct size
        integer(4) :: hwndOwner            ! Owner window
        integer(4) :: hInstance            ! Not used here
        integer(4) :: lpstrFilter          ! Addr(filter)
        integer(4) :: lpstrCustomFilter    ! Not used here
        integer(4) :: nMaxCustFilter       ! Not used here
        integer(4) :: nFilterIndex         ! Highlighted
        integer(4) :: lpstrFile            ! Addr(fn buf1)
        integer(4) :: nMaxFile             ! Size(fn buf1)
        integer(4) :: lpstrFileTitle       ! Addr(fn buf2)
        integer(4) :: nMaxFileTitle        ! Size(fn buf2)
        integer(4) :: lpstrInitialDir      ! Addr(initdir)
        integer(4) :: lpstrTitle           ! Addr(title)
        integer(4) :: Flags                ! Mode flags
        integer(2) :: nFileOffset          ! Offset(file)
        integer(2) :: nFileExtension       ! Offset(fext)
        integer(4) :: lpstrDefExt          ! Addr(def ext)
        integer(4) :: lCustDate            ! Not used here
        integer(4) :: lpfnHook             ! Not used here
        integer(4) :: lpTemplateName       ! Not used here
      end type t_openfilename
      end module ofnmod

      SUBROUTINE GETINPFILENAME(MSG,DIR,NFILT,FILT,PATHFILE,READONLY)
      use ofnmod
!
!     File-Opening Common Dialog Example Subroutine for LF95
!     Kenneth G. Hamilton, June 2002
!
!     Formal parameters
!
      character (len=*) :: msg, dir, pathfile  ! Formal params
      type s_filt                       ! Formal param
        character (len=40) :: desc, mask
      end type s_filt
      type (s_filt) :: filt(nfilt)      ! Filter list
      logical :: readonly               ! Receives checkbox status
!
!     Locals
!
      type (t_openfilename) :: ofn      ! Arg for Dlgs
      character (len=256)   :: szDirName, szFile, szFileTitle, szTitle
      character (len=512)   :: szFilter
      integer  :: lstatus
      logical  :: ok, input
!
      input = .TRUE.                    ! Input file
      go to 10
!
!     Second entry point for output filenames
!
      ENTRY GETOUTFILENAME(MSG,DIR,NFILT,FILT,PATHFILE,READONLY)
      input = .FALSE.                   ! Output file
!
!     Compose the filter string:
!
   10 szFilter = ' '                    ! Init to blank
      ip = 1                            ! Char position
      do i = 1, nfilt                   ! Loop over all
        nc = len_trim(filt(i)%desc)     ! Description
        szFilter(ip:ip+nc) = filt(i)%desc(:nc)//char(0)
        ip = ip + nc + 1                ! Inc position
        nc = len_trim(filt(i)%mask)     ! Filter proper
        szFilter(ip:ip+nc) = filt(i)%mask(:nc)//char(0)
        ip = ip + nc + 1                ! Inc position
      enddo
      szFilter(ip:ip) = char(0)         ! Second NULL
!
      szFile(1:1) = char(0)             ! d:\path\file
      szFileTitle(1:1) = char(0)        ! file name
      nch = len_trim(dir)               ! Count chrs
      szDirName = dir                   ! Copy init dir
      szDirName(nch+1:nch+1) = char(0)  !   plus a NULL
      nch = len_trim(msg)               ! Count chrs
      szTitle = msg                     ! Boxtop title
      szTitle(nch+1:nch+1) = char(0)    !   plus a NULL
!
!     Fill the T_OPENFILENAME structure for input
!
                                        ! Structure Size
      ofn%lStructSize = loc(ofn%lpTemplateName) - loc(ofn%lStructSize) + 4
      ofn%hwndOwner   = GetFocus()      ! Popup over
      ofn%hInstance   = 0               ! Don't need
      ofn%lpstrFilter = loc(szFilter)   ! Addr(filter)
      ofn%lpstrCustomFilter = 0         ! Don't need
      ofn%nMaxCustFilter  = 0           ! Don't need
      ofn%nFilterIndex    = 1           ! 1st filter
      ofn%lpstrFile       = loc(szFile) ! Addr(pth\fil)
      ofn%nMaxFile        = len(szFile) ! Size(buffer)
      ofn%lpstrFileTitle  = loc(szFileTitle) ! Adr(fil)
      ofn%nMaxFileTitle   = len(szFileTitle) ! Siz(buf)
      ofn%lpstrInitialDir = loc(szDirName)   ! Adr(dir)
      ofn%lpstrTitle      = loc(szTitle)     ! Adr(top)
      ofn%lpstrDefExt       = 0         ! Not using
      ofn%lCustDate         = 0         ! Zero out
      ofn%lpfnHook          = 0         ! to prevent
      ofn%lpTemplateName    = 0         ! activating
!
      if (input) then
        ofn%Flags = OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST
        ok = GetOpenFileNameA(ofn)      ! Call dialog
      else
        ofn%Flags = OFN_PATHMUSTEXIST + OFN_OVERWRITEPROMPT + OFN_HIDEREADONLY
        ok = GetSaveFileNameA(ofn)      ! Call dialog
      endif
!
      if (ok) then                      ! It worked
        nch = index(szFile,char(0)) - 1 ! Length
        pathfile = szFile(:nch)         ! Get qualname
        readonly = iand(ofn%Flags,OFN_READONLY).ne.0
      else                              ! No good
        lstatus = CommDlgExtendedError()
        print 90, lstatus               ! Show error
   90   format (' Error status ',Z8,'(hex) occurred')
        pathfile = ' '
        readonly = .FALSE.
      endif
!
      return
      end