module1.bas

2008年版

Attribute VB_Name = "Module1"
'------------------------------------------------------
'以下是模块中的源码：
'------------------------------------------------------
'存储背景图片的变量
Public BackPicture As String

'设置背景图片的子过程
Public 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
'    w1 = Frm.ScaleX(Pic.Width, vbHimetric, vbTwips)
'    H1 = Frm.ScaleY(Pic.Height, vbHimetric, vbTwips)

    H1 = Pic.Height / 10
    w1 = Pic.Width / 10
    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.gif" Then
        BackPicture = App.Path + "\default.gif"
        Set Pic = LoadPicture(BackPicture)
        Resume Next
    Else
        'ShowBorder Frm
    End If
End Sub