編程思路:按一定格式在文件夾中建立Desktop.ini文件並將文件夾的屬性設置為系統屬性即可自定義文件夾的圖標。文件的建立不難,關鍵是更改文件夾屬性,得用上VB的內部函數Attributes來實現。
Desktop.ini文件格式:
[.ShellClassInfo]
IconIndex=0
iconfile=Icon圖標所在的驅動器我 路徑名 文件名
下面是完整的程序代碼。使用前請給工程添加一個按鈕、一個公共對話框、一個DriveListBox和一個DirListBox。
OptionExplicit
DimsPathAsString'文件夾變量
PrivateSubDir1_Click()
DimiAsInteger
Command1.Enabled=True
i=Dir1.ListIndex
sPath=Dir1.List(i)
EndSub
PrivateSubDrive1_Change()
Dir1.Path=Drive1.Drive
EndSub
PrivateSubForm_Load()
Command1.Caption="定義文件夾圖標"
Command1.Enabled=False
EndSub
PrivateSubCommand1_Click()
ChangeFolderInfosPath'更改目錄為系統文件
DimsAsString'圖標文件路徑、名稱變量
WithCommonDialog1
.Filter="(*.ico)|*.ico"
.DialogTitle="查找圖標"
.ShowOpen
s=.FileName
EndWith
OpensPath "" "desktop.ini"ForOutputAs#1
Print#1,"[.ShellClassInfo]" vbCrLf "IconIndex=0" vbCrLf "iconfile=" s
Close#1
ChangeFileInfo(sPath "" "desktop.ini")
EndSub
'賦予文件夾系統屬性子程序
PrivateSubChangeFolderInfo(folderspec)
Dimfs,f
Setfs=CreateObject("Scripting.FileSystemObject")
Setf=fs.GetFolder(folderspec)
f.Attributes=4'用Attributes函數設置文件夾屬性
EndSub
'賦予Desktop.ini文件隱藏屬性
PrivateSubChangeFileInfo(filespec)
Dimfs,f
Setfs=CreateObject("Scripting.FileSystemObject")
Setf=fs.GetFile(filespec)
f.Attributes=2'用Attributes屬性設置文件屬性
EndSub
運行程序,打開"我的電腦"找到更改了圖標的文件夾看看,效果如何?->