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

用VB类实现文件对话框

编程学习2007-11-0445230

用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://apull.net/html/20071104224.html

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

相关文章

VB/VB.net 只允许运行一个实例

VB/VB.net 只允许运行一个实例

VB/VB.net  只允许运行一个实例       by:  Apull  VB中的实现方法VB如何防止程序被重复加载,也就是只允许运行一个实例,一般有2种方法。一,直接用VB提供的APP对象的PrevInstance方法。PrevInstance的返回值为True则说明已经有一个实力在运行。If App.PrevInstance Then Msgbox "已经有一个实例在运行" End if这个...

制作网页28个常用小代码

制作网页28个常用小代码

1、oncontextmenu="window.event.returnValue=false" 将彻底屏蔽鼠标右键<table border oncontextmenu=return(false)><td>no</table>  可用于Table2、<body onselectstart="return false"> 取消选取、防止复制3、onpaste="retu...

VB.NET关于加密算法

VB.NET关于加密算法

加密将防止数据被查看或修改,并在原本不安全的信道上提供安全的通信信道,它达到以下目的:  保密性:防止用户的标识或数据被读取。  数据完整性:防止数据被更改。  身份验证:确保数据发自特定的一方。  基本概念  1、散列(HASH)函数  散列(HASH)函数H也称哈希函数或杂凑函数等,是典型的多到一的函数,其输入为一可变长x(可以足够的长),输出一固定长的串h(一般为128位、160位,比输入的串短),该串h被称为输入x的Hash值(或称消息摘要Message  ...

HTML与ASCII码表

HTML与ASCII码表

HTML与ASCII码表Standard ASCII set, HTML Entity names, ISO 10646, ISO 8879, ISO 8859-1  Latin alphabet No. 1Browser support: All browsersASCIIHTMLHTMLDecHexSymbolNumberNameDescription32333435363738394041424344454647202122232425262728292A2B...

发表评论

访客

看不清,换一张

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