VB编程案例(蝴蝶飞舞,计算器,加密,解密,矩阵转置,鸟巢,统计,文本编辑,小球跳动,学生信息录入窗口).doc

目录
一、鸟巢绘制……………………………………………………………………………………2
二、加密…………………………………………………………………………………………3
三、解密…………………………………………………………………………………………4
四、蝴蝶飞舞……………………………………………………………………………………6
五、文本编辑……………………………………………………………………………………6
六、统计…………………………………………………………………………………………9
七、小球跳动……………………………………………………………………………………11
八、计算器（彩票摇奖）………………………………………………………………………12
九、学生信息录入………………………………………………………………………………16
十、矩阵转置……………………………………………………………………………………17

一、鸟巢绘制
Private Sub Form_Click()
Cls
Dim r, xi, yi, xj, yj, x0, y0, aif As Single
r = Form10.ScaleHeight / 2
x0 = Form10.ScaleWidth / 2
y0 = Form10.ScaleHeight / 2
n = 16
aif = 3.14159 * 2 / n
For i = 1 To n
xi = r * Cos(i * aif) + x0
yi = r * Sin(i * aif) + y0

For j = i To n
xj = r * Cos(j * aif) + x0
yj = r * Sin(j * aif) + y0

Line (xi, yi)-(xj, yj), QBColor(i - 1)

PSet (xi, yi)
Print i - 1

Next j

Next i

End Sub

Private Sub Form_Load()
Print "要求： ";
Print "1.将圆周等分成16份；"
Print "2.每个等分点要标记成0-16的数字；"
Print "3.按样本图的图案画图。"
End Sub
附图：

二、加密
Function code(ByVal s$, ByVal key%)
Dim c As String * 1, iAsc%
code = ""
For i = 1 To Len(s)
c = Mid$(s, i, 1)
Select Case c
Case "A" To "Z"
iAsc = Asc(c) + key
If iAsc > Asc("Z") Then iAsc = iAsc - 26
code = code + Chr(iAsc)
Case "a" To "z"
iAsc = Asc(c) + key
If iAsc > Asc("z") Then iAsc = iAsc - 26
code = code + Chr(iAsc)
Case Else
code = code + c
End Select
Next i
End Function

Private Sub close_Click()
Form11.Hide
Form1.Show
End Sub

Private Sub Jiami_Click()
Text2 = code(Text1, 2)
End Sub

Private Sub open_Click()
CommonDialog1.Action = 1
Text1.Text = ""
Open CommonDialog1.FileName For Input As #1
Dim counter As Integer
Dim workarea(25000) As String
ProgressBar1.min = LBound(workarea)
ProgressBar1.max = UBound(workarea)
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.min
For counter = LBound(workarea) To UBound(workarea)
workarea(counter) = "initial value " & counter
ProgressBar1.Value = counter
Next counter
Do While Not EOF(1)
Line Input #1, inputdata
Text1.Text = Text1.Text + inputdata + vbCrLf
Loop
Close #1
End Sub

Private Sub save_Click()
CommonDialog1.FileName = "a1.txt"
CommonDialog1.DefaultExt = "txt"
CommonDialog1.Action = 2
Open CommonDialog1.FileName For Output As #1
Print #1, Text2.Text
Close #1
End Sub
三、解密
Function UnCode(ByVal s$, ByVal key%)
Dim c As String * 1, iAsc%
UnCode = ""
For i = 1 To Len(s)
c = Mid$(s, i, 1)
Select Case c
Case "A" To "Z"
iAsc = Asc("c") - key
If iAsc < Asc("A") Then iAsc = iAsc + 26
UnCode = UnCode + Chr(iAsc)
Case "a" To "z"
iAsc = Asc(c) - key
If iAsc < Asc("a") Then iAsc = iAsc + 26
UnCode = UnCode + Chr(iAsc)
Case Else
UnCode = UnCode + c
End Select
Next i
End Function

Private Sub closeClick()
Form2.Hide
Form1.Show
End Sub

Private Sub Jiemi_Click()
Text2 = UnCode(Text1, 2)
End Sub

Private Sub open_Click()
CommonDialog1.Action = 1
Text1.Text = ""
Open CommonDialog1.FileName For Input As #1
Dim counter As Integer
Dim workarea(25000) As String
ProgressBar1.min = LBound(workarea)
ProgressBar1.max = UBound(workarea)
ProgressBar1.Visible = True
ProgressBar1.Value = ProgressBar1.min
For counter = LBound(workarea) To UBound(workarea)
workarea(counter) = "initial value " & counter
ProgressBar1.Value = counter
Next counter
Do While Not EOF(1)
Line Input #1, inputdata
Text1.Text = Text1.Text + inputdata + vbCrLf
Loop
Close #1
End Sub

Private Sub save_Click()
CommonDialog1.FileName = "a.txt"
CommonDialog1.DefaultExt = "txt"
CommonDialog1.Action = 2
Open CommonDialog1.FileName For Output As #1
Print #1, Text2.Text
Close #1
End Sub
四、蝴蝶飞舞

