FreeBASIC マニュアルのトップに戻る

FreeBASIC ファイルを開くダイアログを表示

目次→フォーラム→FreeBASIC→補足Windows API: Open Dialog to Browse for a File←オリジナル・サイト

FileOpen、FileSave、Select Folder 左にメニュー・フレームが表示されていない場合は、ここをクリックして下さい

←リンク元に戻る プログラム開発関連に戻る

 以下は、ファイルを開くダイアログ(FileOpen、FileSave、Select Folder)の、実際に動くコード例です。

 追記 2020/06/07: FreeBASIC 1.07.1 で動かなくなっていたのですが、Xusinboy Bekchanov さん、UEZ さん、Tourist Trap さんに、それぞれ修正バージョンを提供いただいたので、内容を置き換えます。

 Win32 API 日本語マニュアルは、下記でダウンロードして下さい。
Win32JP.zip

'Windows API: Open Dialog to Browse for a File
'https://www.freebasic.net/forum/viewtopic.php?f=7&p=272536&sid=fca1d76f95fd4298b29c396997573dcc#p272533
'by Xusinboy Bekchanov ≫ May 27, 2020 14:38 


#Include Once "crt.bi"
#Include Once "windows.bi"
#Include Once "win/commdlg.bi"
#Include Once "win/shlobj.bi"
#Ifndef _FILE_HELPERS_WIN32
#Define _FILE_HELPERS_WIN32

#Define FileOpenDialog(a,b,c,d,e) FileOpenSaveDialog(0,(a),(b),(c),(d),(e))
#Define FileSaveDialog(a,b,c,d,e) FileOpenSaveDialog(1,(a),(b),(c),(d),(e))

Dim Shared As Integer OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS

Dim Shared As Integer OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY

Declare Function FileOpenSaveDialog(iMode As Integer, ByVal szTitle As ZString Ptr , ByVal szInitialDir As ZString Ptr, ByVal _szFilter As ZString Ptr, ByVal iFlags As Dword, ByVal szName As ZString Ptr) As String
Declare Function FileSelectFolder_callback (ByVal hwndbrowse As HWND, ByVal uMsg As UINT, ByVal lp As LPARAM, ByVal lpData As LPARAM) As Integer
Declare Function FileSelectFolder (ByRef title As String = "Choose A Folder", ByVal nCSIDL As Integer, ulFlags As ULong =BIF_NEWDIALOGSTYLE, ByRef sz_InitialDir As String) As String

Type FOLDER_PROPS
   Dim lpszTitle As ZString Ptr
   Dim lpszInitialFolder As ZString Ptr
   Dim As UInteger ulFlags
End Type
Function FileOpenSaveDialog(iMode As Integer, ByVal szTitle As ZString Ptr , ByVal szInitialDir As ZString Ptr, ByVal _szFilter As ZString Ptr, ByVal iFlags As Dword, ByVal szName As ZString Ptr) As String
   Dim ofn As OPENFILENAME
   Dim buff As ZString*260
   Dim sz_Filter As ZString Ptr
   Dim iIndex As UInteger
   ofn.lStructSize=SizeOf(OPENFILENAME)
   ofn.hwndOwner=NULL
   ofn.hInstance=GetModuleHandle(NULL)
   ofn.lpstrInitialDir= szInitialDir
   buff=String(260,0)
   If szName Then
       StrCpy(buff,szName)
   EndIf
   ofn.lpstrFile=@buff
   ofn.nMaxFile=260
    sz_Filter = malloc(StrLen(_szFilter)+2)
    StrCpy(sz_Filter,_szFilter)
    sz_Filter[StrLen(sz_Filter)+1] = 0
    For iIndex = 0 To StrLen(sz_Filter) - 1
      If sz_Filter[iIndex] = Asc("|") Then sz_Filter[iIndex] = 0
    Next iIndex
      ofn.lpstrFilter = sz_Filter
   ofn.lpstrTitle = szTitle
   If iFlags = 0 Then
       ofn.Flags = iFlags
   EndIf
   If iMode = 0 Then
       If GetOpenFileName(@ofn) Then Function =  buff
   Else
       If GetSaveFileName(@ofn) Then Function =  buff
   EndIf
   free(sz_Filter)
End Function

