COLOCAR UMA ICONE DE ACORDO COM SUA EXTENSAO?

USUARIO.EXCLUIDOS 28/09/2004 15:08:04
#43778 Resposta escolhida

Option Explicit

Private Declare Function RegCreateKey Lib "advapi32.dll" _
Alias "RegCreateKeyA" (ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long

Private Declare Function RegSetValue Lib "advapi32.dll" _
Alias "RegSetValueA" (ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal dwType As Long, _
ByVal lpData As String, _
ByVal cbData As Long) As Long

' Return codes from Registration functions.
Const ERROR_SUCCESS = 0&
Const ERROR_BADDB = 1&
Const ERROR_BADKEY = 2&
Const ERROR_CANTOPEN = 3&
Const ERROR_CANTREAD = 4&
Const ERROR_CANTWRITE = 5&
Const ERROR_OUTOFMEMORY = 6&
Const ERROR_INVALID_PARAMETER = 7&
Const ERROR_ACCESS_DENIED = 8&

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const MAX_PATH = 260&
Private Const REG_SZ = 1

Private Declare Sub SHChangeNotify Lib "shell32.dll" _
(ByVal wEventId As Long, _
ByVal uFlags As Long, _
dwItem1 As Any, _
dwItem2 As Any)

Const SHCNE_ASSOCCHANGED = &H8000000
Const SHCNF_IDLIST = &H0&

Private Sub Form_Click()
Dim sKeyName As String ' Holds Key Name in registry.
Dim sKeyValue As String ' Holds Key Value in registry.
Dim ret& ' Holds error status if any from API calls.
Dim lphKey& ' Holds key handle from RegCreateKey.
Dim path As String

path = App.path
If Right(path, 1) <> "\" Then
path = path & "\"
End If

' This creates a Root entry called "MyApp".
sKeyName = "MyApp"
sKeyValue = "My Application"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)

' This creates a Root entry called .BAR associated with "MyApp".
sKeyName = ".BAR"
sKeyValue = "MyApp"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)

' This sets the command line for "MyApp".
sKeyName = "MyApp"
sKeyValue = path & "MyApp.exe %1"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "shell\open\command", REG_SZ, _
sKeyValue, MAX_PATH)

' This sets the icon for the file extension
sKeyName = "MyApp"
sKeyValue = path & "myIcon.ico"
ret& = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey&)
ret& = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, _
sKeyValue, MAX_PATH)

' This notifies the shell that the icon has changed
SHChangeNotify SHCNE_ASSOCCHANGED, SHCNF_IDLIST, 0, 0

End Sub

Private Sub Form_Load()
' When the file is double clicked the name is stored in Command()

RichTextBox1.LoadFile Command()
End Sub