-
Private
Declare
Function
mciSendString
Lib
Alias
(ByVal
lpstrCommand As String, ByVal
lpstrReturnString As String, ByVal uReturnLength
As Long, ByVal
hwndCallback As Long) As
Long
'mcisendstring
< br>播放音乐的
API
函数
Private Declare Function timeGetTime
Lib
用于制作延时函数
Dim
WithEvents imgMG As Image
'
申明控件数组
Dim i As
Integer '
全局变量
Dim
imgBox(999) As Image
'
记录控件数组的数组
Dim
ratio As Double
Private Sub Form_Load()
Style = 0
State
= 2
= 0
= 0
= 20480
'
图片框宽度等于屏幕宽度
= 11510 '
ratio
= /
(-ratio / 2,
1)-(ratio / 2, -1)
lor =
vbWhite
DrawLines 0, 0
Image1(0).Picture =
LoadPicture(
&
红玫瑰
.gif
= 0
= 0
ld = True
lor = vbRed
n =
e = False
'Call BB
End Sub
Private Sub Label2_Click()
mciSendString
Unload Me
'
退出程序
End Sub
Private Sub BB()
'
本程序主要的函数，功能都在里实现
Call MusicPlay
'
播放音乐
For j = 1 To 99
X = Rnd * 20480
Y = Rnd * 11510
i = i + 1
Load Image1(i)
Image1(i).Picture = Image1(0).Picture
Image1(i).Width = Image1(0).Width
Image1(i).Height = Image1(0).Height
Image1(i).Top = Y
Image1(i).Left = X
Image1(i).Visible = True
Sleep2 200
n = i &
< br>送上
99
朵玫瑰，代表我的心！
Next j
n =
我们一起长长久久
< br>'
随机“画”出
99
朵玫瑰
nullMeiGui i
'
“察”去玫瑰清屏，下同
n =
MeiGui
n =
你和你的名字在我心中
Sleep2 3000
nullMeiGui i
'
画出桃心
n =
MeiGui
n =
Sleep2 3000
nullMeiGui i '
画出
i
love u
n =
MeiGui
n =
喜欢吗？
Y = MsgBox(
告诉我你喜欢吗？
我想知道
If Y = vbYes Then
nullMeiGui i
MeiGui
n =
你喜欢，我很开心
Open &
Print #1,
我喜欢
Close #1
Else
nullMeiGui i
MeiGui
n =
你不喜欢，我很难过
Open &
Print #1,
我不喜欢
Close #1
End If
e = True
lor = vbRed
n =
点这里退出
= -
= / 2 - / 2
End Sub
Private Sub
MusicPlay() '
音乐播放函数
mName = &
获取音乐文件地址及文件名，
音乐文件放在当前文件夹
下，
即为我去程序所在当前文件夹路径
mciSendString
mciSendString
注意
o
pen
后有
个空格，
TYPE
前有个空格，否则播放不成功
mciSendString
mciSendString
End Sub
Private Sub MeiGui(ByVal
strFile As String) '
用玫瑰绘制想要写的字或图片，
文件是事先做好的
,
可以通过代码下面的代码完成
Open &
While Not EOF(1)
Sleep2 (200)
Input #1, X, Y
i = i + 1
Load Image1(i)
Image1(i).Picture =
Image1(0).Picture
Image1(i).Width = Image1(0).Width
Image1(i).Height = Image1(0).Height
Image1(i).Top =
Y - Image1(0).Height / 2
Image1(i).Left = X - Image1(0).Width /
2
Image1(i).Visible = True
Wend
Close #1
End Sub
Private Sub
nullMeiGui(ByVal N As Integer)
'
通过释放控件数组清屏
For j = N To 1
Step -1
Sleep2 (200)
Unload Image1(j)
Next j
i = 0
End Sub
Private Function Sleep2(T
As Long) '
延时函数
Dim
Savetime As Long
Savetime =
timeGetTime '
记下开始时的时间，以毫秒为单位
While timeGetTime < Savetime + T
'
循环等待
DoEvents '
转让控制权
Wend
End Function
Private Sub
Picture1_MouseDown(Button As Integer, Shift As
Integer, X As Single, Y As Single) '
用
点描记出要绘制的图画或文字，记录的数据保存在
c_
，复制出去可用
yle = 0
lor = vbRed
(X, Y), 0.01, vbRed
Open &
Print #1, X
&
记录点击的位置
Close #1
End Sub
Private Sub DrawLines(ByVal
X As Long, ByVal Y As Long)
'
画网格，描记图形时用
yle = 0
lor
= vbRed
(0, 1)-(0, -1)
(-ratio / 2, 0)-(ratio /
2, 0)
End Sub
程序中用到的图片资源：红玫瑰
.gif
文件记录的数据
1575
2295
1530
3450
1575
4590
1515
5775
1485
6885
1470
8025
3885
2310
3855
3465
3900
4590
3840
5760
3840
6900
3765
7995
4560
8040
5610
7995
7065
3045
6015
4065
5865
5340
6015
6420
6675
7320
7140
7590
7755
7080
8160
6165
8160
4995
7665
3840
8535
2850
8805
3765
9090
4980
9315
5985
9555
6870
10050
7485
10755
6660
11220
5595
11430
4515
11685
3525
11850
2730
12525
2685
13170
2685
14205
2685
12405
3735
12420
4875
12450
5820
12420
6780
12390
7545
13410
7500
14475
7590
13125
5040
13935
4995
16080
2685
16065
3810
16215
5010
16560
6090
17145
7200
17970
7260
18480
6345
18660
5175
18900
3930
18930
3195
19005
2625
其他文件数据附于文末
运行时截图：
程序运行是动态的，这是瞬间截图
数据
8835
3300
8160
2895
7140
2490
6195
2610
5655
3315
5505
4305
5685
5460
6120
6465
6945
7380
7680
8145
8460
8625
9270
8910
10065
8580
10935
8040
11520
7410
12135
6525
12615
5595
12960
4425
13020
3540
12885
2685
12345
2130
11655
2115
10800
2370
9960
2745
9435
3030
7605
2640
6555
2520
5820
2955
5565
3795
5565
4935
5895
6030
6465
6840
7290
7755
8070
8355
8895
8730
9720
8685
10500
8235
11205
7680
11775
6855
12330
6015
12840
5025
8580
4650
7725
4140
7515
5265
-
-
-
-
-
-
-
-
-
上一篇：常用原材料中英文名称对照表
下一篇：冀教版小学六年级下册英语教案11