Function FileSelectFolder_callback (ByVal hwndbrowse As HWND, ByVal uMsg As UINT, _
  ByVal lp As LPARAM, ByVal lpData As LPARAM) As Integer
    If uMsg = BFFM_INITIALIZED Then
            Dim fp As FOLDER_PROPS Ptr
            fp = Cast(FOLDER_PROPS Ptr, lpData)
         If fp Then
             If (*fp).lpszInitialFolder Then
                 If (*fp).lpszInitialFolder[0] <> 0   Then
                ' set initial directory
                   SendMessage(hwndbrowse, BFFM_SETSELECTION, TRUE, Cast(LPARAM,fp->lpszInitialFolder))
                EndIf
             EndIf
             If fp->lpszTitle Then
                 If (fp->lpszTitle[0] <>0) Then
                '   // set window caption
                   SetWindowText(hwndbrowse, fp->lpszTitle)
                EndIf
             EndIf
            EndIf
   
        EndIf
    Return 0
End Function

Function FileSelectFolder (ByRef title As String = "Choose A Folder", ByVal nCSIDL As Integer, iFlags As ULong = BIF_EDITBOX, ByRef sz_InitialDir As String) As String
  Dim bi As BROWSEINFO
  Dim pidl As LPITEMIDLIST
  Dim ret As HRESULT
  Dim physpath As ZString * MAX_PATH
  Dim dispname As ZString * MAX_PATH
  Dim fp As FOLDER_PROPS
  bi.hwndOwner = HWND_DESKTOP
  If nCSIDL Then
    ret = SHGetSpecialFolderLocation(HWND_DESKTOP, nCSIDL, Cast(LPITEMIDLIST Ptr, @bi.pidlRoot) )
    'ret = SHGetFolderLocation(HWND_DESKTOP, nCSIDL, NULL, NULL, @bi.pidlRoot)
  Else
   'ret = SHGetSpecialFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP, @bi.pidlRoot)
   ret = SHGetFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP , NULL, NULL, Cast(LPITEMIDLIST Ptr, @bi.pidlRoot))
  EndIf
 
  fp.lpszTitle = StrPtr(Title)
  fp.lpszInitialFolder = StrPtr(sz_InitialDir)
  fp.ulFlags = iFlags
 
  bi.pszDisplayName = @dispname
  bi.lpszTitle = StrPtr(title)
  bi.ulFlags = iFlags
  bi.lpfn = @FileSelectFolder_callback
  bi.lParam = Cast(LPARAM,VarPtr(fp))
  bi.iImage = 0

  pidl = SHBrowseForFolder(@bi)
 
  If pidl <> 0 Then
    If SHGetPathFromIDList(pidl, physpath) = 0 Then
      Function = ""
    Else
      Function = physpath
    End If
    CoTaskMemFree pidl
   Else
    Function = ""
  End If
 
  CoTaskMemFree Cast(LPVOID, bi.pidlRoot)
End Function
#EndIf


'********************* Usage: *****************************


    Dim buff As ZString*260
    Dim ofnFlags As Integer

