Office中国论坛/Access中国论坛

标题: 例子：改变应用程序图标和窗体背景-->tmtony转移 [打印本页]

作者: zhuyiwen 时间: 2002-5-1 09:29
标题: 例子：改变应用程序图标和窗体背景-->tmtony转移

为了做这个例子，把我ACCESS给玩死了。

文件下载

[em26][em26][em26]

作者: xinbao 时间: 2002-5-1 17:15
很不错啦，但几个改背景的例子都是美眉，没有俊男，这儿女程序员也不少吧：）
看不到源码哦？

作者: zhuyiwen 时间: 2002-5-2 05:05
其实这个例子综合了两个方面的东西。

一、根据dca在《请教：如何用代码修改应用程序标题和应用程序图标？》贴中的回复，设置数据库应用程序的标题栏和图标。
见：http://www.office-cn.net/bbs/dispbbs.asp?boardID=2&RootID=3263&ID=3263&page=2

二、修改《设置程序背景的小例子[竹笛2]》贴中的程序，去掉了ACCESS最大化，仅留下窗体最大化。
见：http://www.office-cn.net/bbs/dispbbs.asp?boardID=2&RootID=3756&ID=3756&page=1

另：下载的例子，含源代码（请按Shift）打开。[em19]

作者: prince 时间: 2002-7-14 22:30
如果能加上打开查找图片和图标功能就更完美了！！

作者: WTM1 时间: 2002-9-21 00:00
xinbao :你要的源代码！

Option Compare Database
Public ICO

Private Sub cmdICO_Click()
If ICO = 1 Then
      intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\FStar.ico")
      Application.RefreshTitleBar                '//设置程序的标题,图标
      ICO = 0
Else
      intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\MSN.ico")
      Application.RefreshTitleBar                '//设置程序的标题,图标
      ICO = 1
End If

End Sub

Private Sub cmdPic_Click()
If Me.Picture = CurrentProject.Path & "\a.jpg" Then
      Me.Picture = CurrentProject.Path & "\b.jpg"
Else
      Me.Picture = CurrentProject.Path & "\a.jpg"
End If
End Sub

Private Sub Form_Close()
Access.SetOption "Show Status Bar", True
End Sub

Private Sub Form_Load()
Dim I, J As Integer

ICO = 1

intX = AddAppProperty("AppTitle", DB_Text, "修改背景和应用程序图标的例子")
intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\MSN.ico")
Application.RefreshTitleBar                '//设置程序的标题,图标

Me.Picture = CurrentProject.Path & "\b.jpg"
Access.SetOption "Show Status Bar", False
' DoCmd.RunCommand acCmdAppMaximize
DoCmd.Maximize

I = Me.WindowWidth
J = Me.WindowHeight
DoCmd.Restore
DoCmd.MoveSize 0, 0, I, J
End Sub
Option Compare Database
Option Explicit
Const DB_Text As Long = 10

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

作的很好！！是个典型的例子！值得学习！！

作者: evewxs 时间: 2003-6-30 04:13
谢谢高手！

作者: yuankeh8 时间: 2003-7-7 22:37
的确不错，可我感觉到有点遗憾的是在每次改变背景图片的时候，都会有出现一个“正在导入：F：\....”的消息。请问能否考虑把这一过程给做掉？

作者: moon--star 时间: 2004-3-29 23:25
不错，还有原码，谢谢。[em11][em11]

作者: chaojianan 时间: 2009-4-17 15:21
不错不错，收藏了。

作者: 岭南王子 时间: 2012-11-14 13:35

yuankeh8 发表于 2003-7-7 22:37
的确不错，可我感觉到有点遗憾的是在每次改变背景图片的时候，都会有出现一个“正在导入：F：\....”的消息 ...

这问题好像就中文版的才会这样,英文版的则没有,这个好像要改注册表

作者: 灰太郎 时间: 2013-1-15 22:38
qqqqqqqqqqqqq

作者: cumtclmk123 时间: 2015-1-3 15:52
看看

作者: WFH6898 时间: 2015-11-12 12:43
牛人啊，做得好

作者: 公子襄 时间: 2020-8-6 19:40
1024

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)