Monday, May 28, 2012

Menampilkan Browse For Folder Menggunakan Fungsi API

Pada postingan terdahulu telah kami ketengahkan mengenai cara menampilkan browse for folder dengan mudah menggunakan kode yang pendek dengan memanfaatkan ActiveX. Sekarang, kita akan menampilkan browse for folder dengan memanfaatkan fungsi API, tentu saja kodenya lebih panjang dari artikel yang terdahulu.
Option Explicit 

Private Const
BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260

Private Declare Function
SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function
SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function
lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Public Type
BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type

Public Function
BrowseForFolder(hwnd As Long, Optional Title As String = "Browse For Folder") As String
Dim
lpIDList As Long
Dim
sBuffer As String
Dim
szTitle As String
Dim
tBrowseInfo As BrowseInfo
szTitle = "This Is My Title"
With tBrowseInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
BrowseForFolder = sBuffer
End If
End
Function


Private Sub Command1_Click() 
Text1.Text = BrowseForFolder(Me.hwnd)
End Sub