用代码修改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交流群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
- 【Access定时打开查询】A...(08.19)
- Access生成固定数量的记录...(08.13)
- Access怎样才能实现日期时...(08.12)
- Access利用导航窗体控件对...(08.03)
学习心得
最新文章
- Access自定义函数命名为中文名...(09.20)
- Access表中的字段名、字段标题...(09.19)
- Access快速开发平台--更改“...(09.18)
- 【中秋及国庆优惠】Access培训...(09.15)
- Access如何将日期型的数值转换...(09.14)
- 英文输入法输入数据中存在单引号引起...(09.11)
- 【Access选项卡示例】Acce...(09.09)
- 让Access光标停留在指定的控件...(09.07)
- 关于Access查询条件里使用通配...(09.06)
- Access报表偷懒制作法--Ac...(09.05)