用代码修改access应用程序或者窗体的图标;用vba代码更改Access应用程序图标;通过VBA代码设置任务栏Access应用程序图标的方法
时 间:2022-11-19 08:30:11
作 者:杨雪 ID:42182 城市:南京
摘 要:分享一个用代码修改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, "我是修改的窗体名称!!!") 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 ICO_BIG = 1 Const IMAGE_BITMAP = 0 Const IMAGE_ICON = 1 Const IMAGECURSOR = 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
Access软件网QQ交流群 (群号:483923997) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access窗体导出PDF】...(04.08)
- 【Access窗体导出PDF】...(04.07)
- Access两种方式实现即时更...(03.01)
- Access隐藏与显示lacc...(01.12)
- 【Access高效办公】将每个...(12.23)
- Access21点游戏源代码(12.13)
- 【Access窗体导出Exce...(11.15)
- 【Access开发】Acces...(11.14)
- 通过Access宏录入数据到选...(11.10)
学习心得
最新文章
- Access学习笔记--用Acce...(04.19)
- 【Access重复项查询示例】将A...(04.17)
- Access快速开发平台企业版--...(04.16)
- 【Access模块示例】通过模块代...(04.15)
- Access查询里面分组合计功能添...(04.13)
- 【Access删除查询】删除数字最...(04.12)
- 显示文件夹中所有文件的修改时间(04.11)
- 铁路工程管理系统;铁路工程管理小程...(04.10)
- 【Access查询示例】怎么将两个...(04.09)
- 【Access窗体导出PDF】Ac...(04.08)