Code: Select all
#Include once "windows.bi"
#Include Once "win\commdlg.bi"
#Include Once "win/commctrl.bi"
'***********************************************************************
' Call GetOpenFileName or GetSaveFileName for FB Console Program
'***********************************************************************
Function getfname (ownerwindow As hwnd, _
ByRef iotype As UByte, _ 'I, O, U or A
ByRef dialogtitle As String, _
ByRef fname As String, _ 'returned full path filename
ByRef fnpos As Integer, _ 'returned pos of filename in above
ByRef fxpos As Integer, _ 'returned pos of extension in above
Byref ffilter As String, _ 'File filter elements sepeated by backslash
ByRef fstartdir As String, _ 'starting directory
byRef fdefext As String _ 'default extension
) As Integer
Dim ofn As OPENFILENAME
Dim freturn As String *MAX_PATH+1
Dim i As Integer
Dim l As Integer = Len(ffilter)
Dim As Short Ptr t, s
' Pass user's filename if supplied
freturn = fname
' The file filter passed contains file types and relevant descriptions in pairs,
' seperated by backslash, and terminated by 2 backslashes. We copy this,
' change this to a sequence of null-terminated strings, as required by the API.
ofn.lpstrfilter = Callocate(l+3,SizeOf(String))
s = CPtr(Short Ptr,@ffilter)
t = CPtr(Short Ptr,ofn.lpstrFilter)
While *s<>0
If *s = Asc("\") Then
*t = 0
Else
*t = *s
EndIf
s+=1
t+=1
Wend
'Set up openfilename parameter block
ofn.lStructSize = Sizeof(OPENFILENAME)
ofn.lpstrFile = @freturn
ofn.nMaxFile = Sizeof(freturn)
If Len(fstartdir)>0 Then
ofn.lpstrInitialDir = @fstartdir
EndIf
If Len(fdefext)>0 Then
ofn.lpstrdefext = @fdefext
EndIf
ofn.lpstrTitle = @dialogtitle
Select Case iotype
Case Asc("I")
ofn.flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST
Case Asc("O")
ofn.flags = OFN_OVERWRITEPROMPT
Case Asc("U"),Asc("A")
ofn.flags = OFN_CREATEPROMPT
End Select
' Call suitable procedure
Select Case(iotype)
Case Asc("O")
i = GetSavefilename(@ofn)
Case Asc("I"),asc("U"),Asc("A")
i = GetOpenFileName(@ofn)
Case Else
messagebox(ownerwindow,"Invalid I/O Type","PROGRAM ERROR",MB_OK)
i = 0
End Select
'check results and set return
If i<>0 Then
fname = freturn
fnpos = ofn.nFileOffset
fxpos = ofn.nFileExtension
Else
fname = ""
fnpos = 0
fxpos = 0
EndIf
Function = i
End Function