Изменение иконки у формы Ms Access

Данный пример показывает как изменить стандартную иконку формы на свою иконку (ico) или бмпешку (bmp)

Public Declare Function SendMessage Lib "user32" _
      Alias "SendMessageA" _
      (ByVal hwnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, _
       ByVal lParam As Long) As Long

Public Declare Function DestroyIcon Lib "user32" _
      (ByVal hIcon As Long) As Long

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

Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

Public Const WM_SETICON = &H80
Public Const ICON_SMALL = 0
Public Const IMAGE_ICON = 1
Public Const LR_LOADFROMFILE = &H10

Private Sub Form_Open(Cancel As Integer)
 SendMessage Me.hwnd, WM_SETICON, ICON_SMALL, _
  LoadImage(0, "C:\TEST.ICO", IMAGE_ICON, 0, 0, LR_LOADFROMFILE)
End Sub

Private Sub Form_Close()
 Dim hIcon As Long
 hIcon = SendMessage(hwnd, WM_SETICON, ICON_SMALL, 0)
 If hIcon <> 0 Then DestroyIcon hIcon
End Sub

Ниже приведен пример модуля формы, который устанавливает в заголовок 16-тицветную бмпешку размером 16х16 точек. Прозрачным цветом в исходном bmp-файле считается белый.

Option Compare Database
Option Explicit

Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0
Private Const IMAGE_BITMAP = 0
Private Const LR_LOADFROMFILE = &H10

Private Type ICONINFO
 fIcon As Long
 xHotspot As Long
 yHotspot As Long
 hbmMask As Long
 hbmColor As Long
End Type

Private Declare Function CreateCompatibleDC Lib "gdi32" _
 (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" _
 (ByVal hdc As Long) As Long
Private Declare Function SelectObject Lib "gdi32" _
 (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" _
 (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" _
 (ByVal nWidth As Long, ByVal nHeight As Long, _
  ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function CreateIconIndirect Lib "user32" _
 (piconinfo As ICONINFO) As Long
Private Declare Function DestroyIcon Lib "user32" _
 (ByVal hIcon As Long) As Long
Private 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
Private Declare Function GetPixel Lib "gdi32" _
 (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" _
 (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
  ByVal crColor As Long) As Long
Private Declare Function SendMessage Lib "user32" _
      Alias "SendMessageA" _
      (ByVal hwnd As Long, _
       ByVal wMsg As Long, _
       ByVal wParam As Long, _
       ByVal lParam As Long) As Long

Private Sub Form_Close()
 Dim hIcon As Long
 hIcon = SendMessage(hwnd, WM_SETICON, ICON_SMALL, 0)
 If hIcon <> 0 Then DestroyIcon hIcon
End Sub

Private Sub Form_Open(Cancel As Integer)
 Dim hIcon As Long, ii As ICONINFO
 Dim hBmpMask As Long, hBmpColor As Long, ob As Long, ob1 As Long
 Dim hDCMask As Long, hDCColor As Long
 Dim x As Long, y As Long
 hDCColor = CreateCompatibleDC(0)
 hDCMask = CreateCompatibleDC(0)
 ' файл test.bmp - 16-тицветная картинка размером 16х16
 hBmpColor = LoadImage(0, "c:\test.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)
 hBmpMask = CreateBitmap(16, 16, 1, 1, 0)
 ob = SelectObject(hDCColor, hBmpColor)
 ob1 = SelectObject(hDCMask, hBmpMask)
 ' делаем маску
 For y = 0 To 15: For x = 0 To 15
  If GetPixel(hDCColor, x, y) = &HFFFFFF Then
   SetPixel hDCColor, x, y, 0: SetPixel hDCMask, x, y, &HFFFFFF
  Else
   SetPixel hDCMask, x, y, 0
  End If
 Next: Next
 ii.hbmColor = SelectObject(hDCColor, ob)
 ii.hbmMask = SelectObject(hDCMask, ob1)
 ii.fIcon = 1
 ii.xHotspot = 8: ii.yHotspot = 8
 hIcon = CreateIconIndirect(ii)
 SendMessage hwnd, WM_SETICON, ICON_SMALL, hIcon
 DeleteObject hBmpColor
 DeleteObject hBmpMask
 DeleteDC hDCColor
 DeleteDC hDCMask
End Sub