'FileOpen
    ofnFlags = OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_EXPLORER
    'buff = FileOpenDialog("Open","C:\Program Files\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"")
    buff = FileOpenDialog("Open","C:\tool\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"")
    Print buff
    Sleep


''FileSave
'    ofnFlags = OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
'    buff = FileSaveDialog("Save","C:\Program Files\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"untitled.bas")
'
''Select Folder
'     ofnFlags = BIF_NEWDIALOGSTYLE Or BIF_RETURNONLYFSDIRS
'     buff = FileSelectFolder("Select Folder",0,ofnFlags,"C:\Program Files")

'Windows API: Open Dialog to Browse for a File
'https://www.freebasic.net/forum/viewtopic.php?f=7&p=272536&sid=fca1d76f95fd4298b29c396997573dcc#p272534
'by UEZ ≫ May 27, 2020 14:40 


#Include Once "crt.bi"
#Include Once "windows.bi"
#Include Once "win/commdlg.bi"
#Include Once "win/shlobj.bi"
#Ifndef _FILE_HELPERS_WIN32
#Define _FILE_HELPERS_WIN32

#Define FileOpenDialog(a,b,c,d,e) FileOpenSaveDialog(0,(a),(b),(c),(d),(e))
#Define FileSaveDialog(a,b,c,d,e) FileOpenSaveDialog(1,(a),(b),(c),(d),(e))

Dim Shared As Integer OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS

Dim Shared As Integer OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY

Declare Function FileOpenSaveDialog(iMode As Integer, ByVal szTitle As ZString Ptr , ByVal szInitialDir As ZString Ptr, ByVal _szFilter As ZString Ptr, ByVal iFlags As Dword, ByVal szName As ZString Ptr) As String
Declare Function FileSelectFolder_callback (ByVal hwndbrowse As HWND, ByVal uMsg As UINT, ByVal lp As LPARAM, ByVal lpData As LPARAM) As Integer
Declare Function FileSelectFolder (ByRef title As String = "Choose A Folder", ByVal nCSIDL As Integer, iFlags As ULong = BIF_EDITBOX, ByRef sz_InitialDir As String) As String

Type FOLDER_PROPS
   Dim lpszTitle As ZString Ptr
   Dim lpszInitialFolder As ZString Ptr
   Dim As UInteger ulFlags
End Type
Function FileOpenSaveDialog(iMode As Integer, ByVal szTitle As ZString Ptr , ByVal szInitialDir As ZString Ptr, ByVal _szFilter As ZString Ptr, ByVal iFlags As Dword, ByVal szName As ZString Ptr) As String
   Dim ofn As OPENFILENAME
   Dim buff As ZString*260
   Dim sz_Filter As ZString Ptr
   Dim iIndex As UInteger
   ofn.lStructSize=SizeOf(OPENFILENAME)
   ofn.hwndOwner=NULL
   ofn.hInstance=GetModuleHandle(NULL)
   ofn.lpstrInitialDir= szInitialDir
   buff=String(260,0)
   If szName Then
       StrCpy(buff,szName)
   EndIf
   ofn.lpstrFile=@buff
   ofn.nMaxFile=260
    sz_Filter = malloc(StrLen(_szFilter)+2)
    StrCpy(sz_Filter,_szFilter)
    sz_Filter[StrLen(sz_Filter)+1] = 0
    For iIndex = 0 To StrLen(sz_Filter) - 1
      If sz_Filter[iIndex] = Asc("|") Then sz_Filter[iIndex] = 0
    Next iIndex
      ofn.lpstrFilter = sz_Filter
   ofn.lpstrTitle = szTitle
   If iFlags = 0 Then
       ofn.Flags = iFlags
   EndIf
   If iMode = 0 Then
       If GetOpenFileName(@ofn) Then Function =  buff
   Else
       If GetSaveFileName(@ofn) Then Function =  buff
   EndIf
   free(sz_Filter)
End Function

Function FileSelectFolder_callback (ByVal hwndbrowse As HWND, ByVal uMsg As UINT, _
  ByVal lp As LPARAM, ByVal lpData As LPARAM) As Integer
    If uMsg = BFFM_INITIALIZED Then
            Dim fp As FOLDER_PROPS Ptr
            fp = Cast(FOLDER_PROPS Ptr, lpData)
         If fp Then
             If (*fp).lpszInitialFolder Then
                 If (*fp).lpszInitialFolder[0] <> 0   Then
                ' set initial directory
                   SendMessage(hwndbrowse, BFFM_SETSELECTION, TRUE, Cast(LPARAM,fp->lpszInitialFolder))
                EndIf
             EndIf
             If fp->lpszTitle Then
                 If (fp->lpszTitle[0] <>0) Then
                '   // set window caption
                   SetWindowText(hwndbrowse, fp->lpszTitle)
                EndIf
             EndIf
            EndIf
   
        EndIf
    Return 0
End Function

Function FileSelectFolder (ByRef title As String = "Choose A Folder", ByVal nCSIDL As Integer, iFlags As ULong = BIF_EDITBOX, ByRef sz_InitialDir As String) As String
  Dim bi As BROWSEINFO
  Dim pidl As LPITEMIDLIST
  Dim ret As HRESULT
  Dim physpath As ZString * MAX_PATH
  Dim dispname As ZString * MAX_PATH
  Dim fp As FOLDER_PROPS
  bi.hwndOwner = HWND_DESKTOP
  If nCSIDL Then
    ret = SHGetSpecialFolderLocation(HWND_DESKTOP, nCSIDL, Cast(Any Ptr, @bi.pidlRoot))
    'ret = SHGetFolderLocation(HWND_DESKTOP, nCSIDL, NULL, NULL, @bi.pidlRoot)
  Else
   'ret = SHGetSpecialFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP, @bi.pidlRoot)
   ret = SHGetFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP , NULL, NULL, Cast(Any Ptr, @bi.pidlRoot))
  EndIf
 
  fp.lpszTitle = StrPtr(Title)
  fp.lpszInitialFolder = StrPtr(sz_InitialDir)
  fp.ulFlags = iFlags
 
  bi.pszDisplayName = @dispname
  bi.lpszTitle = StrPtr(title)
  bi.ulFlags = iFlags
  bi.lpfn = @FileSelectFolder_callback
  bi.lParam = Cast(LPARAM,VarPtr(fp))
  bi.iImage = 0

  pidl = SHBrowseForFolder(@bi)
 
  If pidl <> 0 Then
    If SHGetPathFromIDList(pidl, physpath) = 0 Then
      Function = ""
    Else
      Function = physpath
    End If
    CoTaskMemFree pidl
   Else
    Function = ""
  End If
 
  CoTaskMemFree(@bi.pidlRoot)
