打开和另存为对话框

最新推荐文章于 2023-12-07 20:28:08 发布

留下些什么

最新推荐文章于 2023-12-07 20:28:08 发布

阅读量112

点赞数

分类专栏： VB实例源码文章标签： windows

本文链接：https://blog.csdn.net/zezese/article/details/132157366

版权

VB实例源码专栏收录该内容

31 篇文章 2 订阅

订阅专栏

用API函数GetOpenFileName和GetSaveFileName来创建“打开”和“另存为”对话框。

OPENFILENAMEA (commdlg.h) - Win32 apps | Microsoft Learn

https://learn.microsoft.com/zh-cn/windows/win32/api/commdlg/ns-commdlg-openfilenamea

新建一个标准EXE工程，加入一个窗口和标准模块。

窗口代码如下：

'用户昵称: 留下些什么
'个人简介: 一个会做软件的货代
'CSDN网址：https://blog.csdn.net/zezese
'电子邮箱：31319180@qq.com

Option Explicit

Private Sub Command1_Click()
    Debug.Print OpenFile(Me.hwnd, "文本文件(*.txt)|*.txt")
End Sub

Private Sub Command2_Click()
    Debug.Print SaveFile(Me.hwnd, "文本文件", ".txt")
End Sub

标准模块代码如下：

'用户昵称: 留下些什么
'个人简介: 一个会做软件的货代
'CSDN网址：https://blog.csdn.net/zezese
'电子邮箱：31319180@qq.com

Option Explicit

Public Enum DialogFlags
    OFN_READONLY = &H1
    OFN_OVERWRITEPROMPT = &H2
    OFN_HIDEREADONLY = &H4
    OFN_NOCHANGEDIR = &H8
    OFN_SHOWHELP = &H10
    OFN_ENABLEHOOK = &H20
    OFN_ENABLETEMPLATE = &H40
    OFN_ENABLETEMPLATEHANDLE = &H80
    OFN_NOVALIDATE = &H100
    OFN_ALLOWMULTISELECT = &H200
    OFN_EXTENSIONDIFFERENT = &H400
    OFN_PATHMUSTEXIST = &H800
    OFN_FILEMUSTEXIST = &H1000
    OFN_CREATEPROMPT = &H2000
    OFN_SHAREAWARE = &H4000
    OFN_NOREADONLYRETURN = &H8000
    OFN_NOTESTFILECREATE = &H10000
    OFN_NONETWORKBUTTON = &H20000
    OFN_NOLONGNAMES = &H40000
    OFN_EXPLORER = &H80000
    OFN_NODEREFERENCELINKS = &H100000
    OFN_LONGNAMES = &H200000
End Enum

Private Const MAX_PATH As Long = 260

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 DialogFlags
     nFileOffset As Integer
     nFileExtension As Integer
     lpstrDefExt As String
     lCustData As Long
     lpfnHook As Long
     lpTemplateName As String
End Type

Private OpenPath As String
Private SavePath As String

Function SaveFile(ByVal hwnd As Long, ByVal dlgFilterDescription As String, ByVal dlgFilter As String, _
    Optional ByVal dlgTitle As String = "另存为", Optional ByVal dlgIniDir) As String
    
    On Error Resume Next
    
    Dim OFName As OPENFILENAME, sFileName As String
    
    With OFName
        '设置结构的大小
        .lStructSize = Len(OFName)
        '设置父窗口
        .hwndOwner = hwnd
        '设置程序的实例
        .hInstance = App.hInstance
        '设置过滤属性
        .lpstrFilter = dlgFilterDescription & "(*" & dlgFilter & ")" & Chr(0) & "*" & dlgFilter & Chr(0)
        '设置默认扩展名
        .lpstrFile = String(MAX_PATH, Chr(0))
        '设置返回的文件（全路径）的最大长度
        .nMaxFile = MAX_PATH
        '为文件名称创建缓冲区
        .lpstrFileTitle = String(MAX_PATH, Chr(0))
        '设置返回的文件名称的最大长度
        .nMaxFileTitle = MAX_PATH
        If IsMissing(dlgIniDir) Then
            .lpstrInitialDir = SavePath
        Else
            .lpstrInitialDir = dlgIniDir
        End If
        '设置对话框标题
        .lpstrTitle = dlgTitle
        .flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT
    End With
    
    If GetSaveFileName(OFName) Then
        sFileName = GetUsefullStr(OFName.lpstrFile)
        If Right(sFileName, 4) <> Trim(dlgFilter) Then
            SaveFile = sFileName & Trim(dlgFilter)
        Else
            SaveFile = sFileName
        End If
        SavePath = GetPath(sFileName)
    Else
        SaveFile = ""
    End If
    
