?? modbrowse.bas
字號:
Attribute VB_Name = "modBrowse"
Option Explicit
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Type SHITEMID
cb As Long
abID As Byte
End Type
Private Type ITEMIDLIST 'idl
mkid As SHITEMID
End Type
'========================================================
'使用此函數可以出現一個對話框,
'并返回所選擇的路徑,若沒有選擇返回("")。
Function FPath$(nhWnd&, Title$)
Dim bi As BROWSEINFO
Dim idl As ITEMIDLIST
Dim rtn&, pidl&, path$, pos%
bi.hOwner = nhWnd&
bi.pidlRoot = idl.mkid.cb
bi.lpszTitle = Title$
bi.ulFlags = &H1
pidl& = SHBrowseForFolder(bi)
path$ = Space$(512)
rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
pos% = InStr(path$, Chr$(0))
''
FPath$ = Left(path$, pos - 1)
End Function
'========================================================
'========================================================
' 獲取系統所有的根目錄,并添加到下拉列表中。
Sub GetAllDrives(cImageCombo As ImageCombo)
Dim LastItem As Integer
Dim Drv As String, lResult As Long
Dim DrvLetter As String, sBuffer As String
Dim DrvType As Long
Drv = String$(128, 0)
lResult = GetLogicalDriveStrings(1024, Drv)
Do While Left$(Drv, 1) <> Chr$(0)
DrvLetter = UCase$(Left$(Drv, 3))
Drv = Mid$(Drv, 5)
DrvType = GetDriveType(DrvLetter)
Select Case DrvType
Case DRIVE_REMOVABLE
If DrvLetter = "A:\" Then
cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "35floppy"
ElseIf DrvLetter = "B:\" Then
cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "525floppy"
Else
cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "dirve2"
End If
Case DRIVE_FIXED
cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "drive1"
Case DRIVE_REMOTE
sBuffer = String$(255, 0)
lResult = WNetGetConnection(Left$(DrvLetter, 2), sBuffer, Len(sBuffer))
If lResult = 0 Then
cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "dirvenet"
End If
Case DRIVE_CDROM
cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "cddrive"
Case DRIVE_RAMDISK
cImageCombo.ComboItems.Add , , Left(DrvLetter, 2), "dirve1"
End Select
Loop
End Sub
'========================================================
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -