ACCESS设置应用程序标题和图标的源码

1. Function AddAppProperty(strName As String, _
2.                         varType As Variant, varvalue As Variant) As Integer
3.     '应用程序标题和图标
5.     Dim dbs As Object, prp As Variant
6.     Const conPropNotFoundError = 3270
8.     Set dbs = CurrentDb
9.     On Error GoTo AddProp_Err
10.     dbs.Properties(strName) = varvalue
11.     AddAppProperty = True
13. AddProp_Bye:
14.     Exit Function
16. AddProp_Err:
17.     If Err = conPropNotFoundError Then
18.         Set prp = dbs.CreateProperty(strName, varType, varvalue)
19.         dbs.Properties.Append prp
20.         Resume
21.     Else
22.         AddAppProperty = False
23.         Resume AddProp_Bye
24.     End If
25. End Function
27. ----------------------------------------------------------------------------------------
28. Private Sub Form_Current()
29.      Dim intX   As Integer
30.     Const DB_Text As Long = 25
31.     '设置应用程序标题
32.     intX = AddAppProperty("apptitle", DB_Text, xtmc)
34.     '设置图标
35.     intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "/" & "30346.ico")
36.     CurrentDb.Properties("UseAppIconForFrmRpt") = 1
37.     Application.RefreshTitleBar
38.     '回答问题2：这里请注意，如果你同时定义了 AppIcon 和 AppTitle，只要其中有一项是错误的，
39.     '比如 AppIcon 的文件名或者路径错误，那么 RefreshTitleBar 就不会刷新标题。
41. End Sub