End Function
#EndIf


'********************* Usage: *****************************


    Dim buff As ZString*260
    Dim ofnFlags As Integer

'FileOpen
    ofnFlags = OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_EXPLORER
    'buff = FileOpenDialog("Open","C:\Program Files\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"")
    buff = FileOpenDialog("Open","C:\tool\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"")
    Print buff
    Sleep


''FileSave
'    ofnFlags = OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
'    buff = FileSaveDialog("Save","C:\Program Files\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"untitled.bas")
'
''Select Folder
'     ofnFlags = BIF_NEWDIALOGSTYLE Or BIF_RETURNONLYFSDIRS
'     buff = FileSelectFolder("Select Folder",0,ofnFlags,"C:\Program Files")


'Windows API: Open Dialog to Browse for a File
'https://www.freebasic.net/forum/viewtopic.php?f=7&p=272536&sid=fca1d76f95fd4298b29c396997573dcc#p272536
'by Tourist Trap ≫ May 27, 2020 15:01 


#Include Once "crt.bi"
#Include Once "windows.bi"
#Include Once "win/commdlg.bi"
#Include Once "win/shlobj.bi"
#Ifndef _FILE_HELPERS_WIN32
#Define _FILE_HELPERS_WIN32

#Define FileOpenDialog(a,b,c,d,e) FileOpenSaveDialog(0,(a),(b),(c),(d),(e))
#Define FileSaveDialog(a,b,c,d,e) FileOpenSaveDialog(1,(a),(b),(c),(d),(e))

Dim Shared As Integer OFS_FILE_OPEN_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_CREATEPROMPT _
Or OFN_NODEREFERENCELINKS

Dim Shared As Integer OFS_FILE_SAVE_FLAGS = OFN_EXPLORER _
Or OFN_LONGNAMES _
Or OFN_OVERWRITEPROMPT _
Or OFN_HIDEREADONLY

Declare Function FileOpenSaveDialog(iMode As Integer, ByVal szTitle As ZString Ptr , ByVal szInitialDir As ZString Ptr, ByVal _szFilter As ZString Ptr, ByVal iFlags As Dword, ByVal szName As ZString Ptr) As String
Declare Function FileSelectFolder_callback (ByVal hwndbrowse As HWND, ByVal uMsg As UINT, ByVal lp As LPARAM, ByVal lpData As LPARAM) As Integer
Declare Function FileSelectFolder (ByRef title As String = "Choose A Folder", ByVal nCSIDL As Integer, ulFlags As ULong =BIF_NEWDIALOGSTYLE, ByRef sz_InitialDir As String) As String

Type FOLDER_PROPS
   Dim lpszTitle As ZString Ptr
   Dim lpszInitialFolder As ZString Ptr
   Dim As UInteger ulFlags
End Type
Function FileOpenSaveDialog(iMode As Integer, ByVal szTitle As ZString Ptr , ByVal szInitialDir As ZString Ptr, ByVal _szFilter As ZString Ptr, ByVal iFlags As Dword, ByVal szName As ZString Ptr) As String
   Dim ofn As OPENFILENAME
   Dim buff As ZString*260
   Dim sz_Filter As ZString Ptr
   Dim iIndex As UInteger
   ofn.lStructSize=SizeOf(OPENFILENAME)
   ofn.hwndOwner=NULL
   ofn.hInstance=GetModuleHandle(NULL)
   ofn.lpstrInitialDir= szInitialDir
   buff=String(260,0)
   If szName Then
       StrCpy(buff,szName)
   EndIf
   ofn.lpstrFile=@buff
   ofn.nMaxFile=260
    sz_Filter = malloc(StrLen(_szFilter)+2)
    StrCpy(sz_Filter,_szFilter)
    sz_Filter[StrLen(sz_Filter)+1] = 0
    For iIndex = 0 To StrLen(sz_Filter) - 1
      If sz_Filter[iIndex] = Asc("|") Then sz_Filter[iIndex] = 0
    Next iIndex
      ofn.lpstrFilter = sz_Filter
   ofn.lpstrTitle = szTitle
   If iFlags = 0 Then
       ofn.Flags = iFlags
   EndIf
   If iMode = 0 Then
       If GetOpenFileName(@ofn) Then Function =  buff
   Else
       If GetSaveFileName(@ofn) Then Function =  buff
   EndIf
   free(sz_Filter)
End Function

Function FileSelectFolder_callback (ByVal hwndbrowse As HWND, ByVal uMsg As UINT, _
  ByVal lp As LPARAM, ByVal lpData As LPARAM) As Integer
    If uMsg = BFFM_INITIALIZED Then
            Dim fp As FOLDER_PROPS Ptr
            fp = Cast(FOLDER_PROPS Ptr, lpData)
         If fp Then
             If (*fp).lpszInitialFolder Then
                 If (*fp).lpszInitialFolder[0] <> 0   Then
                ' set initial directory
                   SendMessage(hwndbrowse, BFFM_SETSELECTION, TRUE, Cast(LPARAM,fp->lpszInitialFolder))
                EndIf
             EndIf
             If fp->lpszTitle Then
                 If (fp->lpszTitle[0] <>0) Then
                '   // set window caption
                   SetWindowText(hwndbrowse, fp->lpszTitle)
                EndIf
             EndIf
            EndIf
   
        EndIf
    Return 0
End Function

Function FileSelectFolder _ 
(ByRef title As String = "Choose A Folder",_ 
ByVal nCSIDL As Integer, _
iFlags As ULong, _
ByRef sz_InitialDir As String) As String
  Dim bi As BROWSEINFO
  Dim pidl As LPITEMIDLIST
  Dim ret As HRESULT
  Dim physpath As ZString * MAX_PATH
  Dim dispname As ZString * MAX_PATH
  Dim fp As FOLDER_PROPS
  bi.hwndOwner = HWND_DESKTOP
  If nCSIDL Then
    ret = SHGetSpecialFolderLocation(HWND_DESKTOP, nCSIDL, Cast(PIDLIST_ABSOLUTE Ptr, @bi.pidlRoot))
    'ret = SHGetFolderLocation(HWND_DESKTOP, nCSIDL, NULL, NULL, @bi.pidlRoot)
  Else
   'ret = SHGetSpecialFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP, @bi.pidlRoot)
   ret = SHGetFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP , NULL, NULL, Cast(PIDLIST_ABSOLUTE Ptr, @bi.pidlRoot))
  EndIf
 
  fp.lpszTitle = StrPtr(Title)
  fp.lpszInitialFolder = StrPtr(sz_InitialDir)
  fp.ulFlags = iFlags
 
  bi.pszDisplayName = @dispname
  bi.lpszTitle = StrPtr(title)
  bi.ulFlags = iFlags
  bi.lpfn = Cast(BFFCALLBACK, @FileSelectFolder_callback)
  bi.lParam = Cast(LPARAM,VarPtr(fp))
  bi.iImage = 0

  pidl = SHBrowseForFolder(@bi)
 
  If pidl <> 0 Then
    If SHGetPathFromIDList(pidl, physpath) = 0 Then
      Function = ""
    Else
      Function = physpath
    End If
    CoTaskMemFree pidl
   Else
    Function = ""
  End If
 
  CoTaskMemFree Cast(PCIDLIST_ABSOLUTE Ptr, @bi.pidlRoot)
End Function
#EndIf


'********************* Usage: *****************************


    Dim buff As ZString*260
    Dim ofnFlags As Integer

'FileOpen
    ofnFlags = OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_EXPLORER
    'buff = FileOpenDialog("Open","C:\Program Files\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"")
    buff = FileOpenDialog("Open","C:\tool\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"")
    Print buff
    Sleep

''FileSave
'    ofnFlags = OFN_LONGNAMES Or OFN_PATHMUSTEXIST Or OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
'    buff = FileSaveDialog("Save","C:\Program Files\FreeBasic\examples","FreeBasic(*.bas;*.bi)|*.bas;*.bi|All(*.*)|*.*",ofnFlags,"untitled.bas")
'
''Select Folder
'     ofnFlags = BIF_NEWDIALOGSTYLE Or BIF_RETURNONLYFSDIRS
'     buff = FileSelectFolder("Select Folder",0,ofnFlags,"C:\Program Files")

 
補足 に戻る
←リンク元に戻る プログラム開発関連に戻る
ページ歴史:2008-04-22 / 2020-06-07
日本語翻訳:WATANABE Makoto、原文著作者:spodhaje

ホームページのトップに戻る

表示-非営利-継承