就好像关闭选择文件的程序之后,再次重新打开选择窗口,它还会指向原来的文件位置
解决方案 »
- Label控件真的没有句柄吗?
- 高分求助高难问题?斑马打印机VB设置
- 急需解释。。。。。
- 为什么我的VB6打开时,不能再加入控件,只有几个最基本的控件,我的操作系统是WinNT
- 请问有没有办法改变工具栏的大小,如用SetWindowlong?
- shell(如何打开.html)文件?
- 如何获得用api函数(SetTextCharacterExtra和DrawText)画的文本的宽度!
- 有关使用TreeView和ImageList的问题???
- 版友须知:今天本版主被人举报了
- InstallShield for Microsoft VB 请问那里有这个东东下载。。。。
- 自动换代理打开网页并点击其中的超级连接用什么方法最合适?
- 让我转个弯
'调用 浏览目录 对话框
'--------------------API声明部分--------------------
'common to both methods
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End TypePrivate Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long) '前面已定义Private Const MAX_PATH = 260
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1Private Const BFFM_SETSTATUSTEXTA As Long = (WM_USER + 100)
Private Const BFFM_SETSTATUSTEXTW As Long = (WM_USER + 104)Private Const BFFM_ENABLEOK As Long = (WM_USER + 101)
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)Private Declare Function SHSimpleIDListFromPath Lib "shell32" Alias "#162" (ByVal szPath As String) As Long
Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib "kernel32" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib "kernel32" (lpString As Any) As LongPrivate Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const lPtr = (LMEM_FIXED Or LMEM_ZEROINIT)Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_USENEWUI = &H40Private PreSelFolder As String'-------------------------------------------
' 目录选择窗(允许指定初始目录)
'-------------------------------------------
Function BrowseForFolder(Optional ByVal sTitle As String, Optional ByVal sSelPath As String, Optional NewFolder As Boolean, Optional ByVal hWndOwner As Long) As String Dim BI As BROWSEINFO
Dim pidl As Long
Dim lpSelPath As Long
Dim sPath As String * MAX_PATH
If Len(sSelPath) > 0 Then
sSelPath = Replace(sSelPath & "\", "\\", "\")
Else
sSelPath = PreSelFolder
End If
With BI
.hOwner = hWndOwner
.pidlRoot = 0
.lpszTitle = sTitle
.lpfn = FARPROC(AddressOf BrowseCallbackProcStr)
lpSelPath = LocalAlloc(lPtr, Len(sSelPath))
MoveMemory ByVal lpSelPath, ByVal sSelPath, Len(sSelPath)
.lParam = lpSelPath
.ulFlags = IIf(NewFolder, BIF_USENEWUI, BIF_RETURNONLYFSDIRS)
End With
pidl = SHBrowseForFolder(BI)
If pidl Then
If SHGetPathFromIDList(pidl, sPath) Then
BrowseForFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)
End If
Call CoTaskMemFree(pidl)
End If
Call LocalFree(lpSelPath)
'If cancel was pressed, sPath = ""
If Len(BrowseForFolder) > 0 Then
BrowseForFolder = Replace(BrowseForFolder & "\", "\\", "\")
PreSelFolder = BrowseForFolder
End IfEnd FunctionPrivate Function BrowseCallbackProcStr(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal StrFromPtrA(lpData))
Case Else:
End SelectEnd FunctionPrivate Function FARPROC(ByVal pfn As Long) As Long FARPROC = pfnEnd FunctionPrivate Function StrFromPtrA(ByVal lpszA As Long) As String Dim sRtn As String
sRtn = String$(lstrlenA(ByVal lpszA), 0)
Call lstrcpyA(ByVal sRtn, ByVal lpszA)
StrFromPtrA = sRtnEnd Function