Author Topic: Open, Save, and Folder dialogs (ANSI and Unicode, 32 and 64 bit) (Read 3088 times)

SpriggsySpriggs · « **on:** July 31, 2021, 03:46:21 pm »

I've made a demo program here for 32 and 64 bit Open and Save dialogs for ANSI and Unicode. The Unicode usage will not return characters beyond the ASCII range because this code converts it to an ANSI string first. The Open and Save dialogs can be performed with the ComDlgFileName function. If you specify the SAVE_DIALOG flag then it will show a save dialog. The OPEN_DIALOG flag is not necessary to show an open dialog as it is the default for the wrapper function.

Code: QB64: [Select]

Option _Explicit
 
'$Let UNICODE = TRUE
$If UNICODE = DEFINED Then
    Const MAX_PATH = 65534 'Since the MAX_PATH for unicode is 32767 and it is a wide string, two bytes are needed per character. So, double the length
    Const MODE = "Unicode"
$Else
    Const MAX_PATH = 260
    Const MODE = "ANSI"
$End If
$Console:Only
 
$ExeIcon:'.\internal\source\qb64.ico'
_Icon
 
_ConsoleTitle "Comdlg32 Open/Save Dialog (32/64) Test - " + MODE
 
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
 
 
Dim As String file
file = ComDlgFileName("Open Source File", _CWD$, "QB64 Files (*.BAS, *.BI, *.BM, *.FRM)|*.BAS;*.BI;*.BM;*.FRM|C/C++ Files (*.CPP, *.HPP, *.H, *.C)|*.CPP;*.HPP;*.H;*.C|All Files|*.*", OFN_FORCESHOWHIDDEN)
If file <> "" Then
    Print file
    Open file For Binary Access Read As #1
    Dim As String content: content = Space$(LOF(1))
    Get #1, , content
    Close
    Print content
    Dim As String filename: filename = Mid$(file, _InStrRev(file, "\") + 1)
    _ConsoleTitle "Viewing - " + filename
End If
 
'Print SelectFolder("Pick a folder")
 
Function ComDlgFileName$ (Title As String, InitialDir As String, Filter As String, Flags As _Unsigned Long)
    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
 
    Declare Dynamic Library "Comdlg32"
        $If UNICODE = DEFINED Then
        Sub GetSaveFileName Alias "GetSaveFileNameW" (ByVal ofn As _Offset)
        Function GetOpenFileName& Alias "GetOpenFileNameW" (ByVal ofn As _Offset)
        $Else
            Sub GetSaveFileName Alias "GetSaveFileNameA" (ByVal ofn As _Offset)
            Function GetOpenFileName& Alias "GetOpenFileNameA" (ByVal ofn As _Offset)
        $End If
    End Declare
 
    $If UNICODE = DEFINED Then
        Declare CustomType Library
        Function wcslen%& (ByVal str As _Offset)
        End Declare
    $Else
        $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
 
    Dim As OPENFILENAME ofn
    Do
        Mid$(Filter, InStr(Filter, "|")) = Chr$(0)
    Loop While InStr(Filter, "|")
 
    $If UNICODE = DEFINED Then
        Title = ANSIToUnicode(Title + Chr$(0))
        InitialDir = ANSIToUnicode(InitialDir + Chr$(0))
        Filter = ANSIToUnicode(Filter + Chr$(0) + Chr$(0))
    $Else
        Title = Title + Chr$(0)
        InitialDir = InitialDir + Chr$(0)
        Filter = Filter + Chr$(0) + Chr$(0)
    $End If
    Dim As String * MAX_PATH oFile
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = _WindowHandle
    ofn.lpstrFilter = _Offset(Filter)
    ofn.nFilterIndex = 1
    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
        ofn.Flags = Flags
        If GetOpenFileName(_Offset(ofn)) <> 0 Then
            If OFN_ALLOWMULTISELECT And Flags Then
                Dim As String file, outfiles, directory
                $If UNICODE = DEFINED Then
                    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)
                $Else
                    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))
                $End If
                _MemGet dir, dir.OFFSET, directory
                _MemFree dir
                Dim As Long i
                $If UNICODE = DEFINED Then
                    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
                $Else
                    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
                $End If
                _MemFree pFiles
                If i = 1 Then
                    $If UNICODE = DEFINED Then
                        file = wCharPtrToString(_Offset(directory))
                    $Else
                        file = directory
                    $End If
                    ComDlgFileName = file
                Else
                    $If UNICODE = DEFINED Then
                        outfiles = wCharPtrToString(_Offset(outfiles))
                    $End If
                    ComDlgFileName = outfiles
                End If
            Else
                $If UNICODE = DEFINED Then
                    Dim As String selectedfile: selectedfile = wCharPtrToString(_Offset(oFile))
                    ComDlgFileName = selectedfile
                $Else
                    ComDlgFileName = Mid$(oFile, 1, InStr(oFile, Chr$(0)) - 1)
                $End If
            End If
        End If
    ElseIf SAVE_DIALOG And Flags Then
        ofn.Flags = Flags
        GetSaveFileName _Offset(ofn)
        $If UNICODE = DEFINED Then
            selectedfile = wCharPtrToString(_Offset(oFile))
            ComDlgFileName = selectedfile
        $Else
            ComDlgFileName = Mid$(oFile, 1, InStr(oFile, Chr$(0)) - 1)
        $End If
    End If
