用VB类实现文件对话框

'类名：ComDlg.cls
'作用：文件打开保存对话框
'
'
'
'By：Apull
'2007-5-21
'http://www.apull.net
       
       
Option Explicit
       
Private Declare Function GetOpenFileName Lib "comdlg32.dll"  Alias "GetOpenFileNameA" ( _
pOpenfilename As OPENFILENAME) As Long
       
Private Declare Function GetSaveFileName Lib "comdlg32.dll"  Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
       
       
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
       
' file  constants
Const cdlOFNAllowMultiselect =  &H200
Const  cdlOFNCreatePrompt = &H2000
Const cdlOFNExplorer =  &H80000
Const  cdlOFNExtensionDifferent = &H400
Const cdlOFNFileMustExist =  &H1000
Const  cdlOFNHelpButton = &H10
Const cdlOFNHideReadOnly =  4
Const cdlOFNLongNames =  &H200000
Const  cdlOFNNoChangeDir = 8
Const cdlOFNNoDereferenceLinks =  &H100000
Const  cdlOFNNoLongNames = &H40000
Const cdlOFNNoReadOnlyReturn =  &H8000
Const  cdlOFNNoValidate = &H100
Const cdlOFNOverwritePrompt =  2
Const cdlOFNPathMustExist =  &H800
Const  cdlOFNReadOnly = 1
Const cdlOFNShareAware =  &H4000
       
       
'属性  =======================
'保持属性值的局部变量
Private  sPath As String
       
Private mFileName As String
Private mFileTitle As String
Private mhOwner As Long
Private mDialogTitle As String
Private mFilter As String
Private mInitDir As String
Private mDefaultExt As String
Private mFilterIndex As Long
Private mFlags As Long
Private mHelpFile As String
Private mHelpCommand As Long
Private mHelpKey As String
       
       
       
Friend Property Get DefaultExt() As String
DefaultExt =  mDefaultExt
End  Property
       
Friend  Property Let DefaultExt(sDefExt  As String)
mDefaultExt =  sDefExt
End  Property
       
Friend  Property Get DialogTitle() As String
DialogTitle =  mDialogTitle
End  Property
       
Friend  Property Let DialogTitle(sTitle  As String)
mDialogTitle =  sTitle
End  Property
       
Friend  Property Get FileName() As String
FileName =  mFileName
End  Property
       
Friend  Property Let FileName(sFileName  As String)
mFileName =  sFileName
End  Property
       
Friend  Property Get FileTitle() As String
FileTitle =  mFileTitle
End  Property
       
Friend  Property Let FileTitle(sTitle  As String)
mFileTitle =  sTitle
End  Property
       
Friend  Property Get Filter() As String
Filter = mFilter
End Property
       
Friend Property Let Filter(sFilter As String)
mFilter =  sFilter
End  Property
       
Friend  Property Get FilterIndex() As Long
FilterIndex =  mFilterIndex
End  Property
       
Friend  Property Let FilterIndex(lIndex  As Long)
mFilterIndex =  lIndex
End  Property
       
Friend  Property Get Flags() As Long
Flags =  mFlags
End  Property
       
Friend  Property Let Flags(lFlags  As Long)
mFlags =  lFlags
End  Property
       
Friend  Property Get HelpCommand() As Long
HelpCommand =  mHelpCommand
End  Property
       
Friend  Property Let HelpCommand(lCommand  As Long)
mHelpCommand =  lCommand
End  Property
       
Friend  Property Get HelpFile() As String
HelpFile =  mHelpFile
End  Property
       
Friend  Property Let HelpFile(sFile  As String)
mHelpFile =  sFile
End  Property
       
Friend  Property Get HelpKey() As String
HelpKey =  mHelpKey
End  Property
       
Friend  Property Let HelpKey(sKey  As String)
mHelpKey =  sKey
End  Property
       
Friend  Property Get InitDir() As String
InitDir =  mInitDir
End  Property
       
Friend  Property Let InitDir(sDir  As String)
mInitDir =  sDir
End  Property
       
Friend  Property Get Path() As String
Path =  sPath
End  Property
       
       
'方法 ==========================
       
'显示打开文件对话框
'参数：  父窗口句柄
Public Sub ShowOpen(hWndOwner As Long)
       
Dim strFile     As String
Dim OFName     As OPENFILENAME
       
OFName.lStructSize  = Len(OFName)
OFName.hWndOwner = hWndOwner
OFName.hInstance  = vbNull 'App.hInstance
    OFName.lpstrFile =  Space$(254)
OFName.nMaxFile =  255
OFName.lpstrFileTitle  = Space$(254)
OFName.nMaxFileTitle =  255
OFName.lpstrDefExt  = mDefaultExt & Chr(0)
OFName.lpstrTitle =  "选择要打开的文件"  & Chr(0)
OFName.lpstrFilter =  mFilter & Chr(0)
OFName.Flags =  mFlags
       
If  GetOpenFileName(OFName) Then
Dim s() As String
s = Split(Trim(OFName.lpstrFile), Chr(0))
       
mFileName  = s(0)
Else
mFileName  = ""
End If
       
End Sub
       
'显示保存文件对话框
'参数：父窗口句柄
Public  Sub ShowSave(hWndOwner As Long)
       
Dim strFile     As String
Dim OFName     As OPENFILENAME
       
OFName.lStructSize  = Len(OFName)
OFName.hWndOwner = hWndOwner
OFName.hInstance  = App.hInstance
OFName.lpstrFile =  Space$(254)
OFName.nMaxFile =  255
OFName.lpstrFileTitle  = Space$(254)
OFName.nMaxFileTitle =  255
'OFName.lpstrDefExt =  "所有文件(*.*)" & Chr(0) & "*.*" & Chr(0)
    OFName.lpstrDefExt =  mDefaultExt & Chr(0)
       
OFName.lpstrTitle =  "保存"  & Chr(0)
OFName.lpstrFilter =  mFilter
       
OFName.Flags = mFlags '
                   
If GetSaveFileName(OFName) Then
Dim s() As String
s = Split(Trim(OFName.lpstrFile), Chr(0))
       
mFileName  = s(0)
Else
mFileName  = ""
End If
       
End Sub
       
'初始化函数  =========================================
Public  Sub Class_Initialize()
     mFlags = cdlOFNHideReadOnly  Or cdlOFNExplorer Or cdlOFNOverwritePrompt Or cdlOFNLongNames Or cdlOFNPathMustExist 'Or  cdlOFNFileMustExist
             
End Sub
       
'析构函数  =========================================
Public  Sub Class_Terminate()
       
End Sub

使用方法：

在工程中添加一个类文件，粘贴上面的内容并保存为ComDlg.cls。

在窗体上放一个按钮，写入下面的代码。

'在form中定义
Dim  comdlg new ComDlg
Dim FileName As String
       
'按钮单击事件
Private Sub Command1_Click()    
With comdlg
.Filter =  "文本文件(*.txt)"  & Chr(0) & "*.txt" & Chr(0)  & _
"所有文件(*.*)"  & Chr(0) & "*.*" & Chr(0)
.ShowSave (Me.hWnd)
FileName =  .FileName
End With
End  Sub