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

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

QB64.org Forum

Active Forums => Programs => Topic started by: SpriggsySpriggs on July 31, 2021, 03:46:21 pm