如何通过程序修改ACCESS主窗体的标题和图标


正    文:

    在ACCESS 2002中,可以通过数据库窗体的[启动]属性来设置应用程序(ACCESS主窗体)的标题和图标,那么在ACCESS 2000中怎么办呢?其实ACCESS提供了AppTitle和AppIco两个属性以及RefreshTitleBar方法,可以用来实现这个目的,本文将详细介绍如何编制程序和使用。   首先,新建一个模块,在模块中定义两个常量(来自微软帮助中的例程):

Public Const DB_Text As Long = 10      ' 属性值为文本类型
Public Const DB_Boolean As Long = 1    ' 属性值为逻辑类型

    接下编写下列函数(此函数来自ACCESS帮助中),以实现在数据库中添加或修改数据库属性。

Public Function AddAppProperty(strName As String, varType As Variant, varvalue As Variant) As Integer
'=============================================================================================
' 本函数用来给当前数据库(.mdb)添加属性
'
' strName : 属性名
' varType : 属性类型
' varvalue: 属性的值
'
' 返回值  : 成功 为 True (-1)
'            失败 为 False (0)
'
'   例如:应用程序标题栏和应用程序图标
'   intX = AddAppProperty("AppTitle", DB_Text, "更改应用各标题栏和应用程序图标的例子")
'   intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\MSN.ico")
'   ' 应用设置
'   Application.RefreshTitleBar
'
'   易和软件:朱亦文 2002.05.01
'=============================================================================================

    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    ' 返回指向当前数据库的 Database 对象变量。
    Set dbs = CurrentDb   ' 如果是ADP,则为 CurrentProject
    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标题和图标的函数:

Public Function ChangeMyAccessTitle(strTitle As String) As Integer
    ' 设置ACCESS主窗体的标题
    ChangeMyAccessTitle = AddAppProperty("AppTitle", DB_Text, strTitle)
    Application.RefreshTitleBar                 ' 刷新标题栏,设置ACCESS的标题
End Function

Public Function ChangeMyAccessIco(strIcoPath As String) As Integer
    ' 设置ACCESS主窗体的图标
    ChangeMyAccessIco = AddAppProperty("AppIcon", DB_Text, strIcoPath)
    Application.RefreshTitleBar                 ' 刷新标题栏,设置ACCESS的图标
End Function

如果想要把 ACCESS 的图标改在 C:\my.ico, 则只要这样就可以了:

iX = ChangeMyAccessIco("C:\my.ico")

如果想要把 ACCESS 的标题改为“我的应用程序”,则只要这样:
iX = ChangeMyAccessTitle("我的应用程序")
本文作者:

正    文:

    在ACCESS 2002中,可以通过数据库窗体的[启动]属性来设置应用程序(ACCESS主窗体)的标题和图标,那么在ACCESS 2000中怎么办呢?其实ACCESS提供了AppTitle和AppIco两个属性以及RefreshTitleBar方法,可以用来实现这个目的,本文将详细介绍如何编制程序和使用。   首先,新建一个模块,在模块中定义两个常量(来自微软帮助中的例程):

Public Const DB_Text As Long = 10      ' 属性值为文本类型
Public Const DB_Boolean As Long = 1    ' 属性值为逻辑类型

    接下编写下列函数(此函数来自ACCESS帮助中),以实现在数据库中添加或修改数据库属性。

Public Function AddAppProperty(strName As String, varType As Variant, varvalue As Variant) As Integer
'=============================================================================================
' 本函数用来给当前数据库(.mdb)添加属性
'
' strName : 属性名
' varType : 属性类型
' varvalue: 属性的值
'
' 返回值  : 成功 为 True (-1)
'            失败 为 False (0)
'
'   例如:应用程序标题栏和应用程序图标
'   intX = AddAppProperty("AppTitle", DB_Text, "更改应用各标题栏和应用程序图标的例子")
'   intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\MSN.ico")
'   ' 应用设置
'   Application.RefreshTitleBar
'
'   易和软件:朱亦文 2002.05.01
'=============================================================================================

    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270

    ' 返回指向当前数据库的 Database 对象变量。
    Set dbs = CurrentDb   ' 如果是ADP,则为 CurrentProject
    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标题和图标的函数:

Public Function ChangeMyAccessTitle(strTitle As String) As Integer
    ' 设置ACCESS主窗体的标题
    ChangeMyAccessTitle = AddAppProperty("AppTitle", DB_Text, strTitle)
    Application.RefreshTitleBar                 ' 刷新标题栏,设置ACCESS的标题
End Function

Public Function ChangeMyAccessIco(strIcoPath As String) As Integer
    ' 设置ACCESS主窗体的图标
    ChangeMyAccessIco = AddAppProperty("AppIcon", DB_Text, strIcoPath)
    Application.RefreshTitleBar                 ' 刷新标题栏,设置ACCESS的图标
End Function

如果想要把 ACCESS 的图标改在 C:\my.ico, 则只要这样就可以了:

iX = ChangeMyAccessIco("C:\my.ico")

如果想要把 ACCESS 的标题改为“我的应用程序”,则只要这样:
iX = ChangeMyAccessTitle("我的应用程序")
本文作者:
« 
» 
快速导航

Copyright © 2016 phpStudy | 豫ICP备2021030365号-3