Code: Select all
ScreenControl GET_WINDOW_HANDLE,cast(Integer,hwnd)
EDIT: Is there any way to have a full screen mode come back? Another words, not minimized after exiting the dialog
Code: Select all
ScreenControl GET_WINDOW_HANDLE,cast(Integer,hwnd)
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")
This works for me compiled as 32-bit only: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'
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")
Hi Makoto WATANABE,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.
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
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")
Yes, that's a way to force Windows XP users to upgrade their OS. The old version will work another century, though.marcov wrote:Note that the comdlg way is deprecated, and the current recommended way is over IFileDialog.
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.jj2007 wrote:Yes, that's a way to force Windows XP users to upgrade their OS. The old version will work another century, though.marcov wrote:Note that the comdlg way is deprecated, and the current recommended way is over IFileDialog.
No offense taken, I'm not always subtle myself:-)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.
This code example works fine but I get chinese characters in the some places of the dialog. How can I make it 100% english?Tourist Trap wrote: ↑May 27, 2020 15:01Hi Makoto WATANABE,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 don't know if the fixes below can help you: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.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
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")