平铺与拉伸MDI窗口的背景图 ~!~

原创 2004年06月10日 17:04:00

Microsoft Visual Basic 的MDI窗口虽然可以通过窗口的PICTURE属性设置窗口的背景图,使程序美化了不少。但是图片加载之后当窗口在不同的分辨率下,会出现缺口的现象,比如在800*600下设计的图片,到了1024*768下右边和下边就会出现一块空余(背景色露了出来,非常难看)。并且当窗口的大小被用户改变的时候,图片也会被载断,使原本设计的很漂亮的图片变的“惨不妨睹”;笔者在开发项目的过程中经过摸索,写出了跟 WINDOWS 的设置桌面背景比较类似的功能。好东西不敢独享,写出来与大家共同提高。

程序源码可以到本人的网站上进行下载:http://www.j2soft.cn/

       作者:崔占民
        EMAIL:CUIZM@163.COM
       2004.6.8

 

以下是程序代码:

Option Explicit

'MDI窗口代码

'/============================================================================/
'|                             作者:崔占民 2003.6.21                          |
'|                              EMAIL:CUIZM@163.COM                           |
'| 添加一个MDI主窗口,一个普通的窗口,设置为MDI的子窗口(MDIChild属性设置为TRUE) |
'| 添加一个模块,用于设置打开文件对话框的API函数及结构                         |
'| 在MDI主窗口中加一个菜单,菜单名为背景,其下添加四项子菜单,分别为:选择背景图, |
'| 默认背景,拉伸与平铺,其代码如下所示                                         |
'|                                                                            |
'/============================================================================/

Private Sub MDIForm_Load()
On Error Resume Next
    Dim ls_tmp As String
   
    '读取注册的设置,是拉伸还是平铺,然后设置菜单项
    ls_tmp = GetSetting("OrientZiXun", "BackGround", "LaShen")
    If ls_tmp = "True" Then
        mnuPull.Checked = True
        mnuLay.Checked = False
    Else
        mnuPull.Checked = False
        mnuLay.Checked = True
    End If
End Sub

Private Sub MDIForm_Resize()
On Error Resume Next
    frmBack.SetBack
    frmBack.Hide
End Sub

