Wednesday, May 24, 2006

Show Open Dialog using Windows API

Dalam VB6 fungsi yang paling sering digunakan adalah Open File Dialog. Nah selain menggunakan menu manager yang terinstall di dalam VB, kita juga bisa langsung menggunakan Function yang telah ada pada Windows API. Untuk coding lengkapnya bisa di lihat di bawah ini :
'------------------------------------
Option Explicit
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXPLORER = &H80000
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Function BukaFileDlg(ByRef FileResult() As String, ByVal MultiSelect As Boolean, _
Optional ByVal DialogTitle As String = "", Optional ByVal FileFilter As String = "", _
Optional ByVal InitDir As String = "") As Boolean
Dim oFn As OPENFILENAME
Dim Stat As Long
Dim DefFilter As String
Dim Result As String
Dim ResultDir As String
Dim ResultFile As String
Dim ArrTmp() As String
Dim EndPos As Integer
Dim i As Integer
On Error GoTo errBukaFileDlg
'Preparing Dialog Environment
DefFilter = "All Files (*.*)" & Chr(0) "*.*"
If Len(FileFilter) > 0 Then DefFilter = FileFilter

oFn.lStructSize = Len(oFn)
oFn.hwndOwner = Form1.hWnd
oFn.hInstance = App.hInstance
oFn.lpstrFilter = DefFilter
oFn.lpstrFile = String$(1024, 0)
oFn.nMaxFile = 255
oFn.lpstrFileTitle = oFn.lpstrFile
oFn.nMaxFileTitle = oFn.nMaxFile
oFn.lpstrInitialDir = InitDir
oFn.lpstrTitle = DialogTitle
If MultiSelect Then
oFn.flags = OFN_ALLOWMULTISELECT Or OFN_EXPLORER
Else
oFn.flags = 0
End If
Stat = GetOpenFileName(oFn)
'Exit when Cancel Pressed
If Stat = 0 Then
BukaFileDlg = False
Exit Function
End If
BukaFileDlg = True
'Proccesing Output file into Array
Result = oFn.lpstrFile
ResultDir = Mid(Result, 1, oFn.nFileOffset - 1)
EndPos = InStr(oFn.lpstrFile, Chr$(0) & Chr$(0)) - 1
If EndPos <>
EndPos = Len(Result)
End If
ResultFile = Mid((Result), oFn.nFileOffset + 1, EndPos - oFn.nFileOffset)
ArrTmp = Split(ResultFile, vbNullChar)
For i = 0 To UBound(ArrTmp)
ArrTmp(i) = ResultDir & "\" & ArrTmp(i)
Next i
FileResult = ArrTmp
Exit Function
errBukaFileDlg:
BukaFileDlg = False
MsgBox Err.Number & "-" Err.Description, vbCritical, DialogTitle
End Function
'------------------------------
Mudah bukan?? Any questions are very welcome. :)