VBNet - Форум - на разные расширения разные значки

Вопрос: на разные расширения разные значки Добавлено: 17.06.05 17:55

Автор вопроса: bas | Web-сайт: www.klyaksa.net

Как ассоциировать расширение с программой нашел:

Private Const HKEY_CLASSES_ROOT = &H80000000

Private Sub AssociateMyApp(ByVal sAppName As String, _
ByVal sEXE As String, ByVal sExt As String, _
Optional ByVal sIcon As String)
Dim lRegKey As Long
Call RegCreateKey(HKEY_CLASSES_ROOT, sExt, lRegKey)
Call RegSetValueEx(lRegKey, "", 0&, 1, ByVal sAppName, Len(sAppName))
Call RegCloseKey(lRegKey)
Call RegCreateKey(HKEY_CLASSES_ROOT, sAppName & _
"\Shell\Open\Command", lRegKey)
Call RegSetValueEx(lRegKey, "", 0&, 1, ByVal sEXE, Len(sEXE))
Call RegCloseKey(lRegKey)
If Len(sIcon) Then
    Call RegCreateKey(HKEY_CLASSES_ROOT, _
    sAppName & "\DefaultIcon", lRegKey)
    Call RegSetValueEx(lRegKey, "", 0&, 1, ByVal sIcon, Len(sIcon))
    Call RegCloseKey(lRegKey)
End If
End Sub

--------------------------
m = App.Path & "\" & LCase(App.EXEName) & ".exe " & " %1"
mi1 = App.Path & "\" & "ico1.ico"
mi2 = App.Path & "\" & "ico2.ico"
'AssociateMyApp "MyTest", m, ".aaa", mi
AssociateMyApp "MyTest", m, ".bbbt", mih

Но вот проблема: можно ли для одной программы на разные расширения поставить разные значки иконок? в коде примера получается одна на все, а хочу разные
Ответить

Ответы Всего ответов: 11

Номер ответа: 1 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #1	Добавлено: 17.06.05 20:01
	Можно, скачай какой-нить редактор иконок, создай в одной несколько с разной глубиной цвета и разрешением... Ответить

Номер ответа: 2 Автор ответа: bas Вопросов: 16 Ответов: 30	Web-сайт: www.klyaksa.net Профиль \| \| #2	Добавлено: 18.06.05 00:54
	Дык, если сделать мультииконку, то это влияет только на вид иконки при разных видах(список, значки ...). А надо чтобы файлы с расширением .aaa имели иконку1 (или мультииконку1), а файлы с расширением .bbb - иконку2. И при этом открывались одной и тоже моей прогой. Ответить

Номер ответа: 3 Автор ответа: Дмитрий Щапов Вопросов: 71 Ответов: 321	Профиль \| \| #3	Добавлено: 18.06.05 03:51
	Ну чтоб открывались одной прогой - не вопрос. А насчёт это влияет только на вид иконки при разных видах - Ты проверял? незнаю,незнаю... чего-то здесь не хватает. А сомневаюсь потомучто я вже так делал. прога - в ней иконок Х, и у каждого типа файла своя иконка - и каждый доволен. Мини проба была тока с определением №иконки в файле (когда в реестре регишь). Ответить

Номер ответа: 4 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #4	Добавлено: 18.06.05 12:22
	ну значит в ресурсы exe/dll кидаешь несколько иконок, а при ассоциации указываешь app.exe,0 - для первой, app.exe,1 - для второй и т.д. Ответить

Номер ответа: 5 Автор ответа: bas Вопросов: 16 Ответов: 30	Web-сайт: www.klyaksa.net Профиль \| \| #5	Добавлено: 18.06.05 12:32
	- Ты проверял? незнаю,незнаю... чего-то здесь не хватает. Да m = App.Path & "\" & LCase(App.EXEName) & ".exe " & " %1" mi1 = App.Path & "\" & "ico1.ico" mi2 = App.Path & "\" & "ico2.ico" AssociateMyApp "MyTest", m, ".aaa", mi AssociateMyApp "MyTest", m, ".bbbt", mih иконки "ico1.ico" и "ico2.ico" - разные, файлы с расширениями ".aaa" и ".bbbt" получают одинаковую иконку. А использование мультииконки влияет только на вид в окне (таблица, список, значки, плитка) - отображаются иконки (из мультииконки)разных размеров. Ответить

Номер ответа: 6 Автор ответа: AASoft Вопросов: 86 Ответов: 920	Профиль \| \| #6	Добавлено: 19.06.05 08:37
	idiyot!!! zameni m = App.Path & "\" & LCase(App.EXEName) & ".exe " & " %1" mi1 = App.Path & "\" & "ico1.ico" mi2 = App.Path & "\" & "ico2.ico" AssociateMyApp "MyTest", m, ".aaa", [B]mi[/B] AssociateMyApp "MyTest", m, ".bbbt", [B]mih[/B] na m = App.Path & "\" & LCase(App.EXEName) & ".exe " & " %1" mi1 = App.Path & "\" & "ico1.ico" mi2 = App.Path & "\" & "ico2.ico" AssociateMyApp "MyTest", m, ".aaa", [B]mi1 [/B] AssociateMyApp "MyTest", m, ".bbbt", [B]mi2[/B] Ответить

