module1.bas

来自「VB开发的可以移动控件的源码」· BAS 代码 · 共 71 行

Attribute VB_Name = "Module1"
Public Function FileDialog(FormObject As Form, SaveDialog As Boolean, ByVal Title As String, ByVal Filter As String, Optional ByVal FileName As String, Optional ByVal Extention As String, Optional ByVal InitDir As String) As String
    Dim OFN   As OPENFILENAME
    Dim r     As Long

    If Len(FileName) > MAX_PATH Then Call MsgBox("Filename Length Overflow", vbExclamation, App.Title + " - FileDialog Function"): Exit Function

    FormObject.Enabled = False
    FileName = FileName + String(MAX_PATH - Len(FileName), 0)

    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = FormObject.hWnd
        .hInstance = App.hInstance
        .lpstrFilter = Replace(Filter, "|", vbNullChar)
        .lpstrFile = FileName
        .nMaxFile = MAX_PATH
        .lpstrFileTitle = Space$(MAX_PATH - 1)
        .nMaxFileTitle = MAX_PATH
        .lpstrInitialDir = InitDir
        .lpstrTitle = Title
        .flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT
        .lpstrDefExt = Extention
    End With

Dim l As Long
l = GetTickCount

    If SaveDialog Then r = GetSaveFileName(OFN) Else r = GetOpenFileName(OFN)

If GetTickCount - l < 20 Then
OFN.lpstrFile = ""
If SaveDialog Then r = GetSaveFileName(OFN) Else r = GetOpenFileName(OFN)
End If

    If r = 1 Then FileDialog = Left$(OFN.lpstrFile, InStr(1, OFN.lpstrFile + vbNullChar, vbNullChar) - 1)
    FormObject.Enabled = True

End Function
Public Function BrowseFolders(FormObject As Form, sMessage As String) As String
    Dim b As BrowseInfo
    Dim r As Long
    Dim l As Long
    Dim f As String

    FormObject.Enabled = False
    With b
        .hwndOwner = FormObject.hWnd
        .lpszTitle = lstrcat(sMessage, "")
        .ulFlags = BrowseForFolders
    End With

    SHGetSpecialFolderLocation FormObject.hWnd, CSIDL_DRIVES, b.pIDLRoot
    r = SHBrowseForFolder(b)

    If r <> 0 Then     'A zero would mean cancel was pressed
        f = String(MAX_PATH, vbNullChar)
        SHGetPathFromIDList r, f
        CoTaskMemFree r
        l = InStr(1, f, vbNullChar) - 1
        If l < 0 Then l = 0
        f = Left(f, l)
        AddSlash f
    End If

    BrowseFolders = f
    FormObject.Enabled = True

End Function