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

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

一、鸟巢绘制

二、加密

三、解密

四、蝴蝶飞舞

五、文本编辑

六、统计

七、小球跳动

八、计算器（彩票摇奖）

九、学生信息录入

十、矩阵转置

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

十二、加减乘除随机数题

十三、计算器

十四、抽奖

一、鸟巢绘制

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

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); b(1); 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

图：

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

Public Class Form1

Dim timers As Integer

Dim temp As Integer

Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

If (ProgressBar1.Value + ProgressBar1.Maximum / timers < ProgressBar1.Maximum) Then

ProgressBar1.Value += ProgressBar1.Maximum / timers

Else

Timer1.Enabled = False

ProgressBar1.Value = ProgressBar1.Maximum

MessageBox.Show("进度完成！")

End If

temp += 1

Label1.Text = temp.ToString()

End Sub

Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load

timers = 30

End Sub

Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

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

End Sub

Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

Timer1.Enabled = 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 System.Object, ByVal e As System.EventArgs) Handles Button2.Click

If (Label1.Text <> "") Then

TextBox2.Text += Label1.Text + TextBox1.Text

TextBox2.Text += " 结果"

If (sum = Val(TextBox1.Text)) Then

TextBox2.Text += "√" + vbCrLf

Else

TextBox2.Text += "×" + 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

Label1.Text = x.ToString() + "＋" + y.ToString() + "＝"

sum = x + y

Case 2

Label1.Text = x.ToString() + "－" + y.ToString() + "＝"

sum = x - y

Case 3

Label1.Text = x.ToString() + "×" + y.ToString() + "＝"

sum = x * y

Case 4

Label1.Text = x.ToString() + "÷" + y.ToString() + "＝"

sum = x / y

End Select

End Sub

End Class

13、计算器

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 Form1.Tag = "s" Then

If Index = 10 Then

Text1.Text = "0"

Else

Text1.Text = Command1(Index).Caption

End If

Form1.Tag = ""

Else

Text1.Text = Text1.Text & Command1(Index).Caption

End If

End Sub

按钮二的命令

Private Sub Command2_Click(Index As Integer)

Form1.Tag = "s"

If v Then

x = Val(Text1.Text)

v = Not v

Else

y = Val(Text1.Text)

Select Case s

Case 0

Text1.Text = x + y

Case 1

Text1.Text = x - y

Case 2

Text1.Text = x * y

Case 3

If y <> 0 Then

Text1.Text = x / y

Else

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

Text1.Text = x

v = False

End If

Case 4

y = 0

v = False

End Select

x = Val(Text1.Text)

End If

s = Index

End Sub

十四、抽奖

Private Sub Command1_Click()

   Timer1.Enabled = True

   Timer1.Interval = 50

   Command1.Caption = "开始"

   Command2.Caption = "停"

   Randomize

End Sub

Private Sub Command2_Click()

  Timer1.Enabled = False

End Sub

Private Sub Form_Load()

  Label1.Caption = ""

  Label1.FontSize = 50

End Sub

Private Sub Timer1_Timer()

  Label1.Caption = Format(Int(300 * Rnd) + 1, "000")

End Sub

本文来源：https://www.2haoxitong.net/k/doc/de45ac6f5afb770bf78a6529647d27284b733707.html