ACCESS更改系統(tǒng)和窗體的圖標(biāo)

背景：
    1.在MDB文件的相同文件夾下放上一個(gè)圖片文件,假定文件名為ico.ico。
    2.有一個(gè)窗體frmOpen，并設(shè)為啟動(dòng)窗體。
    在窗體frmOpen的打開事件中寫代碼：
    Private Sub Form_Open(Cancel As Integer)
    '更改窗體圖標(biāo)
     SetFormIcon Me.hWnd, CurrentProject.Path & "\ico.ico"
     '更改系統(tǒng)標(biāo)題及圖標(biāo)
     Dim intX As Integer
     Const DB_Text As Long = 10
     intX = AddAppProperty("AppTitle", DB_Text, "XXX系統(tǒng)")
     intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\ico.ico")
     Application.RefreshTitleBar
    End Sub
    在模塊中寫代碼：
    Option Explicit
    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 SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, _
     ByVal wMsg As Long, ByVal wparam As Long, lparam As Any) As Long
    Const WM_GETICON = &H7F
    Const WM_SETICON = &H80
    Const ICON_SMALL = 0
    Const ICON_BIG = 1
    Const IMAGE_BITMAP = 0
    Const IMAGE_ICON = 1
    Const IMAGE_CURSOR = 2
    Const IMAGE_ENHMETAFILE = 3
    Const LR_DEFAULTCOLOR = &H0
    Const LR_MONOCHROME = &H1
    Const LR_COLOR = &H2
    Const LR_COPYRETURNORG = &H4
    Const LR_COPYDeleteORG = &H8
    Const LR_LOADFROMFILE = &H10
    Const LR_LOADTRANSPARENT = &H20
    Const LR_DEFAULTSIZE = &H40
    Const LR_LOADMAP3DCOLORS = &H1000
    Const LR_CreateDIBHeader = &H2000
    Const LR_COPYFROMRESOURCE = &H4000
    Const LR_SHARED = &H8000
    Function SetFormIcon(hWnd As Long, IconPath As String) As Boolean
     On Error GoTo Exit_err
     Dim hIcon As Long
     If Dir(IconPath) = "" Then Exit Function
     hIcon = LoadImage(0&, IconPath, IMAGE_ICON, 16, 16, LR_LOADFROMFILE)
     If hIcon <> 0 Then
     Call SendMessage(hWnd, WM_SETICON, 0, ByVal hIcon)
     SetFormIcon = True
     Else
     End
     End If
    Exit_err:
     Exit Function
    End Function
    Function AddAppProperty(strName As String, varType As Variant, varvalue As Variant) As Integer
     Dim dbs As Object, prp As Variant
     Const conPropNotFoundError = 3270
     Set dbs = CurrentDb
     On Error GoTo AddProp_Err
     dbs.Properties(strName) = varvalue
     AddAppProperty = True
    AddProp_Bye:
     Exit Function
    AddProp_Err:
     If ERR = conPropNotFoundError Then
     Set prp = dbs.CreateProperty(strName, varType, varvalue)
     dbs.Properties.Append prp
     Resume
     Else
     AddAppProperty = False
     Resume AddProp_Bye
     End If
    End Function