Номер ответа: 7 Автор ответа: AASoft Вопросов: 86 Ответов: 920	Профиль \| \| #7	Добавлено: 19.06.05 08:38
	i uberi Ответить

Номер ответа: 8 Автор ответа: AASoft Вопросов: 86 Ответов: 920	Профиль \| \| #8	Добавлено: 19.06.05 08:38
	[ B] i [ /B] uberi Ответить

Номер ответа: 9 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #9	Добавлено: 19.06.05 11:01
	тама это не i это единичка )) Ответить

Номер ответа: 10 Автор ответа: bas Вопросов: 16 Ответов: 30	Web-сайт: www.klyaksa.net Профиль \| \| #10	Добавлено: 19.06.05 12:06
	Сорри, не совсем идиот. Это забыл исправить код, когда в формум кидал - у меня имена другие были, а для форума исправил. так что код: m = App.Path & "\" & LCase(App.EXEName) & ".exe " & " %1" m1 = App.Path & "\" & "ico1.ico" m2 = App.Path & "\" & "ico2.ico" AssociateMyApp "MyTest", m, ".aaa", m1 AssociateMyApp "MyTest", m, ".bbb", m2 неработает! все файлы получают последнюю иконку. Ответить

Номер ответа: 11 Автор ответа: sne Разработчик Offline Client ICQ: 233286456 Вопросов: 34 Ответов: 5445	Web-сайт: hw.t-k.ru Профиль \| \| #11	Добавлено: 19.06.05 13:16
	короче, будем проще: модуль реестра: Option Explicit '******************************************************************** '* Написано 26.02.2004 году (Team HomeWork) * '* e-mail: sne_pro@mail.ru * '****************************************************************** ' Для асоциации с файлами '****************************************************************** Public Const HKEY_CLASSES_ROOT As Long = &H80000000 Private Const REG_SZ As Long = &H1 Private Const KEY_READ As Long = ((&H20000 Or &H1 Or &H8 Or &H10) And (Not &H100000)) Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long 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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal szData As String, ByRef lpcbData As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Public Function RegGetValue(Root As Long, SubKey As String, Key As String) As String Dim Buffer As String, hKey As Long, nType As Long, nSize As Long Call RegOpenKeyEx(Root, SubKey, 0, KEY_READ, hKey) Call RegQueryValueEx(hKey, Key, 0, nType, Buffer, nSize) If hKey And nSize > 0 And nType = REG_SZ Then Buffer = Space(nSize + 1) Call RegQueryValueEx(hKey, Key, 0, nType, Buffer, nSize) RegGetValue = Left(Buffer, nSize - 1) End If Call RegCloseKey(hKey) End Function Public Function RegSetValue(ByVal hKey As Long, _ ByVal strSubKey As String, _ ByVal strKey As String, _ ByVal strValue As String) As Long Call RegCreateKey(hKey, strSubKey, RegSetValue) Call RegSetValueEx(RegSetValue, strKey, 0&, 1&, ByVal strValue & vbNullChar, Len(strValue) + 1& Call RegCloseKey(RegSetValue) End Function Public Function RegDelKey(ByVal hKey As Long, ByVal strKey As String) Call RegDeleteKey(hKey, strKey) End Function Public Function RegDelValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String) Dim keyhand As Long Call RegOpenKey(hKey, strPath, keyhand) Call RegDeleteValue(keyhand, strValue) Call RegCloseKey(keyhand) End Function Функции для ассоциирования: ' §§§§§§§§§§§§§§§§§§§§§§§§§§ Асоциирование с файлом §§§§§§§§§§§§§§§§§§§§§§§§§§ 'Ассоциация файлов с программой Public Sub Associate(ByVal sType As String, ByVal sKey As String, ByVal sDescr As String, _ ByVal iIcon As Integer, ByVal sPrompt As String) Call RegSetValue(HKEY_CLASSES_ROOT, sKey, vbNullString, sDescr) If Len(sPrompt) Then Call RegSetValue(HKEY_CLASSES_ROOT, sKey & "\shell\open\command", vbNullString, sPrompt & " %1" Call RegSetValue(HKEY_CLASSES_ROOT, sKey & "\DefaultIcon", vbNullString, App.Path & "\" & LCase(App.EXEName) & ".exe," & CStr(iIcon)) Call RegSetValue(HKEY_CLASSES_ROOT, sType, vbNullString, sKey) End Sub Public Function DeAssociate(sType As String) As String eAssociate = RegGetValue(HKEY_CLASSES_ROOT, sType, vbNullString) Call RegDelKey(HKEY_CLASSES_ROOT, DeAssociate & "\shell\open\command" Call RegDelKey(HKEY_CLASSES_ROOT, DeAssociate & "\shell\open" Call RegDelKey(HKEY_CLASSES_ROOT, DeAssociate & "\shell" Call RegDelKey(HKEY_CLASSES_ROOT, DeAssociate) Call RegDelKey(HKEY_CLASSES_ROOT, sType) End Function Public Function IsAssociate(sType As String, sKey As String) As Boolean IsAssociate = (RegGetValue(HKEY_CLASSES_ROOT, sType, "" = sKey) End Function работает точно! Ответить

Страница: 1 |