access更改系统和窗体的图标-薛武元
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> 综合其它


access更改系统和窗体的图标

发表时间:2007/10/26 8:37:07 评论(0) 浏览(5282)  评论 | 加入收藏 | 复制
   
摘 要:用于ACCESS更改系统和窗体的图标、系统标题的代码
正 文:

背景:

1.在MDB文件的相同文件夹下放上一个图片文件,假定文件名为ico.ico。

2.有一个窗体frmOpen,并设为启动窗体。

在窗体frmOpen的打开事件中写代码:

Private Sub Form_Open(Cancel As Integer)
'更改窗体图标
    SetFormIcon Me.hWnd, CurrentProject.Path & "\ico.ico"
    '更改系统标题及图标
    Dim intX As Integer
    Const DB_Text As Long = 10
    intX = AddAppProperty("AppTitle", DB_Text, "XXX系统")
    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


Access软件网交流QQ群(群号:198465573)
 
 相关文章
向access2007数据库中添加自定义标题或图标  【Microsoft  2008/12/13】
如何启动access2003时显示自定义图标  【褚玉春  2009/2/4】
[共享]图标做窗口届面可以用的  【UMVSoft整理  2009/6/9】
[分享]通用登录及更改系统和窗体图标的例子!  【谢健  2009/6/25】
让任务栏图标动起来  【麥田  2011/12/27】
更改Access应用程序图标,更改任务栏Access应用程序图标的...  【麥田  2012/8/10】
 
 访客评论
总记录:0篇  页次:0/0 9 1 :
 
 发表评论
评论内容 (必填)

常见问答
技术分类
相关资源
文章搜索
关于作者

薛武元

文章分类

文章存档

友情链接