Attribute VB_Name = "modules"
'存儲背景圖片的變量
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
'----------------------------------------------
'怎么拖動不帶標題欄的窗體呢？你可參考源碼講解的例子
'----------------------------------------------