VB编写各种趣味小程序(附代码)

VB编写各种趣味小程序（附代码）

一、鸟巢绘制

二、加密

三、解密

四、蝴蝶飞舞

五、文本编辑

六、统计

七、小球跳动

八、计算器（彩票摇奖）

九、学生信息录入

十、矩阵转置

十一、带有进度条的倒计时程序

十二、加减乘除随机数题

十三、计算器

十四、抽奖

一、鸟巢绘制

Private Sub Form_Click()

Cls

Dim r, xi, yi, xj, yj, x0, y0, aif As Single

r = eight / 2

x0 = idth / 2

y0 = eight / 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()

End Sub

Private Sub Jiami_Click()

Text2 = code(Text1, 2)

End Sub

Private Sub open_Click()

= 1

= ""

Open me For Input As #1

Dim counter As Integer

Dim workarea(25000) As String

= LBound(workarea)

= UBound(workarea)

e = True

=

For counter = LBound(workarea) To UBound(workarea)

workarea(counter) = "initial value " & counter

= counter

Next counter

Do While Not EOF(1)

Line Input #1, inputdata

= + inputdata + vbCrLf

Loop

Close #1

End Sub

Private Sub save_Click()

me = ""

tExt = "txt"

= 2

Open me For Output As #1

Print #1,

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 close_Click()

End Sub

Private Sub Jiemi_Click()

Text2 = UnCode(Text1, 2)

End Sub

Private Sub open_Click()

= 1

= ""

Open me For Input As #1

Dim counter As Integer

Dim workarea(25000) As String

= LBound(workarea)

= UBound(workarea)

e = True

=

For counter = LBound(workarea) To UBound(workarea)

workarea(counter) = "initial value " & counter

= counter

Next counter

Do While Not EOF(1)

Line Input #1, inputdata

= + inputdata + vbCrLf

Loop

Close #1

End Sub

Private Sub save_Click()

me = ""

tExt = "txt"

= 2

Open me For Output As #1

Print #1,

Close #1

End Sub

四、蝴蝶飞舞

Private Sub Form_Load()

Print "蝴蝶飞出窗体后重新定位到左下方再向右上方飞"

End Sub

Private Sub Timer1_Timer()

Static PickBmp As Integer

If PickBmp = 0 Then

e = e

PickBmp = 1

Else

e = e

PickBmp = 0

End If

Call mymove

End Sub

Sub mymove()

+ 40, - 25

If <= 0 Then

= 0

= 2325

End If

End Sub

图：

五、文本编辑

Private Sub Copy_Click()

t t

End Sub

Private Sub Cut_Click()

t t

t = ""

End Sub

Private Sub Exit_Click()

End Sub

Private Sub Font_Click()

= cdlCFBoth Or cdlCFEffects

= 4

me = me

ze = ze

ld = ld

alic = alic

rikethru = rikethru

derline = derline

lor =

End Sub

Private Sub Form_Load()

Print "注："

Print "1.'打开'对话框的初始文件夹应是所要打开文件所在的"

Print "文件夹，将提供的文件打开；"

Print "2.要实现将选定的内容格式化，必须在工具箱中添加"

Print "RichTextBox控件（Microsoft Rich Textbox Comtrol 6.0）"

Print "并在帮助菜单中查阅其字体设置的相关属性。"

Print "xtBox中要设置垂直滚动条，文本格式化时要将选"

Print "定的内容格式化。"

End Sub

Private Sub Label1_Click()

End Sub

Private Sub open_Click()

= 1

= ""

Open me For Input As #1

Do While Not EOF(1)

Line Input #1, inputdata

= + inputdata + vbCrLf

Loop

Close #1

End Sub

Private Sub Paste_Click()

t = t

End Sub

Private Sub Print_Click()

= 5

For i = 1 To

Next i

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()

= 2

Print #1,

Close #1

End Sub

Private Sub SaveAs_Click()

me = ""

tExt = "Txt"

= 2

Open me For Output As #1

Print #1,

Close #1

图：

六、统计

Dim a(0 To 9), i%, min%, max%, ave%

Private Sub Command1_Click()

Dim j%, imin%, s%, t%

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()

End Sub

Private Sub Form_Load()

Print "将随机产生的10个2位数升序排序，并求出其最大值、最小"

Print "值和平均值。"

End Sub

图：

七、小球跳动

Dim d As Boolean

Private Sub Form_Load()

= 3

lor = vbRed

yle = 0

al = 20

End Sub

Private Sub Timer1_Timer()

If Not d Then

If < eight - Then

= + 100

Else

d = Not d

End If

Else

If > 100 Then

= - 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); b(1); b(2); b(3); b(4)

