当前位置:首页 > 编程学习 > 用VB类实现文件对话框

用VB类实现文件对话框

编程学习2007-11-0439360

用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


扫描二维码推送至手机访问。

版权声明:本文由海阔天空发布,如需转载请注明出处。

本文链接:https://www.apull.net/html/20071104224.html

标签: 编程VB
分享给朋友:

相关文章

VB获取光驱盘符

VB获取光驱盘符

VB获取光驱盘符Option Explicit Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _ (ByVal nDrive As String) As Long 'GetLogicalDriveStrings-->获取一个字串,其中包含了当前所有逻辑驱动器的根驱动器路径 Private Declare Function GetLogicalDriveStri...

VBScript 错误信息

VBScript 错误信息

错误代码 信息5 无效的过程调用或参数6 溢出7 内存不够9 下标越界10 数组长度固定或临时锁定11 被零除13 类型不匹配14 字符串空间溢出28 堆栈空间溢出35 Sub或Function未定义48 加载D...

常用asp函数

常用asp函数

<% '------------------------------------- '所有功能函数名如下: ' StrLength(str) 取得字符串长度 ' CutStr(str,strlen) 字符串长度切割 ' CheckIsEmpty(tstr) 检测是否为空 ' isInteger(para) 整数检验 ' CheckName(str) 名字字符校验 ' CheckPassword(str) 密码检验 ' CheckEmail(emai...

计算机蓝屏代码的含义

计算机蓝屏代码的含义

0 0x0000 作业完成。1 0x0001 不正确的函数。2 0x0002 系统找不到指定的档案。3 0x0003 系统找不到指定的路径。4 0x0004 系统无法开启档案。5 0x0005 拒绝存取。6 0x0006 无效的代码。7 0x0007 储存体控制区块已毁。8 0x0008 储存体空间不足,无法处理这个指令。9 0x0009 储存体控制区块地址无效。10 0x000A 环境不正确。11 0x000B 尝试加载一个格式错误的程序。12 0x000C 存取码错误。1...

发表评论

访客

看不清,换一张

◎欢迎参与讨论,请在这里发表您的看法和观点。