mmssoft
سه شنبه 19 شهریور 1392, 14:17 عصر
سلام، من با استفاده از کد زیر پنجره Browse folder ویندوز رو باز میکنم و ازش یه آدرس میخونم. ولی هر کاری کردم نتونستم پنجره رو به شکلی که داخلش یه دکمه New Folder هست، فراخوانی کنم.
ممنون میشم راهنمایی کنید
Option Explicit
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 Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpbi 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 hMem As Long)
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_STATUSTEXT = 4
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private m_sDefaultFolder As String
Public Function BrowseForFolder(DefaultFolder As String, Optional Parent As Long = 0, Optional Caption As String = "") As String
On Error Resume Next
Dim bi As BrowseInfo
Dim sResult As String, nResult As Long
bi.hwndOwner = Parent
bi.pIDLRoot = 0
bi.pszDisplayName = String$(MAX_PATH, Chr$(0))
If Len(Caption) > 0 Then bi.lpszTitle = Caption
bi.ulFlags = BIF_RETURNONLYFSDIRS
bi.lpfn = GetAddress(AddressOf BrowseCallbackProc)
bi.lParam = 0
bi.iImage = 0
m_sDefaultFolder = DefaultFolder
nResult = SHBrowseForFolder(bi)
If nResult <> 0 Then
sResult = String(MAX_PATH, 0)
If SHGetPathFromIDList(nResult, sResult) Then BrowseForFolder = Left$(sResult, InStr(sResult, Chr$(0)) - 1)
CoTaskMemFree nResult
End If
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
On Error Resume Next
Select Case uMsg
Case BFFM_INITIALIZED
'--------------------------------------------------------------------------
If Len(m_sDefaultFolder) > 0 Then SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal m_sDefaultFolder
'--------------------------------------------------------------------------
End Select
End Function
Private Function GetAddress(nAddress As Long) As Long
GetAddress = nAddress
End Function
ممنون میشم راهنمایی کنید
Option Explicit
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 Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpbi 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 hMem As Long)
Private Const MAX_PATH = 260
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_STATUSTEXT = 4
Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Type BrowseInfo
hwndOwner As Long
pIDLRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private m_sDefaultFolder As String
Public Function BrowseForFolder(DefaultFolder As String, Optional Parent As Long = 0, Optional Caption As String = "") As String
On Error Resume Next
Dim bi As BrowseInfo
Dim sResult As String, nResult As Long
bi.hwndOwner = Parent
bi.pIDLRoot = 0
bi.pszDisplayName = String$(MAX_PATH, Chr$(0))
If Len(Caption) > 0 Then bi.lpszTitle = Caption
bi.ulFlags = BIF_RETURNONLYFSDIRS
bi.lpfn = GetAddress(AddressOf BrowseCallbackProc)
bi.lParam = 0
bi.iImage = 0
m_sDefaultFolder = DefaultFolder
nResult = SHBrowseForFolder(bi)
If nResult <> 0 Then
sResult = String(MAX_PATH, 0)
If SHGetPathFromIDList(nResult, sResult) Then BrowseForFolder = Left$(sResult, InStr(sResult, Chr$(0)) - 1)
CoTaskMemFree nResult
End If
End Function
Private Function BrowseCallbackProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
On Error Resume Next
Select Case uMsg
Case BFFM_INITIALIZED
'--------------------------------------------------------------------------
If Len(m_sDefaultFolder) > 0 Then SendMessage hwnd, BFFM_SETSELECTIONA, True, ByVal m_sDefaultFolder
'--------------------------------------------------------------------------
End Select
End Function
Private Function GetAddress(nAddress As Long) As Long
GetAddress = nAddress
End Function