End Function
 
Function SelectFolder$ (title As String)
    Type BROWSEINFO
        As _Offset hwndOwner, pidlRoot, pszDisplayName, lpszTitle
        As _Unsigned Long ulFlags
        As _Offset lpfn, lParam
        As Long iImage
    End Type
    Declare Dynamic Library "Shell32"
        $If UNICODE = DEFINED Then
        Function SHBrowseForFolder%& Alias "SHBrowseForFolderW" (ByVal lpbi As _Offset)
        Function SHGetPathFromIDList%% Alias "SHGetPathFromIDListW" (ByVal lpItem As _Offset, Byval szDir As _Offset)
        $Else
            Function SHBrowseForFolder%& (ByVal lpbi As _Offset)
            Function SHGetPathFromIDList%% (ByVal lpItem As _Offset, Byval szDir As _Offset)
        $End If
    End Declare
    Dim As BROWSEINFO browse
    Dim As String * MAX_PATH folder
    $If UNICODE = DEFINED Then
        title = ANSIToUnicode(title + Chr$(0))
    $Else
        title = title + Chr$(0)
    $End If
    browse.hwndOwner = _WindowHandle
    browse.pszDisplayName = _Offset(folder)
    browse.lpszTitle = _Offset(title)
    Dim As _Offset pfolder
    pfolder = SHBrowseForFolder(_Offset(browse))
    If pfolder Then
        Dim As String * MAX_PATH resolvedPath
        If SHGetPathFromIDList(pfolder, _Offset(resolvedPath)) Then
            $If UNICODE = DEFINED Then
                SelectFolder = wCharPtrToString(_Offset(resolvedPath))
            $Else
                SelectFolder = Mid$(resolvedPath, 1, InStr(resolvedPath, Chr$(0)) - 1)
            $End If
        End If
    End If
End Function
 
$If UNICODE = DEFINED Then
    Function wCharPtrToString$ (wchar As _Offset)
    Dim As _Offset wlen: wlen = wcslen(wchar) * 2 'The length does not account for the 2-byte nature of Unicode so we multiply by 2
    Dim As _MEM pChar: pChar = _Mem(wchar, wlen) 'Declaring a new _MEM block and setting it to grab the number of bytes referenced by wlen at pointer wchar
    Dim As String char: char = Space$(wlen) 'Declaring a new string large enough to hold the unicode string
    _MemGet pChar, pChar.OFFSET, char 'Storing the data in the string
    _MemFree pChar 'Freeing the _MEM block
    wCharPtrToString = UnicodeToANSI(char) 'Returning the converted Unicode string
    End Function
 
    '$INCLUDE:'unicodetoansi.bas'
$End If

loudar · « **Reply #1 on:** August 02, 2021, 12:24:25 pm »

Works super well in the image editor! Great work again.

News:

Author Topic: Open, Save, and Folder dialogs (ANSI and Unicode, 32 and 64 bit) (Read 3088 times)

SpriggsySpriggs

Open, Save, and Folder dialogs (ANSI and Unicode, 32 and 64 bit)

loudar

Re: Open, Save, and Folder dialogs (ANSI and Unicode, 32 and 64 bit)