表白程序 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() = 0 = 2 = 0 = 0

= 20480 '图片框宽度等于屏幕宽度 = 11510 ' ratio = /

(-ratio / 2, 1)-(ratio / 2, -1) = vbWhite DrawLines 0, 0

Image1(0).Picture = LoadPicture & \红玫瑰.gif\ = 0 = 0 = True = vbRed = \

= 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

= i & \送上99朵玫瑰，代表我的心！\ Next j

= \我们一起长长久久\ '随机“画”出99朵玫瑰 nullMeiGui i '“察”去玫瑰清屏，下同

= \ MeiGui \

= \你和你的名字在我心中\ Sleep2 3000

nullMeiGui i '画出桃心

= \ MeiGui \ = \ Sleep2 3000

nullMeiGui i '画出i love u

= \ MeiGui \

= \喜欢吗？\

Y = MsgBox(\告诉我你喜欢吗？\我想知道\ If Y = vbYes Then nullMeiGui i MeiGui \

= \你喜欢，我很开心\

Open & \ Print #1, \我喜欢\

Close #1 Else

nullMeiGui i MeiGui \

= \你不喜欢，我很难过\ Open & \ Print #1, \我不喜欢\ Close #1 End If

= True = vbRed = \点这里退出\ = -

= / 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) '用点描记出要绘制的图画或文字，记录的数据保存在，复制出去可用

= 0

= vbRed

(X, Y), , vbRed

Open & \

Print #1, X & \记录点击的位置 Close #1

End Sub

Private Sub DrawLines(ByVal X As Long, ByVal Y As Long) '画网格，描记图形时用 = 0 = 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