|
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "Change Folder Icon"
ClientHeight = 2265
ClientLeft = 45
ClientTop = 435
ClientWidth = 7365
BeginProperty Font
Name = "Microsoft Sans Serif"
Size = 12
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 2265
ScaleWidth = 7365
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton cmdExit
Cancel = -1 'True
Caption = "E&xit"
Height = 495
Left = 4680
TabIndex = 6
ToolTipText = "Quit"
Top = 1440
Width = 1215
End
Begin VB.CommandButton cmdReset
Caption = "&Reset"
Height = 495
Left = 2700
TabIndex = 5
ToolTipText = "Restore default icon"
Top = 1440
Width = 1215
End
Begin VB.CommandButton cmdSetIcon
Caption = "&OK"
Default = -1 'True
Height = 495
Left = 720
TabIndex = 4
ToolTipText = "Change folder icon"
Top = 1440
Width = 1215
End
Begin MSComDlg.CommonDialog cDlg
Left = 6840
Top = 2520
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton cmdIcon
Caption = ". . ."
BeginProperty Font
Name = "Arial Black"
Size = 11.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6480
TabIndex = 3
ToolTipText = "Browse for Icon"
Top = 840
Width = 615
End
Begin VB.CommandButton cmdFolder
Caption = ". . ."
BeginProperty Font
Name = "Arial Black"
Size = 11.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 6480
TabIndex = 2
ToolTipText = "Browse for Folder"
Top = 240
Width = 615
End
Begin VB.TextBox txtIcon
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 240
Locked = -1 'True
TabIndex = 1
Top = 840
Width = 6135
End
Begin VB.TextBox txtFolder
Alignment = 2 'Center
BackColor = &H00E0E0E0&
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 240
Locked = -1 'True
TabIndex = 0
Top = 240
Width = 6135
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Written : April 25, 2003 by Dipankar Basu
' Web URL : http://www.geocities.com/basudip_in/download/
' Copyright (c)2003-04 All Rights Reserved by Dipankar Basu
Option Explicit
Private Sub cmdFolder_Click()
Dim sFolderName As String
sFolderName = BrowseFolder(Me.hWnd, "Change Icon for the Folder")
If StrPtr(sFolderName) = 0 Or Trim(sFolderName) = vbNullString Then Exit Sub
If UCase(Right(sFolderName, 8)) = "RECYCLED" _
Or UCase(Right(sFolderName, 7)) = "DESKTOP" _
Or Len(sFolderName) <= 3 Then
Call MsgBox("Cannot change icon for this folder" & vbCrLf & sFolderName, vbCritical, App.Title)
Exit Sub
ElseIf CheckIfFolderIsSystem(sFolderName) = True Then
Call MsgBox("Cannot change icon or properties of system folders" & vbCrLf & sFolderName, vbCritical, App.Title)
Exit Sub
End If
txtFolder.Text = sFolderName
End Sub
Private Sub cmdIcon_Click()
Dim ComDlgDir As String
On Error GoTo eh:
ComDlgDir = GetSetting(Appname:="BasuDip_App", Section:="Folder_Icon", _
Key:="InitIconDir", Default:="C:\")
With cDlg
.CancelError = True
.DialogTitle = "Select Icon File"
.Filter = "Icon Files|*.ico"
.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly Or cdlOFNNoChangeDir
.InitDir = ComDlgDir
.ShowOpen
txtIcon.Text = .FileName
SaveSetting Appname:="BasuDip_App", Section:="Folder_Icon", _
Key:="InitIconDir", Setting:=Left(.FileName, Len(.FileName) - Len(.FileTitle))
End With
Exit Sub
eh:
If Err.Number = 32755 Then
txtIcon.Text = vbNullString
Else
MsgBox Err.Source & " reports " & Err.Description, _
vbCritical + vbOKOnly, "Error : " & Err.Number
End If
End Sub
Private Sub cmdReset_Click()
On Error GoTo eh:
Dim FolderName As String, varTemp As String
FolderName = BrowseFolder(Me.hWnd, "Restore default icon for the folder")
If StrPtr(FolderName) = 0 Or Trim(FolderName) = vbNullString Then Exit Sub
varTemp = Trim(ReadINI(".ShellClassInfo", "IconFile", FolderName & "\Desktop.ini"))
If varTemp = vbNullString Then
Call MsgBox("The icon for the folder is either the default icon or the icon has been changed with an external application that cannot be changed" & _
vbCrLf & FolderName, vbInformation, App.Title)
Else
Call WriteINI(".ShellClassInfo", "IconFile", vbNullString, FolderName & "\Desktop.ini")
Call WriteINI(".ShellClassInfo", "IconIndex", vbNullString, FolderName & "\Desktop.ini")
Call MsgBox("Default folder icon Restored" & vbCrLf & FolderName, vbInformation, App.Title)
End If
Exit Sub
eh:
Call MsgBox(Err.Source & " reports " & Err.Description, vbCritical, "Error: " & Err.Number)
End Sub
Private Sub cmdSetIcon_Click()
On Error GoTo eh:
Dim IconFile As String, FolderName As String, sFilePath As String
sFilePath = IIf(Right(App.Path, 1) = "\", App.Path, App.Path & "\")
IconFile = Trim(txtIcon.Text): FolderName = Trim(txtFolder.Text)
If bFileExists(IconFile) Then
If IsFolderExists(FolderName) Then
Call WriteINI(".ShellClassInfo", "IconFile", IconFile, FolderName & "\Desktop.ini")
Call WriteINI(".ShellClassInfo", "IconIndex", "0", FolderName & "\Desktop.ini")
Call FileAttribHide(FolderName & "\Desktop.ini")
Call setFolderRead(FolderName)
Call MsgBox("The icon for the folder " & vbCrLf & FolderName & " is changed." & vbCrLf _
& vbCrLf & "Folder icon is " & IconFile, vbInformation, "Folder Icon changed")
txtIcon.Text = vbNullString: txtFolder.Text = vbNullString
Exit Sub
Else
Call cmdFolder_Click
End If
Else
Call cmdIcon_Click
End If
Exit Sub
eh:
Call MsgBox("An error has occured " & Err.Source & vbCrLf & Err.Description, vbCritical, "Error: " & Err.Number)
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Icon = LoadResPicture(106, vbResIcon)
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub
|
