Visual Basic窗体背景花纹的实现   
 

下面介绍一种窗体背景花纹实现的方法。在窗体上建立一个网格控件，设定网格行不可见，去掉固定行和固定列，用程序实现网格控件与窗体同样大小，并随窗体大小的改变而改变。然后设计一个花纹图案，形成BMP位图文件(本文程序使用文件Pict1.bmp)，或者从其它图象中截取一段图案,也可以利用Windows系统提供的图案（如c:\windows\Tiles.bmp)，将其调入Picture控件。设定网格的每个单元与该图案大小相同，使单元的数量正好覆盖整个窗体背景，再将所有单元均显示该图案。通过子程序Backpict()实现以上过程，不论图案大小、窗体大小，程序都能自动调整网格控件大小和网格单元大小及单元数量。该程序在Visual Basic 4.0上调试成功。

　

1.新建窗体Form1,属性如下：

Caption =“背景花纹的实现”

Borderstyle=3(无最大、最小化按钮）

　

2.建网格控件Grid1,它的位置和大小将在程序中设置（与Form1同样大）,属性为：

Enabled = False（焦点不会落在网格控件Grid1上）

Fillstyle=1（改变所有单元Text特性）

Fixedcols=0（无固定行）

Fixedrows=0（无固定列）

Gridlines = False（网格行不可见），

Visible = True

　

3.建立图象控件Picture1,程序运行时将背景花纹基本图案放入其中，属性为

Visible = False（不可见）

Autosize = True（自动调整大小）

　

4.控件中加入Sheridan 3D Controls,选取其中的三维命令按钮SSCommand,建立两个按钮

SSCommand1.Caption=“退出”

SSCommand2.Caption=“更换背景”（演示不同的背景图案）

　

它们的属性Picture可调用与背景相同或不同的图案，如果使用普通的命令按钮控件Command也可，只是命令按钮无背景图案。

　

5.建立背景图案形成子程序：

　

Dim pictfile As String '位图文件名

Dim FILEPATH As String '文件路径

Sub Backpict(pictfile)

picture1.ScaleMode = 3

Form1.ScaleMode = 3

picture1.Picture = LoadPicture(pictfile)

'网格控件覆盖整个窗体背景

grid1.Top = -1

grid1.Left = -1

grid1.Width = Width

grid1.Height = Height

grid1.Cols=Int(Form1.ScaleWidth/picture1.ScaleWidth) + 1

grid1.Rows=Int(Form1.ScaleHeight/picture1.ScaleHeight) + 1

'所有单元大小等于基本图案大小

For i = 0 To grid1.Cols - 1

For j = 0 To grid1.Rows - 1

grid1.ColWidth(i) = picture1.ScaleWidth * 15

grid1.RowHeight(j) = picture1.ScaleHeight * 15

Next j

Next I

'选定所有单元

grid1.SelStartCol = 0

grid1.SelStartRow = 0

grid1.SelEndCol = grid1.Cols - 1

grid1.SelEndRow = grid1.Rows - 1

grid1.Picture = Picture1.Picture

End Sub

　

6.窗体主程序

　

Private Sub Form_Load()

Private Sub Form_Load()

'得到运行程序路径名，路径名后带反斜杠

If Right(App.Path, 1) <> "\" Then

filePath = App.Path & "\"

Else

filePath = App.Path

End If

'窗体初始显示由Tiles.bmp基本图案组成的背景

pictfile = "c:\windows\Tiles.bmp"

backpict (pictfile)

End Sub

　

7.退出程序命令按钮

　

Private Sub SSCommand1_Click()

End

End Sub

　

8.演示不同的底纹图案

　

Private Sub SSCommand2_Click()

'两种背景图案交替演示

If pictfile = filePath & "Pict1.bmp" Then

pictfile = "c:\windows\Tiles.bmp"

Else

pictfile = filePath & "Pict1.bmp"

End If

Backpict (pictfile)

End Sub