用VB类实现文件对话框
用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