Private Sub Form_Load()
Print "蝴蝶飞出窗体后重新定位到左下方再向右上方飞"
End Sub

Private Sub Timer1_Timer()
Static PickBmp As Integer
If PickBmp = 0 Then
Image1.Picture = Image2.Picture
PickBmp = 1
Else
Image1.Picture = Image3.Picture
PickBmp = 0
End If
Call mymove
End Sub
Sub mymove()
Image1.Move Image1.Left + 40, Image1.Top - 25
If Image1.Top <= 0 Then
Image1.Left = 0
Image1.Top = 2325
End If
End Sub
图：

五、文本编辑
Private Sub Copy_Click()
Clipboard.Clear
Clipboard.SetText RichTextBox1.SelText
End Sub

Private Sub Cut_Click()
Clipboard.Clear
Clipboard.SetText RichTextBox1.SelText
RichTextBox1.SelText = ""
End Sub

Private Sub Exit_Click()
Form3.Hide
Form1.Show
End Sub

Private Sub Font_Click()
CommonDialog1.Flags = cdlCFBoth Or cdlCFEffects
CommonDialog1.Action = 4
RichTextBox1.FontName = CommonDialog1.FontName
RichTextBox1.FontSize = CommonDialog1.FontSize
RichTextBox1.FontBold = CommonDialog1.FontBold
RichTextBox1.FontItalic = CommonDialog1.FontItalic
RichTextBox1.FontStrikethru = CommonDialog1.FontStrikethru
RichTextBox1.FontUnderline = CommonDialog1.FontUnderline
RichTextBox1.ForeColor = CommonDialog1.Color
End Sub

Private Sub Form_Load()
Print "注："
Print "1.'打开'对话框的初始文件夹应是所要打开文件所在的"
Print "文件夹，将提供的xz.txt文件打开；"
Print "2.要实现将选定的内容格式化，必须在工具箱中添加"
Print "RichTextBox控件（Microsoft Rich Textbox Comtrol 6.0）"
Print "并在帮助菜单中查阅其字体设置的相关属性。"
Print "3.TichTextBox中要设置垂直滚动条，文本格式化时要将选"
Print "定的内容格式化。"
End Sub

Private Sub Label1_Click()

End Sub

Private Sub open_Click()
CommonDialog1.Action = 1
RichTextBox1.Text = ""
Open CommonDialog1.FileName For Input As #1
Do While Not EOF(1)
Line Input #1, inputdata
RichTextBox1.Text = RichTextBox1.Text + inputdata + vbCrLf
Loop
Close #1
End Sub

Private Sub Paste_Click()
RichTextBox1.SelText = Clipboard.GetText
End Sub

Private Sub Print_Click()
CommonDialog1.Action = 5
For i = 1 To CommonDialog1.Copies
Printer.Print RichTextBox1.Text
Next i
Printer.EndDoc
End Sub

Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then PopupMenu EditMenu, vbPopupMenuCenterAlign
End Sub

Private Sub save_Click()
CommonDialog1.Action = 2
Print #1,
Close #1
End Sub

Private Sub SaveAs_Click()
CommonDialog1.FileName = "default.Txt"
CommonDialog1.DefaultExt = "Txt"
CommonDialog1.Action = 2
Open CommonDialog1.FileName For Output As #1
Print #1, RichTextBox1.Text
Close #1
图：

六、统计
Dim a(0 To 9), i%, min%, max%, ave%
Private Sub Command1_Click()
Dim j%, imin%, s%, t%
Form5.Cls
CurrentX = 0
CurrentY = 0
For i = 0 To 9
a(i) = Int(Rnd * 90 + 10)
s = s + a(i)
Print a(i);
Next i
ave = s / 10
For i = 0 To 8
imin = i
For j = i + 1 To 9
If a(j) < a(imin) Then imin = j
Next j
t = a(i)
a(i) = a(imin)
a(imin) = t
Next i
End Sub

Private Sub Command2_Click()
Print ""
For i = 0 To 9
Print a(i);
Next i
End Sub

Private Sub Command3_Click()
Print ""
Print a(9)
End Sub

Private Sub Command4_Click()
Print ""
Print a(0);
End Sub

Private Sub Command5_Click()
Print ""
Print ave;
End Sub

Private Sub Command6_Click()
Form1.Show
Form5.Hide
End Sub

Private Sub Form_Load()
Print "将随机产生的10个2位数升序排序，并求出其最大值、最小"
Print "值和平均值。"
End Sub
图：

七小球跳动
Dim d As Boolean
Private Sub Form_Load()
Shape1.Shape = 3
Shape1.FillColor = vbRed
Shape1.FillStyle = 0
Timer1.Interval = 20
End Sub
Private Sub Timer1_Timer()
If Not d Then
If Shape1.Top < Form6.ScaleHeight - Shape1.Height Then
Shape1.Top = Shape1.Top + 100
Else
d = Not d
End If
Else
If Shape1.Top > 100 Then
Shape1.Top = Shape1.Top - 100
Else
d = Not d
End If
End If
End Sub
图：

八、计算器（彩票摇奖）

