大家都知道大名鼎鼎的WINAMP播放器是支持“換膚”的,也就是說,我們可以動態的改變窗體和控件的背景圖案,使窗體看起來十分漂亮,而且能夠不斷更換新的面孔。那我們能讓自己的程序也實現這樣的效果嗎?答案是肯定的,下面我們就一起來看看用VB6做出的可以換膚的窗體。
程序包含一個主窗體和一個模塊,為了使窗體上的控件也能以我們選擇的圖案作為背景,我們使用了Microsoft Forms2.0 Object Library的控件組,在默認狀態下它不在控件面板中,我們可以在控件面板上點鼠標右鍵“添加”,在“添加選擇對話框”中找到這個控件並選中添加進來。這時會多出幾個控件,如下圖所示紅線圈住的部分:
這個程序中我們使用了其中的三個控件,乍一看它們和默認的標簽、文本框、按鈕沒有什麼區別,但它們的屬性中多出了BackStyle屬性,我們正是利用了這個屬性,將控件設為背景透明0-fmBackStyleTransparent,這樣控件的背景就能和窗體的背景保持一致了。
為了學習方便,提供的源碼已經作了詳細的中文注釋,看看代碼:
'-------------------------------------------
' 一個可換膚的窗體的例子
'-------------------------------------------
' 洪恩在線 求知無限
'-------------------------------------------
'程序說明:
'這個例子中,我們可以為應用程序的窗體設置背景圖
'片,這是通過在窗體上平鋪圖片實現的,而你會發現
'窗體上的其他控件也變為透明,這是應用了控件集合
'Microsoft Forms2.0 Object Library得以實現的
'你必須在組件面板中添加此項,然後把要使用的控件
'的BackStyle屬性設為0-fmBackStyleTransparent
'即可。
'------------------------------------------
Private Sub CmdExit_Click()
End
End Sub
'也可點擊“選擇背景圖片”按鈕,在程序運行過程中更換背景圖片
Private Sub CmdSel_Click()
'打開選擇文件對話框
Cdl1.ShowOpen
'選中的圖片文件的路徑賦值給BackPicture變量(全局變量,在模塊中定義)
BackPicture = Cdl1.FileName
'換膚
ShowBackGround Frmmain
End Sub
'窗體加載時自動從應用程序所在的目錄下尋找default.bmp文件,並把它設置為窗體背景
'我們可以用其它圖片替換此文件以為應用程序換上不同的皮膚
Private Sub Form_Load()
'取得背景圖片的完整路徑
BackPicture = App.Path + "\default.JPG"
'ShowBackGround子過程(在模塊中定義),為窗體設置背景
ShowBackGround Frmmain
End Sub
-------------------------
'------------------------------------------------------
'以下是模塊中的源碼:
'------------------------------------------------------
'存儲背景圖片的變量
Global BackPicture As String
'設置背景圖片的子過程
Sub ShowBackGround(Frm As Form)
'將Pic定義為StdPicture對象(StdPicture對象是包含各種圖元的對象)
Dim Pic As StdPicture
'如果選擇圖片時,按下“取消”按鈕(也就是沒有選中文件)
If BackPicture = "" Then Exit Sub
'先清空窗體上原有圖片背景
Frm.Cls
'如果出現異常錯誤,轉向錯誤處理語句
On Error GoTo ErrorPic
'將選中的圖片文件加載到Pic中
Set Pic = LoadPicture(BackPicture)
'下面將圖片排滿整個窗體
W = 0
H1 = Pic.Height / 27
W1 = Pic.Width / 27
While W < Frm.ScaleWidth
H = 0
While H < Frm.ScaleHeight
Frm.PaintPicture Pic, W, H
H = H + H1
Wend
W = W + W1
Wend
'ShowBorder Frm
Exit Sub
'如果出現異常錯誤,則恢復默認的背景圖片
ErrorPic:
If Err.Number = 481 Then
MsgBox " Picture File Error!"
End If
If BackPicture <> App.Path + "\default.JPG" Then
BackPicture = App.Path + "\default.JPG"
Set Pic = LoadPicture(BackPicture)
Resume Next
Else
'ShowBorder Frm
End If
End Sub
'---------------------------------------------
'如果我們不想使用默認的標題欄和邊框,而自己制作更漂
'亮的標題欄,可把窗體Frmmain的Border屬性設為0-None
'利用下面的ShowBorder來重新畫出窗體的Border,別忘
'了把上面中的ShowBackGround子過程的ShowBorder Frm
'寫上。
'---------------------------------------------
'Sub ShowBorder(Frm As Form)
' Frm.DrawWidth = 1
' Frm.Line (Frm.ScaleWidth - 1, 1)-(Frm.ScaleWidth - 1, Frm.ScaleHeight - 1), QBColor(1)
' Frm.Line (Frm.ScaleWidth - 2, 2)-(Frm.ScaleWidth - 2, Frm.ScaleHeight - 2), QBColor(8)
' Frm.Line (Frm.ScaleWidth - 3, 3)-(Frm.ScaleWidth - 3, Frm.ScaleHeight - 3), QBColor(7)
' Frm.Line (1, Frm.ScaleHeight - 1)-(Frm.ScaleWidth - 1, Frm.ScaleHeight - 1), QBColor(1)
' Frm.Line (2, Frm.ScaleHeight - 2)-(Frm.ScaleWidth - 2, Frm.ScaleHeight - 2), QBColor(8)
' Frm.Line (3, Frm.ScaleHeight - 3)-(Frm.ScaleWidth - 3, Frm.ScaleHeight - 3), QBColor(7)
' Frm.Line (0, 0)-(Frm.ScaleWidth, 0), QBColor(7)
' Frm.Line (1, 1)-(Frm.ScaleWidth - 1, 1), QBColor(15)
' Frm.Line (2, 2)-(Frm.ScaleWidth - 2, 2), QBColor(7)
' Frm.Line (0, 0)-(0, Frm.ScaleHeight), QBColor(7)
' Frm.Line (1, 1)-(1, Frm.ScaleHeight - 1), QBColor(15)
' Frm.Line (2, 2)-(2, Frm.ScaleHeight - 2), QBColor(7)
'End Sub
程序每次運行時都會到程序所在的目錄下找default.bmp文件,如果找到這個文件,它就會把這張圖片作為窗體的背景,這樣我們可以用自己喜歡的圖片替換這張圖,也就是為程序“換膚”,另外程序運行過程中也可動態的改變窗體的背景圖片。