改變應(yīng)用程序圖標(biāo)和窗體背景

引用 xinbao 2002-5-1 17:15

很不錯(cuò)啦，但幾個(gè)改背景的例子都是美眉，沒(méi)有俊男，這兒女程序員也不少吧：）
看不到源碼哦？

引用 zhuyiwen 2002-5-2 05:05

其實(shí)這個(gè)例子綜合了兩個(gè)方面的東西。

一、根據(jù)dca在《請(qǐng)教：如何用代碼修改應(yīng)用程序標(biāo)題和應(yīng)用程序圖標(biāo)？》貼中的回復(fù)，設(shè)置數(shù)據(jù)庫(kù)應(yīng)用程序的標(biāo)題欄和圖標(biāo)。
見(jiàn)：http://m.mzhfr.cn/bbs/dispbbs.asp?boardID=2&RootID=3263&ID=3263&page=2

二、修改《設(shè)置程序背景的小例子[竹笛2]》貼中的程序，去掉了ACCESS最大化，僅留下窗體最大化。
見(jiàn)：http://m.mzhfr.cn/bbs/dispbbs.asp?boardID=2&RootID=3756&ID=3756&page=1

另：下載的例子，含源代碼（請(qǐng)按Shift）打開(kāi)。[em19]

引用 prince 2002-7-14 22:30

如果能加上打開(kāi)查找圖片和圖標(biāo)功能就更完美了�。�

引用 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                 '//設(shè)置程序的標(biāo)題,圖標(biāo)
        ICO = 0
    Else
        intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\MSN.ico")
        Application.RefreshTitleBar                 '//設(shè)置程序的標(biāo)題,圖標(biāo)
        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, "修改背景和應(yīng)用程序圖標(biāo)的例子")
    intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\MSN.ico")
    Application.RefreshTitleBar                 '//設(shè)置程序的標(biāo)題,圖標(biāo)
   
    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

作的很好！！是個(gè)典型的例子！值得學(xué)習(xí)�。�

引用 evewxs 2003-6-30 04:13

謝謝高手！

引用 yuankeh8 2003-7-7 22:37

的確不錯(cuò)，可我感覺(jué)到有點(diǎn)遺憾的是在每次改變背景圖片的時(shí)候，都會(huì)有出現(xiàn)一個(gè)“正在導(dǎo)入：F：\....”的消息。請(qǐng)問(wèn)能否考慮把這一過(guò)程給做掉？

引用 moon--star 2004-3-29 23:25

不錯(cuò)，還有原碼，謝謝。[em11][em11]

引用 chaojianan 2009-4-17 15:21

不錯(cuò)不錯(cuò)，收藏了。

引用 嶺南王子 2012-11-14 13:35

yuankeh8 發(fā)表于 2003-7-7 22:37
的確不錯(cuò)，可我感覺(jué)到有點(diǎn)遺憾的是在每次改變背景圖片的時(shí)候，都會(huì)有出現(xiàn)一個(gè)“正在導(dǎo)入：F：\....”的消息 ...

這問(wèn)題好像就中文版的才會(huì)這樣,英文版的則沒(méi)有,這個(gè)好像要改注冊(cè)表

引用 灰太郎 2013-1-15 22:38

qqqqqqqqqqqqq

引用 cumtclmk123 2015-1-3 15:52

看看

引用 WFH6898 2015-11-12 12:43

牛人啊，做得好

引用 公子襄 2020-8-6 19:40

1024

查看全部評(píng)論(13)