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

将圆周等分成

份；

Print < /p>

每个等分点要标记成

0-16

的数字；< /p>

Print

按样本图的图案画图。

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

iAsc = Asc(c) + key

If iAsc > Asc(

code = code + Chr(iAsc)

Case

iAsc = Asc(c) + key

If iAsc > Asc(

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

= 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 =

= 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

iAsc = Asc(

If iAsc < Asc(

UnCode = UnCode + Chr(iAsc)

Case

iAsc = Asc(c) - key

If iAsc < Asc(

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

= 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 =

= 2

Open me For Output As #1

Print #1,

Close #1

End Sub

四、蝴蝶飞舞

Private Sub Form_Load()

Print

蝴蝶飞出窗体后重新定位到左下方再向右上方飞< /p>

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

打开

'

对话框的初始文件夹应是所要打开文件所在的

Print

文件夹，将提供的

文件打开；

Print < /p>

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

Print

控件（

Microsoft Rich Textbox Comtrol 6.0

）

Print

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

Prin t

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

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 =

= 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

图：