Windows API: Open Dialog to Browse for a File

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
dpixel
Posts: 74
Joined: Aug 13, 2008 11:34
Location: US

Postby dpixel » Apr 11, 2009 21:00

Make sure you're not calling this from in between screenlock and screenunlock. It seems like the line:

Code: Select all

ScreenControl GET_WINDOW_HANDLE,cast(Integer,hwnd)

won't work with the screen locked.

EDIT: Is there any way to have a full screen mode come back? Another words, not minimized after exiting the dialog
BasicScience
Posts: 489
Joined: Apr 18, 2008 4:09
Location: Los Angeles, CA
Contact:

Postby BasicScience » Apr 12, 2009 16:48

I haven't come across your problem, with the FB application becoming minimized after closing the WinAPI OpenFileDialog.

One difference may be that I don't use FullScreen for the FB App. The reason I don't use FullScreen is that there is glitch between screen coordinates and mouse coordinates whenever FullScreen with a window border is used.

Through trial and error, I've found the size set by ScreenRes Screen_width, Screen_Height can be up to about 90% of the physical limits for the screen. (I expect there is some absolute reduction in window size below full screen, to allow for a border, rather than a relative scale factor).
Makoto WATANABE
Posts: 196
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: Windows API: Open Dialog to Browse for a File

Postby Makoto WATANABE » May 27, 2020 13:34

Dear Guys;

I compiled this code with FreeBASIC 1.07.1 32bit version (Windows 10).
by spodhaje » Apr 21, 2008 22:00

Then, the following errors were displayed.
Please tell me how to fix it.

(I'm sorry I didn't look it up myself and just gave it away.)

error 181: Invalid assignment/conversion, at parameter 3 of SHGETSPECIALFOLDERLOCATION() in 'ret = SHGetSpecialFolderLocation(HWND_DESKTOP, nCSIDL, @bi.pidlRoot)'
error 181: Invalid assignment/conversion, at parameter 5 of SHGETFOLDERLOCATION() in 'ret = SHGetFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP , NULL, NULL, @bi.pidlRoot)'
error 181: Invalid assignment/conversion, at parameter 1 of COTASKMEMFREE() in 'CoTaskMemFree bi.pidlRoot'
Xusinboy Bekchanov
Posts: 254
Joined: Jul 26, 2018 18:28

Re: Windows API: Open Dialog to Browse for a File

Postby Xusinboy Bekchanov » May 27, 2020 14:38

Can do so:

Code: Select all

#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

    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,"")

'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")
UEZ
Posts: 635
Joined: May 05, 2017 19:59
Location: Germany

Re: Windows API: Open Dialog to Browse for a File

Postby UEZ » May 27, 2020 14:40

Makoto WATANABE wrote:Dear Guys;

I compiled this code with FreeBASIC 1.07.1 32bit version (Windows 10).
by spodhaje » Apr 21, 2008 22:00

Then, the following errors were displayed.
Please tell me how to fix it.

(I'm sorry I didn't look it up myself and just gave it away.)

error 181: Invalid assignment/conversion, at parameter 3 of SHGETSPECIALFOLDERLOCATION() in 'ret = SHGetSpecialFolderLocation(HWND_DESKTOP, nCSIDL, @bi.pidlRoot)'
error 181: Invalid assignment/conversion, at parameter 5 of SHGETFOLDERLOCATION() in 'ret = SHGetFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP , NULL, NULL, @bi.pidlRoot)'
error 181: Invalid assignment/conversion, at parameter 1 of COTASKMEMFREE() in 'CoTaskMemFree bi.pidlRoot'


This works for me compiled as 32-bit only:

Code: Select all

#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

    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,"")

'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")


For 64-bit I need to have deeper look to strcpy / strlen calls.
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Windows API: Open Dialog to Browse for a File

Postby Tourist Trap » May 27, 2020 15:01

Makoto WATANABE wrote:Dear Guys;

I compiled this code with FreeBASIC 1.07.1 32bit version (Windows 10).
by spodhaje » Apr 21, 2008 22:00

Then, the following errors were displayed.
Please tell me how to fix it.

Hi Makoto WATANABE,

I don't know if the fixes below can help you:

Code: Select all

#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

