Yesterday, 06:14 PM
This is some older code (a few years old) but it should still work. This code will allow you to use both ANSI and Wide-string (unicode) versions of the Open, Save, and Folder browse dialogs. It even allows for multiple file selection. (Ignore the formatting on this post. The syntax highlighting is not good for the code blocks.
Basic usage for Unicode:
Basic usage for ANSI:
Basic usage for ANSI with Multiple:
OpenSaveW.BI
OpenSaveW.BI (Size: 856 bytes / Downloads: 4)
OpenSaveW.BM
OpenSaveW.BM (Size: 9.59 KB / Downloads: 4)
unicodetoansi.bas
unicodetoansi.bas (Size: 1.88 KB / Downloads: 4)
ptrtostr.BM
ptrtostr.BM (Size: 1.89 KB / Downloads: 4)
Basic usage for Unicode:
Code: (Select All)
Dim As _Offset myFile
myFile = ComDlgFileName ("Open File Dialog", ".\", "Video Files (*.MKV, *.MP4)|*.MKV;*.MP4", 0, UNICODE)
Dim As String myWideString
myWideString = PointerToWideString (myFile)Basic usage for ANSI:
Code: (Select All)
Dim As _Offset myFile
myFile = ComDlgFileName ("Open File Dialog", ".\", "Video Files (*.MKV, *.MP4)|*.MKV;*.MP4", 0, 0)
Dim As String myString
myString = PointerToString (myFile)Basic usage for ANSI with Multiple:
Code: (Select All)
Dim As _Offset myFiles
myFiles = ComDlgFileName ("Open File Dialog", ".\", "Video Files (*.MKV, *.MP4)|*.MKV;*.MP4", 0, OFN_ALLOWMULTISELECT)
Dim As String myString
myString = PointerToString (myFiles)
'do some work to split by the pipe (|) character, possibly using my tokenize functionOpenSaveW.BI
OpenSaveW.BI (Size: 856 bytes / Downloads: 4)
Code: (Select All)
Const OFN_ALLOWMULTISELECT = &H00000200
Const OFN_CREATEPROMPT = &H00002000
Const OFN_DONTADDTORECENT = &H02000000
Const OFN_EXPLORER = &H00080000
Const OFN_EXTENSIONDIFFERENT = &H00000400
Const OFN_FILEMUSTEXIST = &H00001000
Const OFN_FORCESHOWHIDDEN = &H10000000
Const OFN_HIDEREADONLY = &H00000004
Const OFN_NOCHANGEDIR = &H00000008
Const OFN_NODEREFERENCELINKS = &H00100000
Const OFN_NONETWORKBUTTON = &H00020000
Const OFN_NOREADONLYRETURN = &H00008000
Const OFN_NOTESTFILECREATE = &H00010000
Const OFN_NOVALIDATE = &H00000100
Const OFN_OVERWRITEPROMPT = &H00000002
Const OFN_PATHMUSTEXIST = &H00000800
Const OFN_READONLY = &H00000001
Const OFN_SHAREAWARE = &H00004000
Const OFN_SHOWHELP = &H00000010
Const SAVE_DIALOG = &H01000000
Const OPEN_DIALOG = &H02000000
Const UNICODE = &H07000000
Const STRSAFE_MAX_CCH = 2147483647OpenSaveW.BM
OpenSaveW.BM (Size: 9.59 KB / Downloads: 4)
Code: (Select All)
Type OPENFILENAME
As _Unsigned Long lStructSize
$If 64BIT Then
As String * 4 padding
$End If
As _Offset hwndOwner, hInstance, lpstrFilter, lpstrCustomFilter
As _Unsigned Long nMaxCustFilter, nFilterIndex
As _Offset lpstrFile
As _Unsigned Long nMaxFile
$If 64BIT Then
As String * 4 padding2
$End If
As _Offset lpstrFileTitle
As _Unsigned Long nMaxFileTitle
$If 64BIT Then
As String * 4 padding3
$End If
As _Offset lpstrInitialDir, lpstrTitle
As _Unsigned Long Flags
As Integer nFileOffset, nFileExtension
As _Offset lpstrDefExt, lCustData, lpfnHook, lpTemplateName, pvReserved
As _Unsigned Long dwReserved, FlagsEx
End Type
Type BROWSEINFO
As _Offset hwndOwner, pidlRoot, pszDisplayName, lpszTitle
As _Unsigned Long ulFlags
As _Offset lpfn, lParam
As Long iImage
End Type
Declare Dynamic Library "Comdlg32"
Sub GetSaveFileNameW (ByVal ofn As _Offset)
Function GetOpenFileNameW& (ByVal ofn As _Offset)
Sub GetSaveFileNameA (ByVal ofn As _Offset)
Function GetOpenFileNameA& (ByVal ofn As _Offset)
End Declare
Declare Dynamic Library "Shell32"
Function SHBrowseForFolderW%& (ByVal lpbi As _Offset)
Function SHGetPathFromIDListW%% (ByVal lpItem As _Offset, Byval szDir As _Offset)
Function SHBrowseForFolderA%& (ByVal lpbi As _Offset)
Function SHGetPathFromIDListA%% (ByVal lpItem As _Offset, Byval szDir As _Offset)
End Declare
$If TCSLEN = UNDEFINED Then
$Let TCSLEN = DEFINED
$If 64BIT Then
Declare CustomType Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\tchar"
Function tcslen%& Alias "_tcslen" (ByVal str As _Offset)
End Declare
$Else
Declare CustomType Library ".\internal\c\c_compiler\i686-w64-mingw32\include\tchar"
Function tcslen%& Alias "_tcslen" (ByVal str As _Offset)
End Declare
$End If
$End If
$If WCSLEN = UNDEFINED Then
$Let WCSLEN = DEFINED
Declare CustomType Library
Function wcslen%& (ByVal str As _Offset)
End Declare
$End If
Function ComDlgFileName%& (__Title As String, InitialDir As String, Filter As String, FilterIndex As _Unsigned Long, Flags As _Unsigned Long)
If Flags And UNICODE Then
Flags = Flags - UNICODE
ComDlgFileName = ComDlgFileNameW(__Title, InitialDir, Filter, FilterIndex, Flags)
Else
ComDlgFileName = ComDlgFileNameA(__Title, InitialDir, Filter, FilterIndex, Flags)
End If
End Function
Function ComDlgFileNameW%& (__Title As String, InitialDir As String, Filter As String, FilterIndex As _Unsigned Long, Flags As _Unsigned Long)
Const MAX_PATH = 65534
Dim As OPENFILENAME ofn
Do
Mid$(Filter, InStr(Filter, "|")) = Chr$(0)
Loop While InStr(Filter, "|")
__Title = ANSIToUnicode(__Title + Chr$(0))
InitialDir = ANSIToUnicode(InitialDir + Chr$(0))
Filter = ANSIToUnicode(Filter + Chr$(0) + Chr$(0))
Dim As String * MAX_PATH oFile
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = _WindowHandle
ofn.lpstrFilter = _Offset(Filter)
ofn.nFilterIndex = FilterIndex
ofn.nMaxFile = Len(oFile)
ofn.lpstrFileTitle = ofn.lpstrFile
ofn.nMaxFileTitle = ofn.nMaxFile
ofn.lpstrInitialDir = _Offset(InitialDir)
ofn.lpstrTitle = _Offset(__Title)
ofn.lpstrFile = _Offset(oFile)
If OPEN_DIALOG And Flags Or (SAVE_DIALOG And Flags) = 0 Then
If OFN_ALLOWMULTISELECT And Flags Then Flags = Flags Or OFN_EXPLORER
Flags = Flags Or OFN_HIDEREADONLY
ofn.Flags = Flags
If GetOpenFileNameW(_Offset(ofn)) <> 0 Then
If OFN_ALLOWMULTISELECT And Flags Then
Dim As String file, outfiles, directory
Dim As _Offset tmp: tmp = ofn.lpstrFile + (ofn.nFileOffset * 2)
Dim As _MEM pFiles: pFiles = _Mem(tmp, wcslen(tmp) * 2)
Dim As _MEM dir: dir = _Mem(ofn.lpstrFile, wcslen(ofn.lpstrFile) * 2)
directory = Space$(wcslen(ofn.lpstrFile) * 2)
_MemGet dir, dir.OFFSET, directory
_MemFree dir
Dim As Long i
While wcslen(tmp)
file = Space$(wcslen(tmp) * 2)
_MemGet pFiles, pFiles.OFFSET, file
Select Case i
Case 0
outfiles = directory + ANSIToUnicode("\") + file
Case Else
outfiles = outfiles + ANSIToUnicode("|") + directory + ANSIToUnicode("\") + file
End Select
i = i + 1
tmp = tmp + Len(file) + 2
pFiles = _Mem(tmp, wcslen(tmp) * 2)
Wend
_MemFree pFiles
If i = 1 Then
ComDlgFileNameW = _Offset(directory)
Else
ComDlgFileNameW = _Offset(outfiles)
End If
Else
ComDlgFileNameW = ofn.lpstrFile
End If
End If
ElseIf SAVE_DIALOG And Flags Then
ofn.Flags = Flags
Dim As String defaultExt: defaultExt = ANSIToUnicode(DEFEXT + Chr$(0))
ofn.lpstrDefExt = _Offset(defaultExt)
GetSaveFileNameW _Offset(ofn)
ComDlgFileNameW = ofn.lpstrFile
End If
End Function
Function ComDlgFileNameA%& (__Title As String, InitialDir As String, Filter As String, FilterIndex As _Unsigned Long, Flags As _Unsigned Long)
Const MAX_PATH = 260
Dim As OPENFILENAME ofn
Do
Mid$(Filter, InStr(Filter, "|")) = Chr$(0)
Loop While InStr(Filter, "|")
__Title = __Title + Chr$(0)
InitialDir = InitialDir + Chr$(0)
Filter = Filter + Chr$(0) + Chr$(0)
Dim As String * MAX_PATH oFile
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = _WindowHandle
ofn.lpstrFilter = _Offset(Filter)
ofn.nFilterIndex = FilterIndex
ofn.nMaxFile = Len(oFile)
ofn.lpstrFileTitle = ofn.lpstrFile
ofn.nMaxFileTitle = ofn.nMaxFile
ofn.lpstrInitialDir = _Offset(InitialDir)
ofn.lpstrTitle = _Offset(__Title)
ofn.lpstrFile = _Offset(oFile)
If OPEN_DIALOG And Flags Or (SAVE_DIALOG And Flags) = 0 Then
If OFN_ALLOWMULTISELECT And Flags Then Flags = Flags Or OFN_EXPLORER
Flags = Flags Or OFN_HIDEREADONLY
ofn.Flags = Flags
If GetOpenFileNameA(_Offset(ofn)) <> 0 Then
If OFN_ALLOWMULTISELECT And Flags Then
Dim As String file, outfiles, directory
Dim As _Offset tmp: tmp = ofn.lpstrFile + ofn.nFileOffset
Dim As _MEM pFiles: pFiles = _Mem(tmp, tcslen(tmp))
Dim As _MEM dir: dir = _Mem(ofn.lpstrFile, tcslen(ofn.lpstrFile))
directory = Space$(tcslen(ofn.lpstrFile))
_MemGet dir, dir.OFFSET, directory
_MemFree dir
Dim As Long i
While tcslen(tmp)
file = Space$(tcslen(tmp))
_MemGet pFiles, pFiles.OFFSET, file
Select Case i
Case 0
outfiles = directory + "\" + file
Case Else
outfiles = outfiles + "|" + directory + "\" + file
End Select
i = i + 1
tmp = tmp + (tcslen(tmp) + 1)
pFiles = _Mem(tmp, tcslen(tmp))
Wend
_MemFree pFiles
If i = 1 Then
file = directory
ComDlgFileNameA = _Offset(file)
Else
ComDlgFileNameA = _Offset(outfiles)
End If
Else
ComDlgFileNameA = ofn.lpstrFile
End If
End If
ElseIf SAVE_DIALOG And Flags Then
ofn.Flags = Flags
Dim As String defaultExt: defaultExt = DEFEXT + Chr$(0)
ofn.lpstrDefExt = _Offset(defaultExt)
GetSaveFileNameA _Offset(ofn)
ComDlgFileNameA = ofn.lpstrFile
End If
End Function
Function SelectFolder%& (__Title As String, Flag As _Unsigned Long)
If Flag = UNICODE Then
SelectFolder = SelectFolderW(__Title)
Else
SelectFolder = SelectFolderA(__Title)
End If
End Function
Function SelectFolderW%& (__Title As String)
Const MAX_PATH = 65534
Dim As BROWSEINFO browse
Dim As String * MAX_PATH folder
__Title = ANSIToUnicode(__Title + Chr$(0))
browse.hwndOwner = _WindowHandle
browse.pszDisplayName = _Offset(folder)
browse.lpszTitle = _Offset(__Title)
Dim As _Offset pFolder
pFolder = SHBrowseForFolderW(_Offset(browse))
If pFolder Then
Dim As String * MAX_PATH resolvedPath
If SHGetPathFromIDListW(pFolder, _Offset(resolvedPath)) Then
SelectFolderW = _Offset(resolvedPath)
End If
End If
End Function
Function SelectFolderA%& (__Title As String)
Const MAX_PATH = 260
Dim As BROWSEINFO browse
Dim As String * MAX_PATH folder
__Title = __Title + Chr$(0)
browse.hwndOwner = _WindowHandle
browse.pszDisplayName = _Offset(folder)
browse.lpszTitle = _Offset(__Title)
Dim As _Offset pfolder
pfolder = SHBrowseForFolderA(_Offset(browse))
If pfolder Then
Dim As String * MAX_PATH resolvedPath
If SHGetPathFromIDListA(pfolder, _Offset(resolvedPath)) Then
SelectFolderA = _Offset(resolvedPath)
End If
End If
End Function
'$INCLUDE:'unicodetoansi.bas'unicodetoansi.bas
unicodetoansi.bas (Size: 1.88 KB / Downloads: 4)
Code: (Select All)
$If UNICODETOANSI = UNDEFINED Then
$Let UNICODETOANSI = DEFINED
Declare CustomType Library
Function WideCharToMultiByte& (ByVal CodePage As _Unsigned Long, Byval dwFlags As Long, Byval lpWideCharStr As _Offset, Byval cchWideChar As Integer, Byval lpMultiByteStr As _Offset, Byval cbMultiByte As Integer, Byval lpDefaultChar As _Offset, Byval lpUsedDefaultChar As _Offset)
Function MultiByteToWideChar& (ByVal CodePage As _Unsigned Long, Byval dwFlags As Long, Byval lpMultiByteStr As _Offset, Byval cbMultiByte As Integer, Byval lpWideCharStr As _Offset, Byval cchWideChar As Integer)
End Declare
Function UnicodeToANSI$ (buffer As String)
Dim As String ansibuffer: ansibuffer = Space$(Len(buffer))
Dim As Long a: a = WideCharToMultiByte(437, 0, _Offset(buffer), Len(buffer), _Offset(ansibuffer), Len(ansibuffer), 0, 0)
UnicodeToANSI = Mid$(ansibuffer, 1, InStr(ansibuffer, Chr$(0)) - 1)
End Function
Sub UnicodeToANSI (buffer As String, __dest As String)
Dim As String ansibuffer: ansibuffer = Space$(Len(buffer))
Dim As Long a: a = WideCharToMultiByte(437, 0, _Offset(buffer), Len(buffer), _Offset(ansibuffer), Len(ansibuffer), 0, 0)
__dest = Mid$(ansibuffer, 1, InStr(ansibuffer, Chr$(0)) - 1)
End Sub
Function ANSIToUnicode$ (buffer As String)
Dim As String unicodebuffer: unicodebuffer = Space$(Len(buffer) * 2)
Dim As Long a: a = MultiByteToWideChar(65001, 0, _Offset(buffer), Len(buffer), _Offset(unicodebuffer), Len(unicodebuffer))
ANSIToUnicode = unicodebuffer
End Function
Sub ANSIToUnicode (buffer As String, __dest As String)
Dim As String unicodebuffer: unicodebuffer = Space$(Len(buffer) * 2)
Dim As Long a: a = MultiByteToWideChar(65001, 0, _Offset(buffer), Len(buffer), _Offset(unicodebuffer), Len(unicodebuffer))
__dest = unicodebuffer
End Sub
$End Ifptrtostr.BM
ptrtostr.BM (Size: 1.89 KB / Downloads: 4)
Code: (Select All)
$If PTRTOSTR = UNDEFINED Then
$Let PTRTROSTR = DEFINED
Declare Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\strsafe"
End Declare
Function PointerToWideString$ (pointer As _Offset)
$If WCSLEN = UNDEFINED Then
$Let WCSLEN = DEFINED
Declare CustomType Library
Function wcslen%& (ByVal str As _Offset)
End Declare
$End If
Declare CustomType Library
Sub StringCchCopyW (ByVal pszDest As _Offset, Byval cchDest As _Offset, Byval pszSrc As _Offset)
End Declare
Dim As _Offset length: length = wcslen(pointer) * 2 'The length does not account for the 2-byte nature of Unicode so we multiply by 2
Dim As String __dest: __dest = Space$(length)
StringCchCopyW _Offset(__dest), Len(__dest), pointer
PointerToWideString = __dest
End Function
Function PointerToString$ (pointer As _Offset)
$If TCSLEN = UNDEFINED Then
$Let TCSLEN = DEFINED
$If 64BIT Then
Declare CustomType Library ".\internal\c\c_compiler\x86_64-w64-mingw32\include\tchar"
Function tcslen%& Alias "_tcslen" (ByVal str As _Offset)
End Declare
$Else
Declare CustomType Library ".\internal\c\c_compiler\i686-w64-mingw32\include\tchar"
Function tcslen%& Alias "_tcslen" (ByVal str As _Offset)
End Declare
$End If
$End If
Declare CustomType Library
Sub StringCchCopyA (ByVal pszDest As _Offset, Byval cchDest As _Offset, Byval pszSrc As _Offset)
End Declare
Dim As _Offset length: length = tcslen(pointer)
Dim As String __dest: __dest = Space$(length)
StringCchCopyA _Offset(__dest), Len(__dest), pointer
PointerToString = __dest
End Function
$End If
Tread on those who tread on you