'设置缺省图片
Private Sub mnuDefault_Click()
    If MsgBox("您确定要清除当前背景,而选用默认背景吗?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    Screen.MousePointer = 11
    DoEvents
   
    SaveSetting "OrientZiXun", "BackGround", "PathValue", ""
    frmBack.SetBack
    frmBack.Hide
   
    Screen.MousePointer = 0
End Sub

'平铺背景
Private Sub mnuLay_Click()
    mnuPull.Checked = False
    mnuLay.Checked = True
    SaveSetting "OrientZiXun", "BackGround", "LaShen", "False"
    frmBack.SetBack
    frmBack.Hide
End Sub

'拉伸背景
Private Sub mnuPull_Click()
    mnuPull.Checked = True
    mnuLay.Checked = False
    SaveSetting "OrientZiXun", "BackGround", "LaShen", "True"
    frmBack.SetBack
    frmBack.Hide
End Sub

'选择背景图片
Private Sub mnuSelBack_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
    MsgBox Err.Description
End Sub

Option Explicit

'背景子窗口代码

'/============================================================================/
'|                             作者:崔占民 2003.6.21                          |
'|                              EMAIL:CUIZM@163.COM                           |
'| 在窗口中分别添加一个PICTUREBOX控件和一个IMAGE控件,名称分别为:picBack和     |
'| imgDefault                                                                 |
'|                                                                            |
'|                                                                            |
'|                                                                            |
'/============================================================================/

'设置背景函数
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 = imgDefault.Picture '图片不存在,用默认的图片
        End If
    Else
        picBack.Picture = imgDefault.Picture '路径为空,用默认的图片
    End If

    If frmMain.mnuPull.Checked Then '如果为拉伸
        Me.PaintPicture picBack.Picture, 0, 0, frmMain.Width, frmMain.Height
    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 = vbBlue
    Me.Font.Size = 24
    Me.FontBold = True
    Me.CurrentX = frmMain.ScaleWidth - 3500
    Me.CurrentY = frmMain.ScaleHeight - 1000
    Me.Print "咨询管理系统"
    frmMain.Picture = Me.Image
    frmMain.BackColor = frmMain.BackColor - 1 '为了刷MDI窗口,否则背景不会改变
End Sub

Private Sub Form_Load()
On Error Resume Next
    Me.AutoRedraw = True
    picBack.AutoSize = True
End Sub

Option Explicit

'模块代码

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 = &H2

Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long

 

最简单设置Mdi容器背景图片方法

//手动创建Mdi容器 MdiClient mic = new MdiClient(); mic.Dock = DockStyle.Fill; mic.BackgroundImage = Ima...
  • yunhaiC
  • yunhaiC
  • 2011年06月02日 11:54
  • 2367

让div背景图片自动拉伸,而不是平铺!超简单!

无法拉伸! 但是可以用 background-repeat:no-repeat; 这个方法来 控制背景不会平铺! 或者将你上面的代码改为 ...
  • dxnn520
  • dxnn520
  • 2012年09月19日 23:54
  • 36974

css 如何让背景图片拉伸填充避免重复显示 不是平铺

但是css3出现以后,这个重复显示的情况被改善了。background-size 属性可以让我们之前的让背景图片拉伸填充的希望成真,具体使用方法如下感兴趣的朋友可以参考下哈,希望对大家有所帮助 如何...
  • dayu9216
  • dayu9216
  • 2017年11月17日 14:42
  • 465

winform MDI应用程序

1.创建Mdi应用程序的步骤如下:  1.1 设置父窗口的IsMdiContainer的属性值为true,  1.2在子窗口中设置其父窗口,代码如下:   Form1 f1 = new Form1()...
  • sven_xu
  • sven_xu
  • 2015年06月02日 09:19
  • 232

【iOS开发-背景】关于按钮背景图片的拉伸

关于按钮背景图片拉伸与不拉伸的效果拉伸的效果: 不拉伸的效果 不拉伸的效果 拉伸的效果: 拉伸原理iOS开发中,有一个方法可以将图片按照指定的形式拉伸,拉伸方式为下图,一般拉伸部分都为...
  • ttf1993
  • ttf1993
  • 2015年05月04日 19:22
  • 1196

VB6给MDI窗口(父窗口)动态绘制背景的种种方法

VB6就不说了,要快速写一个程序,.NET(C#)可能还更好更强大,但是要说安全,VB6反到强过他们 有时候两者就是一种矛盾,所以越是用户友好,越是易维护和扩展的程序,越容易被破解. ...
  • prsniper
  • prsniper
  • 2013年08月18日 06:12
  • 2123

在MDI主窗口中设置图像背景

1.创建一个多文档应用程序,工程名为NoChild。 2.导入背景位图IDB_CAR 3.添加新的类CBgWnd。基类选择generic CWnd类。 4.重载CBgWnd类的OnEraseBkgnd...
  • tanyouliang
  • tanyouliang
  • 2015年10月09日 11:08
  • 831

C#-Mdi多文档窗口及其子窗口的排列 ---ShinePans

MdiLayout枚举成员及说明 Casecade s所有Mdi层叠在父窗口 TileHorizontal 水平平铺 TitleVertical 垂直平铺 Form...
  • panshang1994
  • panshang1994
  • 2014年04月20日 15:03
  • 3335

WPF中设置窗体不平铺背景图

             
  • zhouminjob120
  • zhouminjob120
  • 2015年08月25日 14:56
  • 224

background-image背景图片拉伸平铺

选填项 效果: 使用的背景图片: 实现方法主要是: 1,filter:progid:DXImageTransform.Microsoft.AlphaImageLoader(sizing...
  • MajorMayer
  • MajorMayer
  • 2016年02月15日 16:21
  • 8064
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:平铺与拉伸MDI窗口的背景图 ~!~
举报原因:
原因补充:

(最多只允许输入30个字)