如题!可以调用打开图片对话框,选择背景图片.

解决方案 »

  1.   

    '在主窗口中(frmMain),选择背景菜单
    Private Sub mnuSelectGround_Click()
    On Error GoTo Errhandle
        Dim fName As String, sName As String, OfName As OPENFILENAME
        
        OfName.lStructSize = Len(OfName)
        OfName.hwndOwner = hwnd
        OfName.hInstance = App.hInstance
        OfName.lpstrFilter = "图片文件" & Chr(0) & "*.Bmp;*.jpg;*.jpeg;*.gif;*.ico"
        OfName.lpstrFile = Space(255) & Chr(0)
        OfName.nMaxFile = 256
        OfName.lpstrFileTitle = Space(255) & Chr(0)
        OfName.nMaxFileTitle = 256
        OfName.lpstrTitle = "选择图片..."
        OfName.flags = OFN_LONGNAMES + OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST + OFN_HIDEREADONLY
        
        If GetOpenFileName(OfName) Then
            Screen.MousePointer = 11
            DoEvents
            
            SaveSetting "OrientZiXun", "BackGround", "PathValue", OfName.lpstrFile
            frmBack.SetBack
            frmBack.Hide
            
            Screen.MousePointer = 0
        End If
        
        Exit Sub
    Errhandle:
        Screen.MousePointer = 0
        ErrView Err.Description
    End Sub
    '添加一个背景窗口:frmBack,在窗口里面定义一个公共的设置背景函数,里面放一个PictureBox控件,设置AUTOSIZE为TRUE
    Public Sub SetBack()
    On Error Resume Next
        Dim i As Long, j As Long, ls_Path As String
        
        ls_Path = GetSetting("OrientZiXun", "BackGround", "PathValue")
        If Trim(ls_Path) <> "" Then
            If Dir(ls_Path) <> "" Then
                picBack.Picture = LoadPicture(ls_Path)
            Else
                picBack.Picture = LoadPicture(ls_Path)
            End If
        Else
            picBack.Picture = imgDefault.Picture
        End If    If frmMain.mnuLaShen.Checked Then'拉伸
            Me.PaintPicture picBack.Picture, 0, 0, frmMain.Width, frmMain.Height - 1800
        Else'平铺
            For j = 0 To frmMain.ScaleHeight Step picBack.ScaleHeight
                For i = 0 To frmMain.ScaleWidth Step picBack.ScaleWidth
                    Me.PaintPicture picBack.Picture, i, j
                Next
            Next
        End If
    '    Me.Font.Name = "楷体_GB2312"
    '    Me.ForeColor = vbWhite
    '    Me.Font.Size = 24
    '    Me.FontBold = True
    '    Me.CurrentX = frmMain.ScaleWidth - 3300
    '    Me.CurrentY = frmMain.ScaleHeight - 2500
    '    Me.Print "咨询管理系统"
        frmMain.Picture = Me.Image
        frmBack.Tag = Val(frmBack.Tag) + 1
        frmMain.BackColor = Val(frmBack.Tag)
    End Sub'在模块中
    Public Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type'系统全局常量========================================================================
    Public Const OFN_LONGNAMES = &H200000
    Public Const OFN_PATHMUSTEXIST = &H800
    Public Const OFN_FILEMUSTEXIST = &H1000
    Public Const OFN_HIDEREADONLY = &H4
    Public Const OFN_EXPLORER = &H80000
    Public Const OFN_OVERWRITEPROMPT = &H2Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long