表白程序 VB源码

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播放音乐的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 & 送上99朵玫瑰，代表我的心！
Next j
n = 我们一起长长久久 '随机“画”出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 注意open后有
个空格，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

6990 4545
6975 3825
6240 4260
6555 3300
7230 3210
8010 3510
8550 3900
8100 5625
7965 4770
6930 5130
6255 4905
6300 5400
6615 6015
7080 5670
7245 6585
7605 6030
6885 6345
7665 7140
8175 7800
7530 7620
8220 6570
8385 7290
8925 6735
8925 7380
8805 7890
8580 8250
9045 8295
9555 7815
9690 8265
10275 7860
9945 7485
9480 7185
10665 7125
10740 7500
11235 7080
10035 6990
9585 6495
8880 6150
8475 5955
8595 5250
9075 5235
9030 5535
9765 5865
9705 5400

9705 4785
9075 4530
9075 3930
9540 3975
9600 3450
10125 3180
10125 3840
10245 4365
9765 4275
10740 3225
10740 2790
11400 2820
11850 2670
12240 2805
12015 3285
11295 3270
11370 3810
10830 3840
10710 4290
11295 4230
12000 4170
11865 3735
12375 3705
12480 3210
10170 4965
10365 5460
11355 5520
11145 5175
10950 5655
10500 6000
10050 6120
10320 6570
10845 6300
11190 6690
10800 6645
11610 6390
11250 6090
10725 4875
11520 4770
11250 4665
12435 4155
12885 3960
12330 4770
12000 4650

11895 5130
12450 5265
11970 5490
11700 5730
11805 6030
12195 5685

数据
1485 2265
2325 2310
3210 2295
4140 2340
5220 2340
3240 1410
3150 2895
3075 3585
2100 3045
4215 3120
1635 4050
2715 4110
4080 4215
1830 4680
2790 4755
3735 4710
3870 5520
1710 5385
1695 6015
2595 6135
3810 6240
1920 6870
3390 6945
450 7800
1515 7785
2745 7800
3960 7800
5295 7770
1305 8475
2070 8505
3270 8520
3315 9390
1155 9180
1170 9840
2175 9900
3360 10020

6405 3615
7290 3645
8400 3615
8100 4335
7155 5325
6570 6285
6165 6795
6780 4590
7740 6135
9375 3000
8985 4035
8685 4830
9750 4005
10770 3990
11580 3990
12435 3915
12045 4725
10200 4485
9750 5295
9270 6015
8805 6780
8295 7440
10230 5895
10695 6540
11160 7230
13845 2655
13845 3480
13845 4335
14745 2640
15465 2595
15525 3540
15495 4335
14625 4320
16410 2565
17250 2625
18105 2535
18630 2520
18360 3630
17925 4590
17610 5205
16950 3480
16635 4410
16095 5325
15495 6045

16800 6015
17910 5955
18825 5895
18765 6765
18435 7680
18300 8415
18105 9120
17430 8595
13710 7335
15195
16440
17250

数据
5505
6900
9000
11100
12000
12270
4905
5145
6465
7650
9765
11505
5985
6810
7695
7860
9030
9435
10260
10845
11250
6720
7260
8070
9045
9600
10020
12240
11565
9990
7290
7275
7230
2985
2340
2055
2310
3630
5835
4800
6495
7635
8475
8280
7320
4080
3855
3960
4410
4470
4125
3885
4155
4770
6210
6675
7005
6885
6390
6090
4785
2865
2040

7725 2115
6165 2595
5115 3870
4905 5580
5760 7080
6945 8055
8595 8430
10605 7755
12030 6525
将上述文件数据复制到文本文件中，后缀名改为tat