End Function


Function OpenFile(ByVal hwnd As Long, ByVal dlgFilter As String, _
    Optional ByVal dlgTitle As String = "打开", Optional ByVal dlgIniDir) As String
    
    On Error Resume Next
    
    Dim OFName As OPENFILENAME, sFileName As String
    
    With OFName
        '设置结构的大小
        .lStructSize = Len(OFName)
        '设置父窗口
        .hwndOwner = hwnd
        '设置程序的实例
        .hInstance = App.hInstance
        '设置过滤属性
        .lpstrFilter = ChangeStr(dlgFilter)
        '设置默认扩展名
        .lpstrFile = String(MAX_PATH, Chr(0))
        '设置返回的文件（全路径）的最大长度
        .nMaxFile = MAX_PATH
        '为文件名称创建缓冲区
        .lpstrFileTitle = String(MAX_PATH, Chr(0))
        '设置返回的文件名称的最大长度
        .nMaxFileTitle = MAX_PATH
        If IsMissing(dlgIniDir) Then
            .lpstrInitialDir = OpenPath
        Else
            .lpstrInitialDir = dlgIniDir
        End If
        '设置对话框标题
        .lpstrTitle = dlgTitle
        .flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT
    End With
    
    If GetOpenFileName(OFName) Then
        sFileName = GetUsefullStr(OFName.lpstrFile)
        OpenFile = sFileName
        OpenPath = GetPath(sFileName)
    Else
        OpenFile = ""
    End If

End Function


Function OpenFiles(ByVal hwnd As Long, FileNames() As String, ByVal dlgFilter As String, _
    Optional ByVal dlgTitle As String = "打开", Optional ByVal dlgIniDir) As Long
    
    On Error Resume Next
    
    Dim OFName As OPENFILENAME
    
    With OFName
        '设置结构的大小
        .lStructSize = Len(OFName)
        '设置父窗口
        .hwndOwner = hwnd
        '设置程序的实例
        .hInstance = App.hInstance
        '设置过滤属性
        .lpstrFilter = ChangeStr(dlgFilter)
        '设置默认扩展名
        .lpstrFile = String(2048, Chr(0))
        '设置返回的文件（全路径）的最大长度
        .nMaxFile = 2048
        '为文件名称创建缓冲区
        .lpstrFileTitle = String(2048, Chr(0))
        '设置返回的文件名称的最大长度
        .nMaxFileTitle = 2048
        If IsMissing(dlgIniDir) Then
            .lpstrInitialDir = OpenPath
        Else
            .lpstrInitialDir = dlgIniDir
        End If
        '设置对话框标题
        .lpstrTitle = dlgTitle
        .flags = OFN_EXPLORER Or OFN_OVERWRITEPROMPT
    End With
    
    If GetOpenFileName(OFName) Then
        OpenFiles = GetFiles(OFName.lpstrFile, FileNames)
        OpenPath = GetPath(FileNames(0))
    Else
        Dim fn(0) As String
        FileNames = fn()
        OpenFiles = 0
    End If
    
End Function

Private Function ChangeStr(ByVal s As String) As String
    s = Trim(s)
    If s = "" Then Exit Function
    ChangeStr = Replace(s, "|", Chr(0))
End Function

Private Function GetUsefullStr(ByVal s As String) As String
    s = Trim(s)
    If s = "" Then Exit Function
    GetUsefullStr = Left(s, InStr(1, s, Chr(0)) - 1)
End Function

Private Function GetPath(ByVal s As String) As String
    Dim i As Long
    For i = Len(s) To 1 Step -1
        If Mid(s, i, 1) = "\" Then
            GetPath = Left(s, i)
            Exit For
        End If
    Next
End Function

Private Function GetFiles(ByVal s As String, fns() As String) As Long
    Dim n As Long, i As Long
    Dim MultiFile As Boolean
    Dim fn() As String, FileNames() As String
    
    For i = Len(s) To 1 Step -1
        If Asc(Mid(s, i, 1)) <> 0 Then
            s = Left(s, i)
            Exit For
        End If
    Next
    
    For i = 1 To Len(s)
        If Asc(Mid(s, i, 1)) = 0 Then
            MultiFile = True
            Exit For
        End If
    Next
    
    If MultiFile Then
        fn = Split(s, Chr(0))
        ReDim FileNames(UBound(fn) - 1)
        For i = 1 To UBound(fn)
            FileNames(i - 1) = fn(0) & "\" & fn(i)
        Next
        GetFiles = UBound(fn)
    Else
        ReDim FileNames(0)
        FileNames(0) = s
        
        GetFiles = 1
    End If
    
    fns = FileNames
    
End Function