Edited: 6 Jan 2012. Added a unicode capable Browse for Folder dialog class Edited: 15 Jan 2015. Updated UnicodeBrowseFolders class. See post #25 for details. This update is not hot-swappable with the previous version
** Browse for Folder dialog moved to its own thread here.
I have seen recent posts asking how to support selection of unicode filenames with the common dialog. The common dialog control offered by VB does not support unicode, but the APIs do. This class is also ANSI compatible.
The attached class wraps the Open and Save dialog and includes all of the properties offered by VB's Open/Save common dialog, along with a couple more. The additional methods/properties are:
- Clear: resets all properties to default values
- CustomFilterSize: returns/sets size of buffer for user-defined filters
- CustomHookProc: returns/sets the hook procedure for the dialog
- CustomHookData: returns/sets coder-defined value associated with the hook
- FileExtension: returns the extension of a selected file
- FilePath: returns just the path of a selected file
- FlagsEx: returns/sets additional flags for Win2K+
- MaxFileTitleSize: returns/sets buffer size for the FileTitle property
- MinimumBufferSizeRequired: returns required buffer size if multiselecting files and dialog errors with "buffer to small"
I have not included other dialogs (i.e., color, printer, font, etc). Here is another class that you can use to combine codes as needed. That class has all the dialogs but does not support unicode as written. If I knew it was there before I wrote this one, I would have simply modified it instead with the author's permission.
Of course getting a unicode path/file name doesn't do you much good unless you can use it. So I assume anyone that downloads and uses this class can process the file using W-version (unicode) APIs. Trying to use LoadPicture, for example, on a unicode path/file name will generate an error on non-unicode OEM machines, but using the API LoadImageW, passing the StrPtr of the filename, will not.
Using APIs means you have to do most of the work yourself, here is a unicode-capable API-version example of loading a bitmap, gif, jpg, icon, cursor, wmf, emf to a picturebox. Somewhat simple example follows, not 100% fool-proof
Code:
' Add a picturebox and command button to a form; then:
Option Explicit
Private Type PictDesc
Size As Long
Type As Long
hHandle As Long
hPal As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, riid As Any, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long
Private Declare Function LoadImageW Lib "user32.dll" (ByVal hInst As Long, ByVal lpsz As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Const IMAGE_BITMAP As Long = 0
Private Const LR_LOADFROMFILE As Long = &H10
Private Declare Function CreateFileW Lib "kernel32" (ByVal lpFileName As Long, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetFileSize Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpFileSizeHigh As Long) As Long
Private Declare Function ReadFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, ByRef lpNumberOfBytesRead As Long, ByRef lpOverlapped As Any) As Long
Private Const INVALID_HANDLE_VALUE = -1&
Private Sub Command1_Click()
Dim hImage As Long, tmpPic As StdPicture
Dim hHandle As Long, imageData() As Byte, bytesRead As Long
Dim cBrowser As cOpenSaveDialog
Set cBrowser = New cOpenSaveDialog
With cBrowser
.CancelError = True
.Filter = "Bitmaps|*.bmp|JPEGs|*.jpg;*.jpeg|GIFs|*.gif|Meta Files|*.wmf;*.emf|Icons/Cursors|*.ico;*.cur"
.Flags = OFN_FILEMUSTEXIST
.DialogTitle = "Select Image"
End With
On Error GoTo EH
cBrowser.ShowOpen Me.hWnd
On Error GoTo 0
' Note: You don't need to load bitmaps separately as done in this example.
' The LoadImageW call is shown only to let you see that we can pass a unicode filename
' to an API. The API declaration must be tweaked to look for a Long vs String
If cBrowser.FilterIndex = 1 Then ' loaded a .bmp file?
hImage = LoadImageW(0&, StrPtr(cBrowser.FileName), IMAGE_BITMAP, 0&, 0&, LR_LOADFROMFILE)
If hImage Then Set tmpPic = HandleToStdPicture(hImage, vbPicTypeBitmap)
Else ' loaded a gif, jpg or possibly something else?
hHandle = GetFileHandle(cBrowser.FileName)
If hHandle <> INVALID_HANDLE_VALUE Then
If hHandle Then
bytesRead = GetFileSize(hHandle, ByVal 0&)
If bytesRead Then
ReDim imageData(0 To bytesRead - 1)
ReadFile hHandle, imageData(0), bytesRead, bytesRead, ByVal 0&
If bytesRead > UBound(imageData) Then
Set tmpPic = ArrayToPicture(imageData(), 0, bytesRead)
End If
End If
CloseHandle hHandle
End If
End If
End If
If tmpPic Is Nothing Then
MsgBox "Error loading that file", vbOKOnly + vbExclamation
Else
Set Picture1.Picture = tmpPic
End If
EH:
If Err Then
If Err.Number <> CommonDialogErrorsEnum.CDERR_CANCELED Then
MsgBox Err.Description, vbOKOnly, "Error Encountered"
End If
Err.Clear
End If
End Sub
Private Function HandleToStdPicture(ByVal hImage As Long, ByVal imgType As Long) As IPicture
' function creates a stdPicture object from an image handle (bitmap or icon)
Dim lpPictDesc As PictDesc, aGUID(0 To 3) As Long
With lpPictDesc
.Size = Len(lpPictDesc)
.Type = imgType
.hHandle = hImage
.hPal = 0
End With
' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
aGUID(0) = &H7BF80980
aGUID(1) = &H101ABF32
aGUID(2) = &HAA00BB8B
aGUID(3) = &HAB0C3000
' create stdPicture
Call OleCreatePictureIndirect(lpPictDesc, aGUID(0), True, HandleToStdPicture)
End Function
Private Function ArrayToPicture(inArray() As Byte, Offset As Long, Size As Long) As IPicture
' function creates a stdPicture from the passed array
' Note: The array was already validated as not empty when calling class' LoadStream was called
Dim o_hMem As Long
Dim o_lpMem As Long
Dim aGUID(0 To 3) As Long
Dim IIStream As IUnknown
aGUID(0) = &H7BF80980 ' GUID for stdPicture
aGUID(1) = &H101ABF32
aGUID(2) = &HAA00BB8B
aGUID(3) = &HAB0C3000
o_hMem = GlobalAlloc(&H2&, Size)
If Not o_hMem = 0& Then
o_lpMem = GlobalLock(o_hMem)
If Not o_lpMem = 0& Then
CopyMemory ByVal o_lpMem, inArray(Offset), Size
Call GlobalUnlock(o_hMem)
If CreateStreamOnHGlobal(o_hMem, 1&, IIStream) = 0& Then
Call OleLoadPicture(ByVal ObjPtr(IIStream), 0&, 0&, aGUID(0), ArrayToPicture)
End If
End If
End If
End Function
Private Function GetFileHandle(ByVal FileName As String) As Long
' Function uses APIs to read/create files with unicode support
Const GENERIC_READ As Long = &H80000000
Const OPEN_EXISTING = &H3
Const FILE_SHARE_READ = &H1
Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20
Const FILE_ATTRIBUTE_HIDDEN As Long = &H2
Const FILE_ATTRIBUTE_READONLY As Long = &H1
Const FILE_ATTRIBUTE_SYSTEM As Long = &H4
Const FILE_ATTRIBUTE_NORMAL = &H80&
Dim Flags As Long, Access As Long
Dim Disposition As Long, Share As Long
Access = GENERIC_READ
Share = FILE_SHARE_READ
Disposition = OPEN_EXISTING
Flags = FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_NORMAL _
Or FILE_ATTRIBUTE_READONLY Or FILE_ATTRIBUTE_SYSTEM
GetFileHandle = CreateFileW(StrPtr(FileName), Access, Share, ByVal 0&, Disposition, Flags, 0&)
End Function
Private Sub Form_Load()
Picture1.AutoSize = True
End Sub
Since this is a class and errors are raised if the CancelError property is set to true, VB may stop in the class when the error is raised. If VB does stop, it is due to your VB settings. If you have error trapping option to "Break in Class Modules", change it to "Break on Unhandled Errors". That error is required in order to mimic common dialog's CancelError property. The VB stopping applies only to IDE not if project is compiled.
Last edited by LaVolpe; Jan 24th, 2018 at 07:45 PM.
Reason: updated unicode capable Browse for Folder dialog class
Insomnia is just a byproduct of, "It can't be done"
You're welcome. I should have mentioned that the class is also ANSI compatible.
However, the sample unicode routine I posted above is not ANSI compatible.
I think the class code is well commented and easy to follow. Any minor bug reports, feel free to mention them.
Insomnia is just a byproduct of, "It can't be done"
Minor logic error.
In the FileName Property Let routine, change
Code:
from:
If fTitle = vbNullString Then
Mid$(ofn.lpstrFile, 1, 1) = vbNullChar
Else
Mid$(ofn.lpstrFile, 1, Len(fTitle)) = fTitle
End If
to:
If fTitle = vbNullString Then
Mid$(ofn.lpstrFile, 1, 1) = vbNullChar
ElseIf ofn.nMaxFile = Len(fTitle) Then
ofn.lpstrFile = fTitle
Else
Mid$(ofn.lpstrFile, 1, Len(fTitle) + 1) = fTitle & vbNullChar
End If
Without change it is possible that running class multiple times, you could get the new file name you are supplying suffixed with the currently existing filename. The null character appended after the supplied value will prevent that.
Same applies to the FileTitle property, change appropriately.
Insomnia is just a byproduct of, "It can't be done"
Note: you will not get a nice looking dialog box if you use OFN_ENABLEHOOK flag under Vista or Win7.
That is very true. Vista+ uses a new interface and will only apply the Vista+ look if the dialog is not subclassed/hooked. The other solution is to stop using the common dialog and use the new interface, which I think would require a TLB to use it in VB.
Edited: I have an update to post to this and completely forgot. Thanx for bringing this post back to my attention.
Last edited by LaVolpe; Jan 22nd, 2010 at 12:57 PM.
Insomnia is just a byproduct of, "It can't be done"
LaVolpe, Each time i ask a question, i discover you already worked On that lol ,
thanks for the information, i will check what you said once am home and i will let you know if i could make it works.
In general should i make a kind of mix between your code to get the file name with Unicode and Jonney's code to rename a file UNICODE ?
Still also need to know please ow can i also Read/Write into a file using unicode ?
So that if a user entered in the textbox an arabic (or other Unicode langage), i can save it into a file ?
The class I provided in this thread returns a string containing the file name. That string may or may not contain unicode characters. However that string can be used with APIs that read/write files. In my signature, you'll see the XP/Vista Manifest Creator. In that project is a short example on reading/writing files using APIs. In the sample code in post #1 above is an example of reading an array using APIs.
Bottom line, if you are going to use APIs, the routine is basically this:
1. Use CreateFile API (A or W version) to create a file handle for a new file or existing file
-- If using W version, pass filename with StrPtr, else just pass the string
2. Use ReadFile & WriteFile APIs to read/write files
3. Use SetFilePointer to move within the file if needed
4. Use other APIs to get file details: GetFileSize, Get/SetFileAttributes and others as needed
5. Always close an opened file with CloseHandle API
Once you start playing with the APIs, you'll quickly appreciate how easy VB made it for us and wish VB just had the foresight to handle unicode files too.
Please post follow-up questions regarding this topic to the VB6 forum. If you have questions about the open/save dialog class, post it here. Thanx.
Insomnia is just a byproduct of, "It can't be done"
Good code, and it is so nice of La Volpe to help people here.
I became involved in Unicode because very occasionally a Chinese friend would send me a DVD containing photos under various folder names. To view those photos I cannot use my own paint program, nor a third party program such as PhotoShop (v 7.0.0), as folder names are in Chinese, which hinders the access of the files. So I had to make a simple program in order to Open the files and/or to browser them one by one through Next/Previous buttons. Since some photos were vertically taken, I had to provide "turn left" and "turn right" buttons as well. To gain an acceptable speed for the said rotation operations, I used DIB to contain the source image, before projecting it to a full-screen-sized PictureBox (keeping aspect ratio). It is through this kind of exercise that I've acquired some Unicode knowledge.
A few notes of observation:
(a) I normally have the returned type as IPicture or StdPicture interchangeably. However, in the case of OleLoadPicture, I must use IPicture, otherwise GetObjectType would err.
(b) I use both Open and CreateFile depending on circumstances. The file pointer in the case of Open is 1-based, but 0-based if CreateFile.
(c) I don't favor the idea of setting to "Break On Unhandled Errors". I detect whether user had clicked Cancel, and whether any error had occurred, in the following manner:
vb Code:
Function ShowOpenW(Optional Owner As Long = 0&, Optional inFilter As String = "All (*.*)| *.*") As String
........
........
mFileSpec = ""
m_FileExtIndexOnOpen = -1
If mResult = 1 Then
If typOpenFile.nFileOffset Then
i = InStr(typOpenFile.nFileOffset, typOpenFile.lpstrFile, vbNullChar) - 1&
If i = 0 Then
i = Len(typOpenFile.lpstrFile)
End If
Else
i = Len(typOpenFile.lpstrFile))
End If
'Fill in mFileSpec
If i > 0 Then
mFileSpec = Left$(typOpenFile.lpstrFile, i)
' Note down for possible use of calling program, e.g. to set file pattern
' "*.*" when a certain nFilterIndex has been selected.
m_FileExtIndexOnOpen = typOpenFile.nFilterIndex
End If
Else
If mResult <> 0 Then ' 0 is Cancel, else extended error
m_lExtendedError = CommDlgExtendedError()
End If
End If
' Return file spec
ShowOpenW = mFileSpec
End Function
Remarks: If ShowOpenW returns "", then it is assumed user must have Cancelled. If one wants to ensure, then just add something like this:
vb Code:
If returnedFileSpec = "" then
If cUniDialog.ExtendedErrorNum <> 0 then
'Flag what is the error description
cUniDialog.FlagErrMsg cUniDialog.ExtendedErrorNum
End If
End if
This way, no run-time error would ever occur in IDE.
petersen, thanks for this reply, but can you explain what does your code ?
I am a bit lost, as i understood above that i can't use the UNICODE except with special controls and that normal textbox and listbox won't show the names of the arabic and chinese files ... you said that you used to work with UNICODE, any way or suggestion to help me to show a dialog box that can select any file name (including chinese and arabic), and to show in a listbox And textbox the name of the selected file and to allow me to rename this file or copy it using the Name AS function for expl ?
justgreat, please PM Petersen or post questions on his linked thread. I would appreciate not using my thread to discuss stuff not related to what I posted. Thank you
Insomnia is just a byproduct of, "It can't be done"
For clarity purposes, I jot down the following points:
(1) Since this thread is on "Unicode File Open/Save Dialog", we take the VB-supplied Common Dialog Control for example. For certain reasons you cannot use it to "Open" a file which file specification has some Chinese characters in it (here Chinese characters are just as an example). Therefore, La Volpe posts his "class", to be used to invoke an Open dialog which is capable of showing the said file and enabling access to it.
(2) I bumped into the above said "class", hence entered into the forum to share a few points of my observation on the related issues.
(3) I briefly explained how I had become involved in Unicode stuff. As you can see, my knowledge in Unicode is only skin deep. As the problem mentioned in "1" also exists in the VB-supplied TextBox control, i.e. incapable of accepting / displaying Chinese characters, and it happends I have a Unicode TextBox User Control in hand, so I made a mention of it and posted it in the hope that it might be of use to some readers.
(4) The subject of Unicode and associated issues are rather wide and complicated, for an adequate explanation, perhaps you should visit:
(5) Apart from the "class" mentioned in "1" above, La Volpe also posts the source code to demonstrate how to render the image of a BMP and JPG etc file. So all you have to do is download the "class", copy and paste the source code for the Form (shown in Forum panel), read the comments of La Volpe's, and run the code.
(6) In IDE, if you click Cancel button in the Open dialog, a runtime error might occur. Don't worry about it, just re-run the program.
I have one question. How can I change the button "Open", "Cancel" or Title to Unicode.
The class has a DialogTitle property that you can change. Simply give the property your unicode title
As for the button captions, you can find examples of subclassing/hooking the dialog window on the net. There are even examples on how to add your own buttons, like a preview button. Search for keywords: OPENFILENAME hook
But note that in Vista & above, setting the HookProc of the class will cause the dialog to loose any theming. For XP and below, this is not the case.
Insomnia is just a byproduct of, "It can't be done"
Added example, in post #1 above, of using the folder browser to set the initial display/selected path
You could add some more codes in demo:
cBrowser.DialogTitle = ChrW$(&H6B22) & ChrW$(&H8FCE) & " to choose a folder ..."
If we set some flags to show TextBox (e.g. Folder) or Buttons (e.g. Make new Folder), the focus in Folder Treeview will lost. Any way to be initially focused on treeview items and .EnsureVisible at Dialog showing up?
cBrowser.flags = BIF_DONTGOBELOWDOMAIN + BIF_USENEWUI + BIF_NEWDIALOGSTYLE
One thing first. You should not ADD flag values together; they should be OR'd together. The following results in 2 different values:
Code:
MsgBox BIF_DONTGOBELOWDOMAIN Or BIF_USENEWUI Or BIF_NEWDIALOGSTYLE & vbCrLf & _
BIF_DONTGOBELOWDOMAIN + BIF_USENEWUI + BIF_NEWDIALOGSTYLE
From experience, I've found that most things you want to do with the browser window should be done via subclassing. The browser callback messages are very few and most occur before the window is even displayed. A workaround to your scenario is shown below.
1. Add these declarations to your module, as needed, to allow subclassing
Code:
Private Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" (ByVal hWndParent As Long, ByVal hWndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetFocusAPI Lib "user32.dll" Alias "SetFocus" (ByVal hWnd As Long) As Long
Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_SHOWWINDOW As Long = &H18
Private Const GWL_WNDPROC As Long = -4
Private m_WndProc As Long
2. Add a subclass procedure to your module
Code:
Private Function BrowserWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If m_WndProc = 0& Then
BrowserWndProc = DefWindowProc(hWnd, uMsg, wParam, lParam)
Else
BrowserWndProc = CallWindowProc(m_WndProc, hWnd, uMsg, wParam, lParam)
If uMsg = WM_SHOWWINDOW Then
Dim cWnd As Long, pWnd As Long
SetWindowLong hWnd, GWL_WNDPROC, m_WndProc
m_WndProc = 0&
Do ' find the treeview
pWnd = FindWindowEx(hWnd, pWnd, vbNullString, vbNullString)
Debug.Print "checking child window: " & Hex(pWnd)
If pWnd = 0& Then Exit Do
cWnd = FindWindowEx(pWnd, 0&, "SysTreeView32", vbNullString)
If cWnd Then
Debug.Print "treeview found as: " & Hex(cWnd)
SetFocusAPI cWnd
Exit Do
End If
Loop
Debug.Print "unsubclassed"
End If
End If
End Function
3. Modify the BrowseCallbackProc function to start subclassing during initialization, i.e.,
Code:
Case BFFM_INITIALIZED
If m_WndProc = 0& Then
Call SendMessage(hWnd, BFFM_SETSELECTION, 0&, ByVal lParam)
m_WndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf BrowserWndProc)
End If
Edited: Note that the assumption is the treeview will be a grandchild of the main dialog. I would think a more robust/recursive search should be created should previous/future versions of Windows place the treeview higher/deeper in the hierarchy.
Last edited by LaVolpe; Apr 9th, 2012 at 09:44 AM.
Insomnia is just a byproduct of, "It can't be done"
Edited: Note that the assumption is the treeview will be a grandchild of the main dialog. I would think a more robust/recursive search should be created should previous/future versions of Windows place the treeview higher/deeper in the hierarchy.
Suclassing is a good way to set the focus. But .EnsureVisible is bit of complicated.
Call SendMessageLong(m_hTreeView, TVM_ENSUREVISIBLE, 0&, hNode),but how to obtain the hNode (I forgot treeview knowledge)?
Never mind, just curious, I seldom used this feature.
The main point of this thread can be important because in VB6 we don't otherwise have a Unicode Open/Save dialog.
But a folder browsing dialog doesn't need this pile of code since the Shell COM object exposed by Shell32.dll already has the simple BrowseForFolder method available.
Code:
Option Explicit
'
'Late-Binds Microsoft Shell Controls and Automation because Microsoft
'did not maintain binary compatibility in all versions and service
'packs of Windows after XP.
'
'Uses RTBEx.bas for some Unicode operations on RichTextBox controls.
'
Private Enum BIF_OPTIONS_ENUM
'Some options require later shell32.dll versions than 4.71
BIF_RETURNONLYFSDIRS = &H1&
BIF_DONTGOBELOWDOMAIN = &H2&
BIF_RETURNFSANCESTORS = &H8&
BIF_EDITBOX = &H10&
BIF_VALIDATE = &H11&
BIF_NEWDIALOGSTYLE = &H40&
BIF_BROWSEINCLUDEURLS = &H80&
BIF_USENEWUI = BIF_EDITBOX Or BIF_NEWDIALOGSTYLE
BIF_UAHINT = &H100&
BIF_NONEWFOLDERBUTTON = &H200&
BIF_NOTRANSLATETARGETS = &H400&
BIF_BROWSEFORCOMPUTER = &H1000&
BIF_BROWSEFORPRINTER = &H2000&
BIF_BROWSEINCLUDEFILES = &H4000&
BIF_SHAREABLE = &H8000&
End Enum
Private Sub Command1_Click()
Dim Folder2 As Object
With CreateObject("Shell.Application")
Set Folder2 = .BrowseForFolder(hWnd, _
"Choose a folder:", _
BIF_USENEWUI _
Or BIF_SHAREABLE _
Or BIF_DONTGOBELOWDOMAIN _
Or BIF_RETURNONLYFSDIRS, _
RTBReadUnicode(RTB1))
End With
If Not (Folder2 Is Nothing) Then
RTBWriteUnicode RTB2, Folder2.Self.Path
End If
End Sub
Note that no special Unicode handling is required since Unicode is natively supported. The only bow to Unicode here is for entry of the RootFolder and displaying the Path of the resulting Folder2 object.
In many cases the Folder/Folder2 result can be directly used (via .CopyHere, .MoveHere, etc.) making this especially convenient for folder operations.
Though the shell's BrowseForFolder method is nice and clean, requires little knowledge to use, it does have limitations by not exposing a callback for those that want that option. My class may have a few limitations too, but they should be able to be resolved via additional code as needed.
In your example, the path you pass as the final parameter is not the same as setting the desired initial directory to be displayed. That final parameter defines the root of the browser; thereby, restricting selection of anything above that folder in the directory structure. This option is included with that class: SetRootFolder
Not saying my class is better or worse. Different scenarios will dictate usage of either. Good to know of a more generic, suitable substitute. Thanx
Edited: I think a separate thread on many of the shell methods, a coder would use in common projects, could be a really good thing.
P.S. Maybe I did something wrong with the shell version, I get errors whenever I try to use BIF_BROWSEINCLUDEFILES. The dialog displays as intended, but errors if a file is selected (IShellDispatch4 failed).
Code:
With CreateObject("Shell.Application")
Call .BrowseForFolder(hWnd, _
"Choose a folder:", _
BIF_USENEWUI _
Or BIF_SHAREABLE _
Or BIF_DONTGOBELOWDOMAIN _
Or BIF_BROWSEINCLUDEFILES)
End With
Last edited by LaVolpe; Apr 9th, 2012 at 01:25 PM.
Insomnia is just a byproduct of, "It can't be done"
That's how you maybe add Support for Multi File Selection
That's how the 'client part' may look like
vb Code:
Public Sub Form_Load()
With New cOpenSaveDialog
.Flags = OFN_ALLOWMULTISELECT ' + OFN_EXPLORER
.DialogTitle = "Select one (or more) files"
.Filter = "All Files|*.*|" & _
"Sibelius scorch Files|*.sco"
If .ShowOpen(hWnd) Then
Dim item
For Each item In .FileNames
AddFile item
Next
Timer_TriggerLoad_OLEDrag.Enabled = True
End If
End With
End Sub
Public Sub AddFile(FileName$)
cb_ScoFiles.AddItem FileName
cb_ScoFiles.ListIndex = cb_ScoFiles.ListCount - 1
End Sub
Note: To get that sample fully working.
Add a new Form and place there a comboBox and name [it B]cb_ScoFiles[/B].
Na who cares - for sure ya've your own code. Just read over it to grab some Inspirations
So that's how the 'server part' will look like:
Code:
' returns the filenames the dialog starts with or returns
Public Property Get FileNames()
'OFN_ALLOWMULTISELECT _
without OFN_EXPLORER
If ( _
(ofn.Flags And OFN_ALLOWMULTISELECT) And _
((ofn.Flags And OFN_EXPLORER) = False) _
) Then
Dim splitchar$
splitchar = " "
Dim FilenameRaw$
FilenameRaw = FileName()
Else
splitchar = vbNullChar
FilenameRaw = ofn.lpstrFile
End If
' Split FileNames
Dim pFileNames
pFileNames = Split(FilenameRaw, splitchar)
Dim item, i&: i = 0
For Each item In pFileNames
' Cut Array at first empty FileName
If item = "" Then
Exit For
End If
' First is the FilePath (without Filename attached)
If i = 0 Then
Dim pathName$
pathName = pFileNames(0)
Else
' Make full path ( ... and store it in previous array element)
pFileNames(i - 1) = pathName & "\" & pFileNames(i)
End If
i = i + 1
Next
' Rewind/cut empty element
i = i - 1
' Rewind/cut last element
' ... but only if there are more than one File
' since if FilesCount=1 => first element is already fullpath
If i >= 1 Then i = i - 1
ReDim Preserve pFileNames(i)
FileNames = pFileNames
End Property
(I left out vb-highlight here for easier Copy&Paste. So these LineNumber will not come into ya way. )
so add this Property GetFileNames() to cOpenSaveDialog.cls
or
Download the attached cOpenSaveDialog.cls cOpenSaveDialog.cls
1. Added a self-contained callback function that uses JIT (just-in-time) thunk creation in order to callback to a class procedure so the class doesn't need to have an additional bas module.
- This callback is automatically invoked if you set the InitialDirectory or InitialDirectoryPIDL properties. CustomHookProc must not be set to use this default callback. You will not get any events from this callback procedure.
- This option is ignored if you set the CustomHookProc property to use your own hooks
- The CustomHookData() property is ignored if CustomHookProc is not set
2. Added 2 properties to set the startup/initial folder by either string path or PIDL (needed for virtual folders like Control Panel)
- InitialDirectory property sets the startup as a string path
- InitialDirectoryPIDL property sets the startup as a PIDL, which you are required to destroy
- Setting either of those overwrites the other
3. Added option to set the Root folder as either a string path or PIDL
- SetRootFolder requires a string path (no change)
- SetRootFolderPIDL (added) requires a PIDL, which you are required to destroy
- Setting either of those overwrites the other
4. As with the previous version, the main function ShowBrowseFolder has a parameter to prevent the class from destroying the PIDL returned by the API used to display the dialog. However, you may not know in advance whether or not you want to destroy it, but also don't want to be forced to destroy it after each call. So, modified the logic a bit.
a) If ShowBrowseFolder's optional parameter ReleasePIDL is set to False, then existing logic remains. The class will never destroy the PIDL. You are required to and the PIDL can be retrieved from the new SelectedPIDL() property. Can be destroyed with DestroyPIDL()
b) If ShowBrowseFolder's optional parameter ReleasePIDL is set to True, then existing logic was modified and works this way. The PIDL will be destroyed whenever ShowBrowseFolder is called again. However, if you decide you want the PIDL (possibly to be used for InitialDirectoryPIDL or SetRootFolderPIDL), then you can take ownership of the PIDL and the class will not destroy it. To take ownership, call SelectedPIDL(True). If the optional parameter of that property is set to True, then the class will never destroy the PIDL, but you must, at some point.
Note: SetRootFolderPIDL & InitialDirectoryPIDL will not allow you to use the PIDL returned from the previous call to ShowBrowseFolder unless you took ownership of it.
5. Some properties had their names changed to be more intuitive:
- SelectedItem changed to SelectedFolder
- PIDL_ReturnValue changed to SelectedPIDL
Last edited by LaVolpe; Jan 11th, 2015 at 03:20 PM.
Insomnia is just a byproduct of, "It can't be done"
1. Added a self-contained callback function that uses JIT (just-in-time) thunk creation in order to callback to a class procedure so the class doesn't need to have an additional bas module.
- This callback is automatically invoked if you set the InitialDirectory or InitialDirectoryPIDL properties. CustomHookProc must not be set to use this default callback. You will not get any events from this callback procedure.
- This option is ignored if you set the CustomHookProc property to use your own hooks
- The CustomHookData() property is ignored if CustomHookProc is not set
2. Added 2 properties to set the startup/initial folder by either string path or PIDL (needed for virtual folders like Control Panel)
- InitialDirectory property sets the startup as a string path
- InitialDirectoryPIDL property sets the startup as a PIDL, which you are required to destroy
- Setting either of those overwrites the other
3. Added option to set the Root folder as either a string path or PIDL
- SetRootFolder requires a string path (no change)
- SetRootFolderPIDL (added) requires a PIDL, which you are required to destroy
- Setting either of those overwrites the other
4. As with the previous version, the main function ShowBrowseFolder has a parameter to prevent the class from destroying the PIDL returned by the API used to display the dialog. However, you may not know in advance whether or not you want to destroy it, but also don't want to be forced to destroy it after each call. So, modified the logic a bit.
a) If ShowBrowseFolder's optional parameter ReleasePIDL is set to False, then existing logic remains. The class will never destroy the PIDL. You are required to and the PIDL can be retrieved from the new SelectedPIDL() property. Can be destroyed with DestroyPIDL()
b) If ShowBrowseFolder's optional parameter ReleasePIDL is set to True, then existing logic was modified and works this way. The PIDL will be destroyed whenever ShowBrowseFolder is called again. However, if you decide you want the PIDL (possibly to be used for InitialDirectoryPIDL or SetRootFolderPIDL), then you can take ownership of the PIDL and the class will not destroy it. To take ownership, call SelectedPIDL(True). If the optional parameter of that property is set to True, then the class will never destroy the PIDL, but you must, at some point.
Note: SetRootFolderPIDL & InitialDirectoryPIDL will not allow you to use the PIDL returned from the previous call to ShowBrowseFolder unless you took ownership of it.
5. Some properties had their names changed to be more intuitive:
- SelectedItem changed to SelectedFolder
- PIDL_ReturnValue changed to SelectedPIDL
The best helper on this forum is back ??? where have you been man ? I asked many admins about you, no one knew where have you been hiding for years...hope you were fine during all this time
The best helper on this forum is back ??? where have you been man ? I asked many admins about you, no one knew where have you been hiding for years...hope you were fine during all this time
Took nearly a year off. Back for awhile at least until I rewrite my alpha image control. Not a high priority, but every time I get started, I get distracted with something else.
P.S. Regarding this project. Nearly done with the Vista+ revision which will use the new interfaces and remain class-contained, drop & go, code. No outside dependencies such as TLBs. Still need to finalize dynamic creation of the IFileDialogEvents interface so people can 'subclass' the dialog if they choose. Once I'm satisfied with that, I'll post the project. Afterwards, the next logical step would be to implement the IFileDialogCustomize interface to allow users to customize the dialog, i.e., adding controls to it.
Insomnia is just a byproduct of, "It can't be done"
Thank you very much LaVolpe for yor research and your work on the dialog modules.
Can anyone answer me a quick question:
In cOpenSaveFileDialog the MAX PATH constant currently has a value 260. How big can be this value?
Small Note: I have a folder with about 150 files with very long names, so when I multiselect let's say the 140 of them I always get an error (FNERR_BUFFERTOOSMALL) and the only way I found to go around this problem and to have succes was to raise the MAX PATH value.
By default the class uses the System constant MAX_PATH *2 (520 characters) set during the InitStructure method. When that error occurs, you can call the class' MinimumBufferSizeRequired property to return what size is needed for the selection, but this is reactive not proactive. In other words, you still have to show the dialog again because it was closed and generated the error on closing.
You can set the MaxFileSize property to a huge value if you choose, before showing the dialog. The size of the buffer is limited by the system. Obviously I wouldn't suggest setting it in the GB range.
FYI: A more complex, and more proper, method of dealing with this is by hooking/subclassing the common dialog. The hook would be retrieving messages sent from the dialog. One of those messages is a 'selection' message. Knowing what is selected, you can get its length and test total accumulation against the size of the buffer, increasing the buffer if needed. However, for most, this option is too complex. Here is a MSDN article on that topic
Edited: If you are never going to use XP or lower, you can use the new Vista-style implementation. A learning curve, not that bad, is needed. A project showing that implementation can be found here
Last edited by LaVolpe; Dec 1st, 2015 at 03:58 PM.
Insomnia is just a byproduct of, "It can't be done"
Many many thanks for the quick reply LaVolpe.
I agree that the subclassing method is too complex for me.
I will study it but I guess I will use the huge value option for the moment.
Thanks as well for the Vista+ implementation. I will check it out.
Executing .exe in VB 6.0 with input and output files
Iam new to VB6. Please help me out.
I have to run one program.exe file(fortran program) using VB. this program requires inputs stored in in.txt file and the output of the program need to be stored in out1.txt and out2.txt.
I used shell command to run program.exe file but it is not taking inputs from file and not giving outputs.
Hi Keith. I have found that the control does not respond to header clicks live. However if you click the header you want and then close the Dialog, when next opened it is selected and active on the chosen header.
Here is my calling code:
Code:
Private Sub Form_Load()
Dim OC As New cOpenSaveDialog
OC.MaxFileSize = 10000
OC.Flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER
OC.ShowOpen Me.hWnd
Dim Item
For Each Item In OC.FileNames
List1.AddItem Item
Next
End Sub
Hi Keith. Yes I am using my version of the code in #24. Obviously that would have no bearing on the displayed data until after one pushed Open.
It's almost midnight here and I was going to turn in when I thought of the time difference and how quickly you usually reply. So I've turned my PC back on and header clicks are now working fine!!
Perhaps I tripped something earlier that caused the problem. In full detail you could click the header, see the highlight change to the selected header, but nothing would happen. File selection appeared to be quite normal.
Can someone post a File with a Unicode filename for testing please. Doesn't matter what it is.
Steve, just do a google for something, like "dispcallfunc", jump to any page that shows unicode text in the descriptions, copy some of it, & paste/append to a file and/or folder name.
Insomnia is just a byproduct of, "It can't be done"