I read the definition from msdn like here https://docs.microsoft.com/en-us/window ... rowseinfoa, and played a little around. It compiles, but I'm still not sure if it will work.

edit: Ok got the test code posted by the author, and it seems to work.

Code: Select all

#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


    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,"")

'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")

Makoto WATANABE
Posts: 196
Joined: Apr 10, 2010 11:41
Location: Japan
Contact:

Re: Windows API: Open Dialog to Browse for a File

Postby Makoto WATANABE » May 28, 2020 4:30

Dear All;

Thanks for your quick reply.

The three answers you provided have different code content, but all of them worked well in my environment.
I can now easily identify and process the required target files with FreeBASIC.

Thank you for your continued support.
marcov
Posts: 3020
Joined: Jun 16, 2005 9:45
Location: Eindhoven, NL
Contact:

Re: Windows API: Open Dialog to Browse for a File

Postby marcov » May 28, 2020 8:35

Note that the comdlg way is deprecated, and the current recommended way is over IFileDialog.

The note is visible e.g. if you pull up MSDN for getopenfilename()
jj2007
Posts: 1726
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Windows API: Open Dialog to Browse for a File

Postby jj2007 » May 28, 2020 10:29

marcov wrote:Note that the comdlg way is deprecated, and the current recommended way is over IFileDialog.
Yes, that's a way to force Windows XP users to upgrade their OS. The old version will work another century, though.
marcov
Posts: 3020
Joined: Jun 16, 2005 9:45
Location: Eindhoven, NL
Contact:

Re: Windows API: Open Dialog to Browse for a File

Postby marcov » May 28, 2020 10:41

jj2007 wrote:
marcov wrote:Note that the comdlg way is deprecated, and the current recommended way is over IFileDialog.
Yes, that's a way to force Windows XP users to upgrade their OS. The old version will work another century, though.


Not necessarily. If you wrap functions like the example shows you can actually do a windows version detection and choose what to call. IOW keep up with normal industry practices and avoid the thin-foil hat division stifling any progress if you still think that is worthwhile.

That said, the ones that REALLY follow Microsoft policies to the letter have dumped win32/64 with the .NET emergence in 2002, and are now moving over to the "Apps" platform in javascript or so. I want to be absolutely clear 'm not in THAT group.
Last edited by marcov on May 28, 2020 12:17, edited 1 time in total.
jj2007
Posts: 1726
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Windows API: Open Dialog to Browse for a File

Postby jj2007 » May 28, 2020 12:07

Just kidding - I'm not a Windows XP user any more. Unless I need to run an old 16-bit program in my VM for which I have the XP license only, of course. My main OS is Win7-64, my kids are using Win10 and I see lots of good reasons to stay away from that crap.
marcov
Posts: 3020
Joined: Jun 16, 2005 9:45
Location: Eindhoven, NL
Contact:

Re: Windows API: Open Dialog to Browse for a File

Postby marcov » May 28, 2020 12:28

jj2007 wrote:Just kidding - I'm not a Windows XP user any more. Unless I need to run an old 16-bit program in my VM for which I have the XP license only, of course. My main OS is Win7-64, my kids are using Win10 and I see lots of good reasons to stay away from that crap.


No offense taken, I'm not always subtle myself:-)

I migrated all (XP,vista) machines I still used to 64-bit when windows 8 came out. There was some offer to upgrade to win8 for about $23 for a while, and I had already played with win8 at work and it seemed ok (sure, idio-tic startmenu and config panel, but I wasn't that big on start menu anyway).

My main motivation was to get rid of OEM licenses with all kinds of convoluted install methods, and get licenses installable from standard media. Turned out that you could chose the bittiness when reinstalling, so I made them all 64-bit as a bonus. Some of these licenses I still use, though recently Microsoft has said they can't move machines any more.

Another reason is the fact that at work we sell our apps with machines with OEM licenses means that I can't really play ostrich and stick with old versions, since that will sooner or later bite me in the @#@ supportwise. And usually the cheaper OEM licenses were only available in the current version after about 6-12 months after release.

Anyway, there are some problems with the old way, which is why lazarus iirc moved to the new one with a detection, but I'm no real gui man, so don't know the details.

p.s. changed fantastic to idio-tic since forum seems to replace it with fantastic. Just like the first fantastic in this line

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 8 guests