说三道四技术文摘-感悟人生的经典句子
说三道四 > 文档快照

如何使commonDialog的FileName变成不可用?

编辑:说三道四文库 发布时间:2017-02-24 12:53
HTML文档下载 WORD文档下载 PDF文档下载
CommonDialog的FileName在show之前赋值,弹出时,如何让文件名文本框变为不可用,即不允许改变文件名。
有什么意义吗?
用户虽然改变了FileName,但你仍可以在对话框关闭后强制给FileName赋原来的值。
如果真要文本框不可用,恐怕要定制对话框,很麻烦的。
难道没有什么api函数可以使文本框变成不可用吗?
关注
关注 
就算有这样的API函数也没什么用处,对话框出来后,程序已经停止了,除非你写的是多线程,你才能在另一线程使用该API
那么有没有只能选择保存路径的控件?
有的,驱动器,目录,等等都有,看看书吧
'以下程序包含三个函数,可以代替 commondialog 的 showopen 与 showsave
'另外包含一个 先择路径的 函数.


Option Explicit

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

Public Type BrowseInfo
     hwndOwner As Long
     pIDLRoot As Long
     pszDisplayName As Long
     lpszTitle As Long
     ulFlags As Long
     lpfnCallback As Long
     lParam As Long
     iImage As Long
End Type

Public Const cdlCancel = 32755
Public Const BIF_RETURNONLYFSDIRS = 1
Public Const MAX_PATH = 260

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Public Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Public Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Public Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long



Public Function vbGetOpenFileName(hWnd As Long, strFilter As String, strDefFileName As String, strDefExt As String, strTitle As String) As String
'Place the following code in under a command button or in a menu, etc...
    Dim ofn As OPENFILENAME
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = hWnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = Replace(strFilter, "|", Chr(0)) & Chr$(0)
    'ofn.lpstrFile = Space$(254)
    ofn.lpstrFile = strDefFileName & String(254, Chr(0))
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space$(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = CurDir
    ofn.lpstrTitle = strTitle
    ofn.flags = 0
    ofn.lpstrDefExt = strDefExt
    
    Dim a
    a = GetOpenFileName(ofn)

    If (a) Then
            vbGetOpenFileName = Left(Trim$(ofn.lpstrFile), InStr(ofn.lpstrFile, Chr(0)) - 1)
    Else
            Err.Clear
            Err.Raise cdlCancel, , "Cancel was pressed"
    End If
End Function


Public Function vbGetSaveFileName(hWnd As Long, strFilter As String, strDefFileName As String, strDefExt As String, strTitle As String) As String
    Dim ofn As OPENFILENAME
    ofn.lStructSize = Len(ofn)
    ofn.hwndOwner = hWnd
    ofn.hInstance = App.hInstance
    ofn.lpstrFilter = Replace(strFilter, "|", Chr(0)) & Chr$(0)
    'ofn.lpstrFile = Space$(254)
    ofn.lpstrFile = strDefFileName & String(254, Chr(0))
    ofn.nMaxFile = 255
    ofn.lpstrFileTitle = Space$(254)
    ofn.nMaxFileTitle = 255
    ofn.lpstrInitialDir = CurDir
    ofn.lpstrTitle = strTitle
    ofn.flags = 0
    ofn.lpstrDefExt = strDefExt
    Dim a
    a = GetSaveFileName(ofn)

    If (a) Then
            vbGetSaveFileName = Left(Trim$(ofn.lpstrFile), InStr(ofn.lpstrFile, Chr(0)) - 1)
    Else
            Err.Clear
            Err.Raise cdlCancel, , "Cancel was pressed"
    End If
End Function

Public Function BrowseForFolder(hwndOwner As Long, sPrompt As String) As String
     
    'declare variables to be used
     Dim iNull As Integer
     Dim lpIDList As Long
     Dim lResult As Long
     Dim sPath As String
     Dim udtBI As BrowseInfo

    'initialise variables
     With udtBI
        .hwndOwner = hwndOwner
        .lpszTitle = lstrcat(sPrompt, "")
        .ulFlags = BIF_RETURNONLYFSDIRS
     End With

    'Call the browse for folder API
     lpIDList = SHBrowseForFolder(udtBI)
     
    'get the resulting string path
     If lpIDList Then
        sPath = String$(MAX_PATH, 0)
        lResult = SHGetPathFromIDList(lpIDList, sPath)
        Call CoTaskMemFree(lpIDList)
        iNull = InStr(sPath, vbNullChar)
        If iNull Then sPath = Left$(sPath, iNull - 1)
    Else
        Err.Clear
        Err.Raise cdlCancel, , "Cancel was pressed"
     End If

    'If cancel was pressed, sPath = ""
     BrowseForFolder = sPath

End Function

关注 
to袁飞:谢谢你,
还有点问题:BrowseForFolder函数能不能设置默认的路径?即弹出的路径是上次保存的路径?
VB 的通用对话框控件不能浏览目录,但也并非一定要用 API ,下面给出另一个例子

首先引用 Microsoft Shell Controls And Automation 对像库

Private Sub Form_Load()
Dim k As New Shell
k.BrowseForFolder Me.hWnd, "袁飞的测试", 1, "C:\Program Files"
End Sub

现在你看到结果了吗?
我这里还有一个可以设置默认的路径的程序,你要的话就来信啦。