Замена иконки формы

По материалам: http://www.mvps.org   

Не существует прямого способа заменить иконку, но можно это сделать, загружая ICO файл в память и назначая значок на форму (посылаем WM_SETICON сообщение окну).

В форме на событие "Загрузка" вешаем нечто подобное:  

Private Sub Form_Load()

Dim b As Boolean

Dim sIconFilePath As String

sIconFilePath = "d:\Temp\Application002.ico"

b = SetFormIcon(Me.hWnd, sIconFilePath)

If b = False Then Debug.Print "Установить иконку: " & sIconFilePath & " - установить не удалось :("

End Sub

Модуль:

Option Compare Database

Option Explicit

'--------------------------------------------------------------------

' Module : modFormsChangeIcon

' Author : Code courtesy of Klaus H. Probst

' Date : ??.??.2001

' Purpose : Замена иконки формы

'--------------------------------------------------------------------

'

'// Place all this in a module

Public Declare Function LoadImage Lib "user32" Alias "LoadImageA" _

(ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, _

ByVal n2 As Long, ByVal un2 As Long) As Long

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _

(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, LParam As Any) As Long

Public Const WM_GETICON = &H7F

Public Const WM_SETICON = &H80

Public Const ICON_SMALL = 0

Public Const ICON_BIG = 1

'// LoadImage() image types

Public Const IMAGE_BITMAP = 0

Public Const IMAGE_ICON = 1

Public Const IMAGE_CURSOR = 2

Public Const IMAGE_ENHMETAFILE = 3

'// LoadImage() flags

Public Const LR_DEFAULTCOLOR = &H0

Public Const LR_MONOCHROME = &H1

Public Const LR_COLOR = &H2

Public Const LR_COPYRETURNORG = &H4

Public Const LR_COPYDELETEORG = &H8

Public Const LR_LOADFROMFILE = &H10

Public Const LR_LOADTRANSPARENT = &H20

Public Const LR_DEFAULTSIZE = &H40

Public Const LR_LOADMAP3DCOLORS = &H1000

Public Const LR_CREATEDIBHeader = &H2000

Public Const LR_COPYFROMRESOURCE = &H4000

Public Const LR_SHARED = &H8000

Public Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean

Dim hIcon As Long

'--------------------------------------------------------------------

On Error GoTo SetFormIcon_Err

hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)

'// wParam = 0; Setting small icon. wParam = 1; setting large icon

If hIcon <> 0 Then

Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon)

SetFormIcon = True

End If

SetFormIcon_Bye:

Exit Function

SetFormIcon_Err:

MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _

"in procedure SetFormIcon", vbCritical, "Error!"

Resume SetFormIcon_Bye

End Function