- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
This is a well-worn problem, and I'm sure has a trivial solution. I currently open files by typing in their names on the keyboard. This is incredibly archaic in a Windows environment, and I'm tired of my colleagues making fun of my programs! How can I do this by using the standard browser search found in all of the other Windows programs I use?
If someone would send me a sample program that just opens a file like that, I'd be eternally (well at least for a week) grateful.
spike
If someone would send me a sample program that just opens a file like that, I'd be eternally (well at least for a week) grateful.
spike
Link Copied
15 Replies
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
MODULE XFTFILE
USE DFWIN
IMPLICIT NONE
PRIVATE
PUBLIC XGetOpenFile
!PUBLIC XGetSaveFile
!PUBLIC XBrowse
PRIVATE PXOFNHook
INTEGER,PRIVATE:: m_iX, m_iY, m_hParent
!======================================================================
CONTAINS
!======================================================================
LOGICAL FUNCTION XGetOpenFile(hWnd, sDir, nFiles, sFiles, iFlags, sExts, sTypes, &
sTitle, iX, iY)
INTEGER, INTENT(IN):: hWnd !Handle of parent window
CHARACTER(*), INTENT(INOUT):: sDir !Directory path (no trailing )
INTEGER, INTENT(INOUT):: nFiles !Number of files selected
CHARACTER(*), INTENT(INOUT):: sFiles(:) !Names of files selected (no directory info)
INTEGER, OPTIONAL, INTENT(IN):: iFlags !Flags for Openfilename (see defaults below)
CHARACTER(*), OPTIONAL, INTENT(IN):: sExts(:) !Array of extensions (default is "*.*")
CHARACTER(*), OPTIONAL, INTENT(IN):: sTypes(:) !Array of type names (default is "All files")
CHARACTER(*), OPTIONAL, INTENT(IN):: sTitle !Dialog title (default is "Open")
INTEGER, OPTIONAL, INTENT(IN):: iX, iY !Screen position (default is "centered")
TYPE(T_OPENFILENAME):: OFN
INTEGER:: i, nTypes, jFlags, nBegin, nNextZero, iSt, nLen
CHARACTER, ALLOCATABLE:: aszFilter(:)
CHARACTER(256):: szFilter; POINTER(pszFilter,szFilter)
CHARACTER(1024), AUTOMATIC:: szFiles
CHARACTER(64), AUTOMATIC:: szTitle
CHARACTER(LEN(sDir)+1), AUTOMATIC:: szDir
!Delete this line if you use CVF6.0 or newer:
integer, parameter:: OFN_EXPLORER = #00080000
IF (PRESENT(iFlags)) THEN
jFlags=iFlags.OR.OFN_EXPLORER.OR.OFN_ENABLEHOOK
ELSE
jFlags=OFN_EXPLORER.OR.OFN_FILEMUSTEXIST.OR.OFN_PATHMUSTEXIST.OR.OFN_ENABLEHOOK
IF (SIZE(sFiles).GT.1) jFlags=jFlags.OR.OFN_ALLOWMULTISELECT
END IF
IF (PRESENT(iX).AND.PRESENT(iY)) THEN
m_iX=iX
m_iY=iY
ELSE
m_iX=-1
m_iY=-1
END IF
m_hParent=hWnd
IF (PRESENT(sExts) .AND. PRESENT(sTypes)) THEN
nTypes=MIN(SIZE(sExts),SIZE(sTypes))
nLen=nTypes* (LEN(sExts(1))+LEN(sTypes(1))+3)
ALLOCATE( aszFilter(nLen) ) !)
aszFilter=" "
pszFilter=LOC(aszFilter)
DO i=1,nTypes
szFilter(1:nLen)=TRIM(szFilter(1:nLen))//TRIM(sTypes(i))//CHAR(0)//TRIM(sExts(i))//CHAR(0)
END DO
szFilter(1:nLen)=TRIM(szFilter(1:nLen))//CHAR(0)
ELSE
ALLOCATE( aszFilter(20) )
pszFilter=LOC(aszFilter)
szFilter="All files (*.*)"//CHAR(0)//"*.*"//CHAR(0)//CHAR(0)
END IF
IF (PRESENT(sTitle)) THEN
szTitle=TRIM(sTitle)//CHAR(0)
ELSE
szTitle='Open'C
END IF
IF (LEN_TRIM(sDir).EQ.0) THEN
iSt=GetCurrentDirectory(LEN(szDir), szDir)
ELSE
szDir=TRIM(sDir)//CHAR(0)
END IF
szFiles=''C
OFN%lStructSize = SIZEOF(OFN)
OFN%hwndOwner = hWnd
OFN%hInstance= NULL
OFN%lpstrFilter = pszFilter
OFN%lpstrCustomFilter = NULL
OFN%nMaxCustFilter = 0
OFN%nFilterIndex = 1
OFN%lpstrFile = LOC(szFiles)
OFN%nMaxFile = LEN(szFiles)
OFN% lpstrFileTitle = LOC(szTitle)
OFN%nMaxFileTitle = LEN(szTitle)
OFN%lpstrInitialDir=LOC(szDir)
OFN%lpstrTitle=LOC(szTitle)
OFN%Flags=jFlags
OFN%nFileOffset=0
OFN%nFileExtension=0
OFN%lpstrDefExt=NULL
OFN%lCustData=0
OFN%lpfnHook=LOC(PXOFNHook)
OFN%lpTemplateName=0
XGetOpenFile=GetOpenFileName(OFN)
iSt=CommDlgExtendedError()
IF (XGetOpenFile) THEN
szFiles(Ofn%nFileOffset:Ofn%nFileOffset)=CHAR(0)
nBegin=1 !Beginning of new file
nFiles=0
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
...continued:
The simplest call is:
a bit more advanced call (multiple files to open) would be:
HTH
Jugoslav
DO nNextZero = nBegin+SCAN(szFiles(nBegin:), CHAR(0))-1 IF (nNextZero-nBegin .LE. 1) EXIT !Terminal double zero IF (nBegin.EQ.1) THEN sDir = szFiles(nBegin:nNextZero-1) ELSE nFiles=nFiles+1 IF (nFiles.LE.SIZE(sFiles)) sFiles(nFiles)=szFiles(nBegin:nNextZero-1) END IF nBegin = nNextZero + 1 END DO END IF END FUNCTION XGetOpenFile !====================================================================== INTEGER FUNCTION PXOFNHook(hDlg, Msg, wParam, lParam) !DEC$ATTRIBUTES STDCALL:: PXOFNHook INTEGER,INTENT(IN):: hDlg, Msg, wParam, lParam INTEGER:: iSt TYPE(T_RECT):: Rect, WinRect SELECT CASE(Msg) CASE(WM_INITDIALOG) IF (m_iX.LT.0) THEN iSt=GetWindowRect(GetParent(hDlg),Rect) IF (IsWindow(m_hParent)) THEN iSt=GetWindowRect(m_hParent,WinRect) ELSE iSt=GetWindowRect(GetDesktopWindow(),WinRect) END IF iSt=SetWindowPos(GetParent(hDlg),0, & (WinRect%Right+WinRect%Left-Rect%Right+Rect%Left)/2, & (WinRect%Bottom+WinRect%Top-Rect%Bottom+Rect%Top)/2, & 0,0,SWP_NOSIZE.OR.SWP_NOZORDER) ELSE iSt=SetWindowPos(GetParent(hDlg),0,m_iX,m_iY,0,0,SWP_NOSIZE.OR.SWP_NOZORDER) END IF PXOFNHook=.TRUE. CASE DEFAULT PXOFNHook=.FALSE. END SELECT END FUNCTION PXOFNHook END MODULE XFTFILE
The simplest call is:
USE XFTFILE CHARACTER(256):: sDir CHARACTER(32):: sFile IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN OPEN(11, FILE=TRIM(sDir)//""//sFile) ... END IF
a bit more advanced call (multiple files to open) would be:
character(32):: sFiles(20) character(256):: sDir integer:: nFiles, i i=XGetOpenFile(0, sDir, nFiles, sFiles, sTypes=(/"Dat files"/), sExts=(/"*.dat"/), & sTitle="Open file") do i=1,nFiles open(20+i, file=trim(sDir)//''//sFiles(i), status="old") close(20+i) end do
HTH
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear HTH Jugoslav,
Thanks for sending me your solution. I can't get it to work yet. I copied the code of your MODULE XFTFILE, and my compiler (CVF 6.5, Windows2000) produced more errors than I can debug intelligently. It may be a problem of copying & pasting from your web reply. I don't know if there's a way to 'attach' a file of your module to this web forum, but could you attach a file of the module directly to my email address? Then I can try again to use it.
Thanks very much for your advice!
Spike
Richard.Horn@TJU.EDU
Thanks for sending me your solution. I can't get it to work yet. I copied the code of your MODULE XFTFILE, and my compiler (CVF 6.5, Windows2000) produced more errors than I can debug intelligently. It may be a problem of copying & pasting from your web reply. I don't know if there's a way to 'attach' a file of your module to this web forum, but could you attach a file of the module directly to my email address? Then I can try again to use it.
Thanks very much for your advice!
Spike
Richard.Horn@TJU.EDU
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Make sure you select Free-form Source or a .f90 file type when creating the file from Jugoslav's code.
Steve
Steve
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks, Steve and Jugoslav. The XFTFILE module compiles perfectly. Now I need a final bit of help calling it (I've never called a module like this before!). Based on your original suggestion, Jugoslav, I wrote the following program:
program TestRead
c test xftfile module
USE XFTFILE
CHARACTER(256):: sDir
CHARACTER(32):: sFile
INTEGER nFiles
IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN
OPEN(11, FILE=TRIM(sDir)//""//sFile)
END IF
end
*****************************************************************
Unfortunately it won't compile. The error message reads:
Error: The shape matching rules of actual arguments and dummy arguments have been violated. [SFILE]
IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN
Where do I go from here? Excuse my ignorance!
Spike
program TestRead
c test xftfile module
USE XFTFILE
CHARACTER(256):: sDir
CHARACTER(32):: sFile
INTEGER nFiles
IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN
OPEN(11, FILE=TRIM(sDir)//""//sFile)
END IF
end
*****************************************************************
Unfortunately it won't compile. The error message reads:
Error: The shape matching rules of actual arguments and dummy arguments have been violated. [SFILE]
IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN
Where do I go from here? Excuse my ignorance!
Spike
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Let's try formatting that little program again. It looked fine on the screen, but got strung together in the final version.
sorry! Spike
*************************************************
program TestRead
!test xftfile module
USE XFTFILE
CHARACTER(256):: sDir
CHARACTER(32):: sFile
INTEGER nFiles
IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN
OPEN(11, FILE=TRIM(sDir)//""//sFile)
END IF
end
sorry! Spike
*************************************************
program TestRead
!test xftfile module
USE XFTFILE
CHARACTER(256):: sDir
CHARACTER(32):: sFile
INTEGER nFiles
IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN
OPEN(11, FILE=TRIM(sDir)//""//sFile)
END IF
end
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Mea culpa. sFiles is declared as array in routine, so you have to declare
sFile to be an array of size 1 even if you want only a scalar string:
Well, I should've added an "overloaded" version, but it's too late -- sorry for the inconvenience.
When posting code, enclose it in HTML tags:
so that Forum software won't screw it.
Regards
Jugoslav
sFile to be an array of size 1 even if you want only a scalar string:
CHARACTER(LEN=32):: sFile(1)
Well, I should've added an "overloaded" version, but it's too late -- sorry for the inconvenience.
When posting code, enclose it in HTML tags:
..code here
so that Forum software won't screw it.
Regards
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Can you folks not see an "Attachments:" field when you post or reply?
Steve
Steve
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
No, Steve. There's no obvious "attachment" icon anywhere in the current window. It would have helped this entire discourse. Apparently Jugoslav didn't see one either when he posted a solution to my query.
Spike
Spike
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Ok - I guess that's for moderators only...
Steve
Steve
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Dear Steve & Yugoslav,
I thought I was home free, but I'm not. Although I can get to a Windows browse with Yugoslav's code, I can't seem to read the open file (if it is open!). I interpret the code that it opens a file with a unit number =11. But I get no response back when I attempt to read that file.
Here's my tiny code. I'm trying to read a binary data file.
***************************************
Now what am I doing wrong?
Spike
I thought I was home free, but I'm not. Although I can get to a Windows browse with Yugoslav's code, I can't seem to read the open file (if it is open!). I interpret the code that it opens a file with a unit number =11. But I get no response back when I attempt to read that file.
Here's my tiny code. I'm trying to read a binary data file.
program Test Read !test xftfile module USE XFTFILE integer Files character*4 type CHARACTER(256):: sir CHARACTER(LEN=32):: sFile(1) IF (XGetOpenFile(0, sDir, nFiles, sFile)) THEN OPEN(11, FILE=TRIM(sDir)//""//sFile,status='old',form='binary') END IF !read something from the open binary file write(*,*)'nFiles=',nFiles read(11)ftype write(*,*)'file type:',ftype end
***************************************
Now what am I doing wrong?
Spike
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Guess I should check my code a bit better before submitting it for public use :-)... Once you declare sFile as array you must use it as array consistently (i.e. OPEN(...//""//sFile(1)).
My thanks to Ed Mroczek who spotted potential memory-gobbling problem.
This may lead to quite undefined behaviors.
Lines 68-70 should be
I don't know if this was the exact problem in your case (this might or might not cause harm -- it didn't in my code). However, you should get a run-time error either in OPEN (since status="old") if file name is screwed, if it's skipped somehow, on READ from the file if it's not open. Your code works for me. (After Ed's correction & adding sFiles(1)).
Regards
Jugoslav
My thanks to Ed Mroczek who spotted potential memory-gobbling problem.
This may lead to quite undefined behaviors.
Lines 68-70 should be
ALLOCATE( aszFilter(25) ) pszFilter=LOC(aszFilter) szFilter(1:25)="All files (*.*)"//CHAR(0)//"*.*"//CHAR(0)//CHAR(0)
I don't know if this was the exact problem in your case (this might or might not cause harm -- it didn't in my code). However, you should get a run-time error either in OPEN (since status="old") if file name is screwed, if it's skipped somehow, on READ from the file if it's not open. Your code works for me. (After Ed's correction & adding sFiles(1)).
Regards
Jugoslav
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I am trying to implement your wrapper, Yugoslav (thanks for posting it,BOW) and I am solo close. I am compiling (V6.1,2000) as an empty Fort ran Windows Application. The error I get compiling the module is:
Error: This name does not have a type, and must have an explicit type.
[ON] ON%lStructSize = SIZE OF(ON)
Any ideas?
Thanks
Error: This name does not have a type, and must have an explicit type.
[ON] ON%lStructSize = SIZE OF(ON)
Any ideas?
Thanks
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Lets try this without the advantages of spell checking:
Trying to implement Jugoslav's GetOpenFile wrapper as an empty Fortran Windows application. Get an error compiling the module. The error reads:
Error: This name does not have a type, and must have an explicit type. [OFN]
OFN%lStructSize = SIZEOF(OFN)
Any ideas as to the cause?
Thanks
Ted
Trying to implement Jugoslav's GetOpenFile wrapper as an empty Fortran Windows application. Get an error compiling the module. The error reads:
Error: This name does not have a type, and must have an explicit type. [OFN]
OFN%lStructSize = SIZEOF(OFN)
Any ideas as to the cause?
Thanks
Ted
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Looks as if OFN declaration
somehow got lost in copying&pasting. The posted code contained few errors, though (as spotted in the discussion); you can find latest version here.
Jugoslav
TYPE(T_OPENFILENAME):: OFN
somehow got lost in copying&pasting. The posted code contained few errors, though (as spotted in the discussion); you can find latest version here.
Jugoslav

Reply
Topic Options
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page