admin 管理员组文章数量: 1086019
2024年3月8日发(作者：java实现多线程的两种方式)
Microsoft Visual Basic 的MDI窗口虽然可以通过窗口的PICTURE属性设置窗口的背景图，使程序美化了不少。但是图片加载之后当窗口在不同的分辨率下，会出现缺口的现象，比如在800*600下设计的图片，到了1024*768下右边和下边就会出现一块空余（背景色露了出来，非常难看）。并且当窗口的大小被用户改变的时候，图片也会被载断，使原本设计的很漂亮的图片变的“惨不妨睹”；笔者在开发项目的过程中经过摸索，写出了跟 Windows 的设置桌面背景比较类似的功能。好东西不敢独享，写出来与大家共同提高。
作者：崔占民
EMAIL：CUIZM@
2004.6.8
以下是程序代码:
Option Explicit
'MDI窗口代码
'/============================================================================
'| 作者:崔占民
2003.6.21 |
'| EMAIL:CUIZM@
|
'| 添加一个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
d = True
d = False
Else
d = False
d = True
End If
End Sub
Private Sub MDIForm_Resize()
On Error Resume Next
k
End Sub
'设置缺省图片
Private Sub mnuDefault_Click()
If MsgBox("您确定要清除当前背景，而选用默认背景吗？", VBQuestion + vbYesNo)
= vbNo Then Exit Sub
ointer = 11
DoEvents
SaveSetting "OrientZiXun", "BackGround", "PathValue", ""
k
ointer = 0
End Sub
'平铺背景
Private Sub mnuLay_Click()
d = False
d = True
SaveSetting "OrientZiXun", "BackGround", "LaShen", "False"
k
End Sub
'拉伸背景
Private Sub mnuPull_Click()
d = True
d = False
SaveSetting "OrientZiXun", "BackGround", "LaShen", "True"
k
End Sub
'选择背景图片
Private Sub mnuSelBack_Click()
On Error GoTo Errhandle
Dim fName As String, sName As String, OfName As OPENFILENAME
tSize = Len(OfName)
ner = hWnd
nce = nce
ilter = "图片文件" & Chr(0) &
"*.Bmp;*.jpg;*.jpeg;*.gif;*.ico"
ile = Space(255) & Chr(0)
le = 256
ileTitle = Space(255) & Chr(0)
leTitle = 256
itle = "选择图片..."
= OFN_LONGNAMES + OFN_PATHMUSTEXIST + OFN_FILEMUSTEXIST +
OFN_HIDEREADONLY
If GetOpenFileName(OfName) Then
ointer = 11
DoEvents
SaveSetting "OrientZiXun", "BackGround", "PathValue",
ile
k
ointer = 0
End If
Exit Sub
Errhandle:
ointer = 0
MsgBox ption
End Sub
Option Explicit
'背景子窗口代码
'/============================================================================
'| 作者:崔占民
2003.6.21 |
'| EMAIL:CUIZM@
|
'| 在窗口中分别添加一个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
e = LoadPicture(ls_Path) '图片存在,将图片显示在缓冲区中
Else
e = e '图片不存在,用默认的图片
End If
Else
e = e '路径为空,用默认的图片
End If
If d Then '如果为拉伸
icture e, 0, 0, ,
Else '如果为平铺
For j = 0 To eight Step eight
For i = 0 To idth Step idth
icture e, i, j
Next
Next
End If
= "楷体_GB2312"
lor = vbBlue
= 24
ld = True
tX = idth - 3500
tY = eight - 1000
"咨询管理系统"
e =
lor = lor - 1 '为了刷MDI窗口,否则背景不会改变
End Sub
Private Sub Form_Load()
On Error Resume Next
draw = True
ze = 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 "" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetSaveFileName Lib "" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
版权声明：本文标题：VB中实现平铺与拉伸MDI窗口的背景图 内容由网友自发贡献，该文观点仅代表作者本人， 转载请联系作者并注明出处：http://www.roclinux.cn/p/1709827735a547609.html， 本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容，一经查实，本站将立刻删除。
发表评论