Print ""

CurrentX = 300

Print "恭喜了，您中了一等奖"

End If

End Sub

Private Sub Command3_Click()

End Sub

Private Sub Form_Load()

Print "编写一个简易的30选5彩票摇奖程序。功能要求用户可以输入5个不同的整数，或"

Print "者通过‘机选’按钮，自动生成5个互不相同的随机数；单击‘摇奖’按钮，生成中奖号码，"

Print "并对用户输入或机选的彩票数字进行评奖，用户选对1个数字，获5等奖，选对2个数"

Print "获4等奖......程序运行界面如样本所示。"

End Sub

图：

九、学生信息录入

Private Sub Command1_Click()

m Text1

If Option1 Then

m "男"

Else

m "女"

End If

m Text2

m Text3

If Check1 Then

m n

End If

If Check2 Then

m n

End If

If Check3 Then

m n

End If

If Check4 Then

m n

End If

If Check5 Then

m n

End If

If Check6 Then

m n

End If

m

End Sub

Private Sub Form_Load()

Print "将学生的信息录入窗口的信息在基本信息框内"

Print "显示出来。"

m "计算机科学与技术"

m "信息管理"

m "信息工程"

m "软件理论与应用"

m "测绘"

= ""

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()

For i = 0 To 3

For j = 0 To 3

a(i, j) = Int(Rnd * 90 + 10)

Tab(j * 8); a(i, j);

Next j

Next i

End Sub

Private Sub Command2_Click()

For i = 0 To 3

For j = 0 To 3

b(i, j) = a(j, i)

Tab(j * 8); b(i, j);

Next j

Next i

End Sub

Private Sub Command3_Click()

End Sub

Private Sub Form_Load()

Print "转置前的矩阵：4×4的两位随机整数 转置后的矩阵："

End Sub

图：

十一、带有进度条的倒计时程序

Public Class Form1

Dim timers As Integer

Dim temp As Integer

Private Sub Timer1_Tick(ByVal sender As , ByVal e As rgs)

Handles

If ( + m / timers < m)

Then

+= m / timers

Else

d = False

= m

("进度完成！")

End If

temp += 1

= ng()

End Sub

Private Sub Form1_Load(ByVal sender As , ByVal e As rgs)

Handles

timers = 30

End Sub

Private Sub Button2_Click(ByVal sender As , ByVal e As rgs)

Handles

timers = Val(InputBox("输入", "请输入总时间。", 30, 0, 0))

End Sub

Private Sub Button1_Click(ByVal sender As , ByVal e As rgs)

Handles

d = True

End Sub

End Class

十二、加减乘除随机数题

Public Class Form1

Dim x, y As Integer

Dim i As Integer

Dim sum As Integer

Private Sub Button2_Click(ByVal sender As , ByVal e As rgs)

Handles

If ( <> "") Then

+= +

+= " 结果"

If (sum = Val()) Then

+= "√" + vbCrLf

Else

+= "×" + vbCrLf

End If

End If

Randomize()

x = Int(Rnd() * 999 + 1)

y = Int(Rnd() * 999 + 1)

i = Int(Rnd() * 4 + 1)

Select Case i

Case 1

= ng() + "＋" + ng() + "＝"

sum = x + y

Case 2

= ng() + "－" + ng() + "＝"

sum = x - y

Case 3

= ng() + "×" + ng() + "＝"

sum = x * y

Case 4

= ng() + "÷" + ng() + "＝"

sum = x / y

End Select

End Sub

End Class

十三、计算器

Option Explicit

Dim v As Boolean

Dim s As Integer

Dim x As Double

Dim y As Double

按钮一的命令

Private Sub Command1_Click(Index As Integer)

If = "s" Then

If Index = 10 Then

= "0"

Else

= Command1(Index).Caption

End If

= ""

Else

= & Command1(Index).Caption

End If

End Sub

按钮二的命令

Private Sub Command2_Click(Index As Integer)

= "s"

If v Then

x = Val()

v = Not v

Else

y = Val()

Select Case s

Case 0

= x + y

Case 1

= x - y

Case 2

= x * y

Case 3

If y <> 0 Then

= x / y

Else

MsgBox ("不能以0为除数")

= x

v = False

End If

Case 4

y = 0

v = False

End Select

x = Val()

End If

s = Index

End Sub

十四、抽奖

Private Sub Command1_Click()

d = True

al = 50

n = "开始"

n = "停"

Randomize

End Sub

Private Sub Command2_Click()

d = False

End Sub

Private Sub Form_Load()

n = ""

ze = 50

End Sub

Private Sub Timer1_Timer()

n = Format(Int(300 * Rnd) + 1, "000")

End Sub