VBNet - Форум - заменяем иконку

Вопрос: заменяем иконку Добавлено: 01.06.09 16:42

Автор вопроса: gekko | Web-сайт: kalamfur.ru

Добрый вечер.

Вопрос по работе с ресурсами.. пару таких видел на форуме но конкретно к своему ответа не нашел.

Интересует: как сменить иконку одной программы на другую?

Т.е. в папке есть две проги: 1.exe и 2.exe
Как поменять иконку одного приложения (1.exe)
на иконку второго?

Вот код, который добавляет иконку в exe и прописывает её.

Private Declare Function BeginUpdateResource Lib "kernel32" Alias "BeginUpdateResourceA" (ByVal pFileName As String, ByVal bDeleteExistingResources As Boolean) As Long
Private Declare Function UpdateResource Lib "kernel32" Alias "UpdateResourceA" (ByVal hUpdate As Long, ByVal lpType As Long, ByVal lpName As Long, ByVal wLanguage As Long, lpData As Any, ByVal cbData As Long) As Long
Private Declare Function EndUpdateResource Lib "kernel32" Alias "EndUpdateResourceA" (ByVal hUpdate As Long, ByVal fDiscard As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Const RT_ICON = 3&
Private Const RT_GROUP_ICON = 14

Private Type CursorOrIcon
    Reserved As Integer
    wType As Integer
    Count As Integer
End Type

Private Type ICONDIRENTRY
   bWidth As Byte
   bHeight As Byte
   bColorCount As Byte
   bReserved As Byte
   wPlanes As Integer
   wBitCount As Integer
   dwBytesInRes As Long
   dwImageOffset As Long
End Type

Private Type MEMICONDIRENTRY
   bWidth As Byte
   bHeight As Byte
   bColorCount As Byte
   bReserved As Byte
   wPlanes As Integer
   wBitCount As Integer
   dwBytesInRes As Long
   nID As Integer
End Type

Private Type BITMAPINFOHEADER '40 bytes
    a_Size As Long '=40
    b_Width As Long
    b_Height As Long
    c_Planes As Integer
    d_BitCount As Integer
    e_Compression As Long
    f_SizeImage As Long
    g_XPelsPerMeter As Long
    g_YPelsPerMeter As Long
    h_ClrUsed As Long
    i_ClrImportant As Long
End Type

Dim ICO As CursorOrIcon
Dim Bitm As BITMAPINFOHEADER
Dim IconR() As ICONDIRENTRY
Dim IconE() As MEMICONDIRENTRY
Dim Pic() As Byte
Dim mas() As Byte

Private Sub ReplaceIcon(sFileName As String, sIconName As String)
    Dim h As Long
    Dim FileName As String
    FileName = sFileName

    h = BeginUpdateResource(FileName, False)

    Open sIconName For Binary As #1
    Get #1, , ICO

    ReDim IconE(ICO.Count)
    ReDim IconR(ICO.Count)
    For i = 0 To ICO.Count - 1
        Get #1, , IconR(i)
        IconE(i).bColorCount = IconR(i).bColorCount
        IconE(i).bHeight = IconR(i).bHeight
        IconE(i).bReserved = IconR(i).bReserved
        IconE(i).bWidth = IconR(i).bWidth
        IconE(i).dwBytesInRes = IconR(i).dwBytesInRes
        IconE(i).wBitCount = IconR(i).wBitCount
        IconE(i).wPlanes = IconR(i).wPlanes
        IconE(i).nID = i + 1
    Next i

    For i = 0 To ICO.Count - 1
        Get #1, IconR(i).dwImageOffset + 1, Bitm
        ReDim Pic(IconR(i).dwBytesInRes)
        Get #1, , Pic
        ReDim mas(IconR(i).dwBytesInRes + Len(Bitm))
        CopyMemory mas(0), Bitm, Len(Bitm)
        CopyMemory mas(Len(Bitm)), Pic(0), IconR(i).dwBytesInRes
        Call UpdateResource(h, ByVal RT_ICON, i + 1, 0, mas(0), IconR(i).dwBytesInRes + Len(Bitm))   '1252 - ÿçûê
    Next i
    ReDim mas(Len(ICO) + Len(IconE(1)) * ICO.Count)
    CopyMemory mas(0), ICO, Len(ICO)
    For i = 0 To ICO.Count - 1
        offset = Len(ICO) + Len(IconE(1)) * i
        CopyMemory mas(offset), IconE(i), Len(IconE(i))
    Next i
    Call UpdateResource(h, ByVal RT_GROUP_ICON, 1, 0, mas(0), Len(ICO) + Len(IconE(1)) * ICO.Count)

    Call EndUpdateResource(h, 0)
    Close #1
End Sub

Private Sub Command1_Click()
    ReplaceIcon "c:\1.exe", "c:\1.ico"
End Sub

Но увы, у меня так и не получилось смены не из ico, а из exe.

Подскажите, как?
Ответить

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

Номер ответа: 1 Автор ответа: Василий Вопросов: 3 Ответов: 8	Профиль \| \| #1	Добавлено: 01.06.09 18:35
	я проверил. у меня всё работает!! Ответить

Номер ответа: 2 Автор ответа: VβÐUηìt Вопросов: 246 Ответов: 3333	Web-сайт: смекаешь.рф Профиль \| \| #2	Добавлено: 01.06.09 19:57
	Вася прав, видимо ты как-то неправильно используешь. Ответить

Номер ответа: 3 Автор ответа: gekko Вопросов: 39 Ответов: 127	Web-сайт: kalamfur.ru Профиль \| \| #3	Добавлено: 02.06.09 07:27
	Конечно Вася прав! У меня этот код тоже чудненько пашет. Но тут иконка из файла 1.ico дописывается в 1.exe а мне нужно из 1.exe в 2.exe, минуя создание ico файла. Т.е. Взять из одной проги иконку и прописать эту иконку в другую прогу. Ответить

Номер ответа: 4 Автор ответа: Василий Вопросов: 3 Ответов: 8	Профиль \| \| #4	Добавлено: 03.06.09 18:56
	http://vladikcomper.narod.ru/vb6/samples/vsvb_IconExplorer.zip Ответить

Номер ответа: 5 Автор ответа: gekko Вопросов: 39 Ответов: 127	Web-сайт: kalamfur.ru Профиль \| \| #5	Добавлено: 04.06.09 08:31
	Василий, спасибо, совсем не то. Т.Е. вывод иконки в пикчер есть в примерах, на этом сайте. Мне нужно сменить иконку одной программы на иконку другой программы. -------------- По-моему это должно работать так: Программа открывает exe'шник и извлекает из него во временный файл иконку. затем пользуется приведенный выше код. Проблема с извлечением иконки из exe в ico Ну и было бы совсем круто, если можно обойтись без временного ico файла Ответить

Страница: 1 |