Private Sub Command1_Click()
Dim x, i%, a%(0 To 4), j%
Randomize
For i = 0 To 4
Do
a(i) = Int(Rnd * 30)
For j = 0 To i - 1
If a(i) = a(j) Then Exit For
Next j
Loop While j < i
x = a(i) & " " & x
Text1 = x
Next i

End Sub

Private Sub Command2_Click()
Dim b%(0 To 4), k%, l%, q%, r%, y As String, c

y = Trim$(Text1)
c = Split(y, " ")

Randomize
n = 0
For k = 0 To 4
Do
b(k) = Int(Rnd * 30)
For l = 0 To k - 1
If b(k) = b(l) Then Exit For
Next l
Loop While l < k
Next k
For q = 0 To 4
For r = 0 To 4
If b(q) = c(r) Then
n = n + 1
End If
Next r
Next q

If n = 0 Then
Cls
Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"
Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"
Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"
Print "获4等奖......程序运行界面如样本所示。"
CurrentY = 1900
CurrentX = 300
Print "本期中奖号码为：" & b(0); b(1); b(2); b(3); b(4)
Print ""
CurrentX = 300
Print "对不起，您没有中奖"
ElseIf n = 1 Then
Cls
Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"
Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"
Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"
Print "获4等奖......程序运行界面如样本所示。"
CurrentY = 1900
CurrentX = 300
Print "本期中奖号码为：" & b(0); b(1); b(2); b(3); b(4)
Print ""
CurrentX = 300
Print "恭喜了，您中了五等奖"
ElseIf n = 2 Then
Cls
Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"
Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"
Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"
Print "获4等奖......程序运行界面如样本所示。"
CurrentY = 1900
CurrentX = 300
Print "本期中奖号码为：" & b(0); b(1); b(2); b(3); b(4)
Print ""
CurrentX = 300
Print "恭喜了，您中了四等奖"
ElseIf n = 3 Then
Cls
Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"
Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"
Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"
Print "获4等奖......程序运行界面如样本所示。"
CurrentY = 1900
CurrentX = 300
Print "本期中奖号码为：" & b(0); b(1); b(2); b(3); b(4)
Print ""
CurrentX = 300
Print "恭喜了，您中了三等奖"
ElseIf n = 4 Then
Cls
Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"
Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"
Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"
Print "获4等奖......程序运行界面如样本所示。"
CurrentY = 1900
CurrentX = 300
Print "本期中奖号码为：" & b(0); b(1); b(2); b(3); b(4)
Print ""
CurrentX = 300
Print "恭喜了，您中了二等奖"
ElseIf n = 5 Then
Cls
Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"
Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"
Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"
Print "获4等奖......程序运行界面如样本所示。"
CurrentY = 1900
CurrentX = 300
Print "本期中奖号码为：" & b(0); b1); b(2); b(3); b(4)
Print ""
CurrentX = 300
Print "恭喜了，您中了一等奖"
End If

End Sub
Private Sub Command3_Click()
Form1.Show
Form7.Hide
End Sub

Private Sub Form_Load()
Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"
Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"
Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"
Print "获4等奖......程序运行界面如样本所示。"
End Sub
图：

九、学生信息录入
Private Sub Command1_Click()
List1.Clear
List1.AddItem Text1
If Option1 Then
List1.AddItem "男"
Else
List1.AddItem "女"
End If
List1.AddItem Text2
List1.AddItem Text3
If Check1 Then
List1.AddItem Check1.Caption
End If
If Check2 Then
List1.AddItem Check2.Caption
End If
If Check3 Then
List1.AddItem Check3.Caption
End If
If Check4 Then
List1.AddItem Check4.Caption
End If
If Check5 Then
List1.AddItem Check5.Caption
End If
If Check6 Then
List1.AddItem Check6.Caption
End If
List1.AddItem Combo1.Text
End Sub

Private Sub Form_Load()
Print "将学生的信息录入窗口的信息在基本信息框内"
Print "显示出来。"
Combo1.AddItem "计算机科学与技术"
Combo1.AddItem "信息管理"
Combo1.AddItem "信息工程"
Combo1.AddItem "软件理论与应用"
Combo1.AddItem "测绘"
Combo1.Text = ""
End Sub

Private Sub Text2_LostFocus()
If Text2 <> "0000年00月00日" Then
MsgBox "日期格式范式为：1985年01月01日"
End If
End Sub
图：

十、矩阵转置
Dim a(3, 3), b(3, 3) As Integer, i, j As Integer
Private Sub Command1_Click()
Picture1.Cls
For i = 0 To 3
For j = 0 To 3
a(i, j) = Int(Rnd * 90 + 10)
Picture1.Print Tab(j * 8); a(i, j);
Next j
Picture1.Print
Next i
End Sub
Private Sub Command2_Click()
Picture2.Cls
For i = 0 To 3
For j = 0 To 3
b(i, j) = a(j, i)
Picture2.Print Tab(j * 8); b(i, j);
Next j
Picture2.Print
Next i
End Sub

Private Sub Command3_Click()
Form1.Show
Form9.Hide
End Sub

Private Sub Form_Load()
Print "转置前的矩阵：4×4的两位随机整数 转置后的矩阵："
End Sub
图：

18