求带有新建功能的目录浏览对话框代码,急用,谢谢

2003-12-12 11:06:57 127 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

leaxin 墨衍会员 · AI 创作全网分发关注 + 加入社区

戴尔PowerEdge服务器R450 RAID配置步骤戴尔PowerEdge服务器R450 RAID配置步骤阅读详情

找了很久没找到,请各位帮帮忙

...全文

AI 辅助代码审查：开启代码质量管控的智能时代 AI辅助代码审查正在改变传统的代码质量管控方式。通过自动化分析、智能反馈和上下文感知，AI不仅提高了代码审查的效率，还提升了代码质量的一致性和可维护性。随着机器学习和深度学习技术的不断发展，未来AI将成为开发者日常工作中强大的助手，进一步推动软件开发向智能化、自动化方向发展。阅读详情

leaxin

VB基础类 7,788 成员 197,583 内容

+ 关注 + 加入社区

切换为时间正序

liyd1978 2003-12-12

打赏
举报

Option Explicit
Option Base 1

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 SelectFile() As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String

OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = frmRegisterSelectFile.hWnd
OpenFile.lpstrTitle = "オープンファイル"
OpenFile.hInstance = App.hInstance
sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = App.Path
OpenFile.lpstrTitle = "選択ファイル"
OpenFile.Flags = 0
lReturn = GetOpenFileName(OpenFile)

If lReturn = 0 Then
'MsgBox "操作を取り消し"
'OpenFileClass = "0"
Else
SelectFile = Trim(OpenFile.lpstrFile)
End If

End Function

TechnoFantasy 2003-12-12

打赏
举报

调用：
BrowseForFolder Me.hWnd, "GGG", "c:\windows", BIF_NEWDIALOGSTYLE

只要加上BIF_NEWDIALOGSTYLE标记就可以实现创建新文件夹了。

TechnoFantasy 2003-12-12

打赏
举报

Module:

Option Explicit

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 DialogStyle
BIF_BROWSEFORCOMPUTER = &H1000
BIF_BROWSEFORPRINTER = &H2000
BIF_BROWSEINCLUDEFILES = &H4000
BIF_DONTGOBELOWDOMAIN = &H2
BIF_EDITBOX = &H10
BIF_NEWDIALOGSTYLE = &H40
BIF_RETURNFSANCESTORS = &H8
BIF_RETURNONLYFSDIRS = &H1
BIF_STATUSTEXT = &H4
BIF_USENEWUI = (BIF_NEWDIALOGSTYLE Or BIF_EDITBOX)
End Enum

Private Const MAX_PATH = 260

Private Type SHITEMID
cb As Long
abID As Byte
End Type

Private Type ITEMIDLIST
mkid As SHITEMID
End Type

Private Const WM_USER = &H400
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_SETSTATUSTEXT = (WM_USER + 100)
Private Const BFFM_SETSELECTION = (WM_USER + 102)

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long

Global m_sCurrentDirectory As String

Public Function BrowseForFolder(ByVal OwnerHwnd As Long, ByVal Title As String, Optional StartDir As String = "", Optional DStyle As DialogStyle = BIF_RETURNONLYFSDIRS + BIF_STATUSTEXT) As String
Dim lpIDList As Long
Dim szTitle As String
Dim sBuffer As String
Dim tBrowseInfo As BrowseInfo

If StartDir = "" Then StartDir = App.Path

m_sCurrentDirectory = StartDir & vbNullChar
BrowseForFolder = ""

szTitle = Title
With tBrowseInfo
.hWndOwner = OwnerHwnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = DStyle
.lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc) 'get address of function.
End With

lpIDList = SHBrowseForFolder(tBrowseInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
BrowseForFolder = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
End If
End Function

Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long

Dim lpIDList As Long
Dim ret As Long
Dim sBuffer As String

On Error Resume Next

Select Case uMsg
Case BFFM_INITIALIZED
Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_sCurrentDirectory)

Case BFFM_SELCHANGED
sBuffer = Space(MAX_PATH)

ret = SHGetPathFromIDList(lp, sBuffer)
If ret = 1 Then Call SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, sBuffer)
End Select

BrowseCallbackProc = 0

End Function

Private Function GetAddressofFunction(add As Long) As Long
GetAddressofFunction = add
End Function

leaxin 2003-12-12

打赏
举报

是什么函数,在哪里可以找得到?

leaxin 2003-12-12

打赏
举报

BrowseForFolder

hisofty 2003-12-12

打赏
举报

BrowseForFolder函数，看看他的参数，其中有一个，不难的

求带有新建功能的目录浏览对话框代码,急用,谢谢

相关推荐