Страница: 1 |
В VBA есть штука Application.GetOpenFileName - вызывает диалоговое окно открытия файла. Как такую же штуку сделать в VB в своей проге?
'Это все в модуле. Если заменить везде Public на Private, можно и в форме Const MAX_PATH=1024 Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (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 Public Function ShowOpen(Filter As String, hwndOwner as Long, OpenDialogTitle As String) As String On Error Resume Next Dim OFN As OPENFILENAME Dim sFilter As String Dim nRes As Long sFilter = ConvertFilter(Filter) OFN.hInstance = App.hInstance OFN.flags = 4 OFN.hwndOwner = hwndOwner OFN.lpstrFile = String(MAX_PATH, vbNullChar) OFN.lpstrTitle = OpenDialogTitle OFN.lpstrFilter = sFilter OFN.nMaxFile = MAX_PATH OFN.lStructSize = LenB(OFN) nRes = GetOpenFileName(OFN) If nRes Then ShowOpen = Trim(OFN.lpstrFile) Else ShowOpen = "" End Function Private Function ConvertFilter(ByVal sFilter) As String On Error Resume Next Dim sTemp As String Dim i As Integer sTemp = sFilter For i = 1 To Len(sTemp) If Mid(sTemp, i, 1) = "|" Then Mid(sTemp, i, 1) = vbNullChar Next i ConvertFilter = sTemp End Function Открытие стандартного окна выбора папок/файлов Данный пример является дополнением к "Открытие стандартного окна выбора папок/файлов", но обеспечивает дополнительную возможность выбора только "Сетевого Окружения", а также папок ПРОГРАММЫ и ГЛАВНОЕ МЕНЮ Вам понадобится элемент CommandButton Private 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 Enum BrowseType BrowseForFolders = &H1 BrowseForComputers = &H1000 BrowseForPrinters = &H2000 BrowseForEverything = &H4000 End Enum Public Enum FolderType CSIDL_BITBUCKET = 10 CSIDL_CONTROLS = 3 CSIDL_DESKTOP = 0 CSIDL_DRIVES = 17 CSIDL_FONTS = 20 CSIDL_NETHOOD = 18 CSIDL_NETWORK = 19 CSIDL_PERSONAL = 5 CSIDL_PRINTERS = 4 CSIDL_PROGRAMS = 2 CSIDL_RECENT = 8 CSIDL_SENDTO = 9 CSIDL_STARTMENU = 11 End Enum Private Const MAX_PATH = 260 Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BrowseInfo) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder As Long, ListId As Long) As Long Public Function BrowseFolders(hWndOwner As Long, sMessage As String, Browse As BrowseType, ByVal RootFolder As FolderType) As String Dim Nullpos As Integer Dim lpIDList As Long Dim res As Long Dim sPath As String Dim BInfo As BrowseInfo Dim RootID As Long SHGetSpecialFolderLocation hWndOwner, RootFolder, RootID BInfo.hWndOwner = hWndOwner BInfo.lpszTitle = lstrcat(sMessage, "") BInfo.ulFlags = Browse If RootID <> 0 Then BInfo.pIDLRoot = RootID lpIDList = SHBrowseForFolder(BInfo) If lpIDList <> 0 Then sPath = String(MAX_PATH, 0) res = SHGetPathFromIDList(lpIDList, sPath) Call CoTaskMemFree(lpIDList) Nullpos = InStr(sPath, vbNullChar) If Nullpos <> 0 Then sPath = Left(sPath, Nullpos - 1) End If End If BrowseFolders = sPath End Function Private Sub Command1_Click() 'следующие вызовы функции сработали нормально MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_DESKTOP) '+весь компьютер 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_DRIVES) '+только устройства 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_NETHOOD) '+только сеть 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_PROGRAMS) '+папка Программы 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_STARTMENU) '+Главное меню 'результат действия следующих кодов вызвал недоумение... 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_BITBUCKET) '-корзина 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_CONTROLS) '-панель управления 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_FONTS) '-папка со шрифтами 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_NETWORK) '-NetHood 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_PERSONAL) '-Мои документы 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_PRINTERS) '-Принтеры 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_RECENT) '-RECENT 'MsgBox BrowseFolders(hWnd, "Select a Folder", BrowseForFolders, CSIDL_SENDTO) '-SENDTO End Sub Да зачем такие нерациональные сложности? Просто воспользуйся ...-буками и оператором OPEN ... и всё! Нет тута Open непоможет как я понял челу надо CommonDialog программно вызвать. Незнаю может здесь всё это уже написано, но ... Option Compare Database Option Explicit Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean Declare Function GetSaveFileName Lib "comdlg32.dll" _ Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As Long nMaxCustrFilter 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 lCustrData As Long lpfnHook As Long lpTemplateName As Long End Type Public Const OFN_ALLOWMULTISELECT = &H200 Public Const OFN_CREATEPROMPT = &H2000 Public Const OFN_EXPLORER = &H80000 Public Const OFN_FILEMUSTEXIST = &H1000 Public Const OFN_HIDEREADONLY = &H4 Public Const OFN_NOCHANGEDIR = &H8 Public Const OFN_NODEREFERENCELINKS = &H100000 Public Const OFN_NONETWORKBUTTON = &H20000 Public Const OFN_NOREADONLYRETURN = &H8000 Public Const OFN_NOVALIDATE = &H100 Public Const OFN_OVERWRITEPROMPT = &H2 Public Const OFN_PATHMUSTEXIST = &H800 Public Const OFN_READONLY = &H1 Public Const OFN_SHOWHELP = &H10 Public Function OpenFile(ByVal InitDir As String, ByVal fname As String) As String Dim strFile As String * 512 Dim of As OPENFILENAME Dim F As String Dim p% ' Установка начальных значений структуры of.hwndOwner = Application.hWndAccessApp of.hInstance = 0 of.lpstrCustomFilter = 0 of.nMaxCustrFilter = 0 of.lpfnHook = 0 of.lpTemplateName = 0 of.lCustrData = 0 'Ниже вы можете изменить фильтры для поиска файлов of.lpstrFilter = "MS Access Database (*.mdb)" & Chr$(0) & "*.mdb" & Chr$(0) & _ "Add-ins (*.mda)" & Chr$(0) & "*.mda" & Chr$(0) & _ "MDE-Files (*.mde)" & Chr$(0) & "*.mde" & Chr$(0) & _ "All Files (*.*)" & Chr$(0) & "*.*" & Chr$(0) & Chr$(0) of.nFilterIndex = 3 of.lpstrFile = fname & String$(512 - Len(fname), 0) of.nMaxFile = 511 of.lpstrFileTitle = String$(512, 0) of.nMaxFileTitle = 511 ' Ниже вы можете изменить заголовок окна of.lpstrTitle = "Открыть модуль" of.lpstrInitialDir = InitDir ' Можете изменить расширение файла of.lpstrDefExt = "mde" of.Flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST '+ OFN_EXPLORER of.lStructSize = Len(of) If GetOpenFileName(of) Then p% = InStr(1, of.lpstrFile, Chr$(0)) OpenFile = Left(of.lpstrFile, p% - 1) Else OpenFile = "" End If End Function Страница: 1 |
Вопрос: открытие файла
Добавлено: 12.12.03 21:36
Автор вопроса: Нукен
Ответы
Всего ответов: 5
Номер ответа: 1
Автор ответа:
cresta
Вопросов: 117
Ответов: 1538
Профиль | | #1
Добавлено: 12.12.03 23:14
А что, ComDlg32.ocx нельзя использовать?
Номер ответа: 2
Автор ответа:
Sharp
Лидер форума
ICQ: 216865379
Вопросов: 106
Ответов: 9979
Web-сайт:
Профиль | | #2
Добавлено: 14.12.03 05:03
Номер ответа: 3
Автор ответа:
HACKER
Разработчик Offline Client
Вопросов: 236
Ответов: 8362
Профиль | | #3
Добавлено: 14.12.03 15:24
Номер ответа: 4
Автор ответа:
Виталий51
ICQ: 224290361
Вопросов: 8
Ответов: 50
Web-сайт:
Профиль | | #4
Добавлено: 14.12.03 23:33
Номер ответа: 5
Автор ответа:
Cooller
Вопросов: 10
Ответов: 28
Профиль | | #5
Добавлено: 15.12.03 21:39