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