pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
''''/结构说明: _
hOwner 调用这个对话框的窗口的句柄 _
pidlRoot 指向你希望浏览的最上面的文件夹的符列表 _
pszDisplayName 用于保存用户所选择的文件夹的显示名的缓冲区 _
lpszTitle 浏览对话框的标题 _
ulFlags 决定浏览什么的标志(见下) _
lpfn 当事件发生时对话框调用的回调函数的地址.可将它设定为NULL _
lparam 若定义了回调函数,则为传递给回调函数的值 _
iImage As Long 保存所选文件夹映像索引的缓冲区 _
ulFlags参数(见下:)
Private Const BIF_RETURNONLYFSDIRS = &H1 ''''仅允许浏览文件系统文件夹
Private Const BIF_DONTGOBELOWDOMAIN = &H2 ''''利用这个值强制用户仪在网上邻居的域级别
中
Private Const BIF_STATUSTEXT = &H4 ''''在选择对话中显示状态栏
Private Const BIF_RETURNFSANCESTORS = &H8 ''''返回文件系统祖先
Private Const BIF_BROWSEFORCOMPUTER = &H1000 ''''允许浏览计算机
Private Const BIF_BROWSEFORPRINTER = &H2000 ''''允许游览打印机文件夹
''''/--------------------------------------------------------------------------------
Dim FontInfo As SmFontAttr ''''字体
''''/--------------------------------------------------------------------------------
Private Function GetFolderValue(wIdx As Integer) As Long
If wIdx < 2 Then
GetFolderValue = 0
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
Else
GetFolderValue = wIdx + 4
End If
End Function
''''
Private Function GetReturnType() As Long
Dim dwRtn As Long
dwRtn = dwRtn Or BIF_RETURNONLYFSDIRS
GetReturnType = dwRtn
End Function
''''
''''文件夹选择对话框
''''函数:SaveFile
''''参数:Title 设置对话框的标签.
'''' hWnd 调用此函数的HWND
'''' FolderID SmBrowFolder枚举(默认:我的电脑).
''''返回值:String 文件夹路径.
''''例子：
Public Function GetFolder(Optional Title As String, _
Optional hWnd As Long, _
Optional FolderID As SmBrowFolder = MyComputer) As String
Dim Bi As BROWSEINFO
Dim Pidl As Long
Dim Folder As String
Dim IDL As ITEMIDLIST
Dim nFolder As Long
Dim ReturnFol As String
Dim Fid As Integer
Fid = FolderID
Folder = String$(255, Chr$(0))
With Bi
.hOwner = hWnd
nFolder = GetFolderValue(Fid)
If SHGetSpecialFolderLocation(ByVal hWnd, ByVal nFolder, IDL) = NoError Then
.pidlRoot = IDL.mkid.cb
End If
.pszDisplayName = String$(MAX_PATH, Fid)
If Len(Title) > 0 Then
.lpszTitle = Title & Chr$(0)
Else
.lpszTitle = "请选择文件夹:" & Chr$(0)
End If
.ulFlags = GetReturnType()
End With
Pidl = SHBrowseForFolder(Bi)
''''/返回所选的文件夹路径
If SHGetPathFromIDList(ByVal Pidl, ByVal Folder) Then
ReturnFol = Left$(Folder, InStr(Folder, Chr$(0)) - 1)
If Right$(Trim$(ReturnFol), 1) <> "\" Then ReturnFol = ReturnFol & "\"
GetFolder = ReturnFol
Else
GetFolder = ""
End If
End Function
''''
''''文件保存对话框
''''函数:SaveFile
''''参数:WinHwnd 调用此函数的HWND
'''' BoxLabel 设置对话框的标签.
'''' StartPath 设置初始化路径.
'''' FilterStr 文件过滤.
'''' Flag 标志.(参考MSDN)
''''返回值:String 文件名.
''''例子：
Public Function SaveFile(WinHwnd As Long, _
Optional BoxLabel As String = "", _
Optional StartPath As String = "", _
Optional FilterStr = "*.*|*.*", _
Optional Flag As Variant = &H4 Or &H200000) As String
Dim Rc As Long
Dim pOpenfilename As OPENFILENAME
Dim Fstr1() As String
Dim Fstr As String
Dim I As Long
Const MAX_Buffer_LENGTH = 256
On Error Resume Next
If Len(Trim$(StartPath)) > 0 Then
If Right$(StartPath, 1) <> "\" Then StartPath = StartPath & "\"
If Dir$(StartPath, vbDirectory + vbHidden) = "" Then
StartPath = App.Path
End If
Else
StartPath = App.Path
End If
If Len(Trim$(FilterStr)) = 0 Then
Fstr = "*.*|*.*"
End If
Fstr1 = Split(FilterStr, "|")
For I = 0 To UBound(Fstr1)
Fstr = Fstr & Fstr1(I) & vbNullChar
Next
''''/--------------------------------------------------
With pOpenfilename
.hwndOwner = WinHwnd
.hInstance = App.hInstance
.lpstrTitle = BoxLabel
.lpstrInitialDir = StartPath
.lpstrFilter = Fstr
.nFilterIndex = 1
.lpstrDefExt = vbNullChar & vbNullChar
.lpstrFile = String(MAX_Buffer_LENGTH, 0)
.nMaxFile = MAX_Buffer_LENGTH - 1
.lpstrFileTitle = .lpstrFile
.nMaxFileTitle = MAX_Buffer_LENGTH
.lStructSize = Len(pOpenfilename)
.flags = Flag
End With
Rc = GetSaveFileName(pOpenfilename)
If Rc Then
SaveFile = Left$(pOpenfilename.lpstrFile, pOpenfilename.nMaxFile)
Else
SaveFile = ""
End If
End Function
''''
''''文件打开对话框
''''函数:OpenFile
''''参数:WinHwnd 调用此函数的HWND
'''' BoxLabel 设置对话框的标签.
'''' StartPath 设置初始化路径.
'''' FilterStr 文件过滤.
'''' Flag 标志.(参考MSDN)
''''返回值:String 文件名.
''''例子：
Public Function OpenFile(WinHwnd As Long, _
Optional BoxLabel As String = "", _
Optional StartPath As String = "", _
Optional FilterStr = "*.*|*.*", _
Optional Flag As Variant = &H8 Or &H200000) As String
Dim Rc As Long
Dim pOpenfilename As OPENFILENAME
Dim Fstr1() As String
Dim Fstr As String
Dim I As Long
Const MAX_Buffer_LENGTH = 256
On Error Resume Next
If Len(Trim$(StartPath)) > 0 Then
If Right$(StartPath, 1) <> "\" Then StartPath = StartPath & "\"
& 上一页 [1] [2] [3] [4] 下一页 |
