表白程序 VB源码.docx
《表白程序 VB源码.docx》由会员分享，可在线阅读，更多相关《表白程序 VB源码.docx（18页珍藏版）》请在冰豆网上搜索。
表白程序VB源码
PrivateDeclareFunctionmciSendStringLib"winmm.dll"Alias"mciSendStringA"（ByVallpstrCommandAsString,ByVallpstrReturnStringAsString,ByValuReturnLengthAsLong,ByValhwndCallbackAsLong）AsLong'mcisendstring播放音乐的API函数
PrivateDeclareFunctiontimeGetTimeLib"winmm.dll"（）AsLong'用于制作延时函数
DimWithEventsimgMGAsImage'申明控件数组
DimiAsInteger'全局变量
DimimgBox（999）AsImage'记录控件数组的数组
DimratioAsDouble
PrivateSubForm_Load（）
Me.Show
Me.BorderStyle=0
Me.WindowState=2
Picture1.Top=0
Picture1.Left=0
Picture1.Width=20480'图片框宽度等于屏幕宽度
Picture1.Height=11510'
ratio=Picture1.Width/Picture1.Height
Picture1.Scale（-ratio/2,1）-（ratio/2,-1）
Picture1.BackColor=vbWhite
DrawLines0,0
Image1（0）.Picture=LoadPicture（App.Path&"\红玫瑰.gif"）
Label1.Top=0
Label1.Left=0
Label1.FontBold=True
Label1.ForeColor=vbRed
Label1.Caption=""
Label2.Visible=False
'CallBB
EndSub
PrivateSubLabel2_Click（）
mciSendString"closemovie",0&,0,0
UnloadMe'退出程序
EndSub
PrivateSubBB（）'本程序主要的函数，功能都在里实现
CallMusicPlay'播放音乐
Forj=1To99
X=Rnd*20480
Y=Rnd*11510
i=i+1
LoadImage1（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
Sleep2200
Label1.Caption=i&"送上99朵玫瑰，代表我的心！
"
Nextj
Label1.Caption="我们一起长长久久"'随机“画”出99朵玫瑰
nullMeiGuii'“察”去玫瑰清屏，下同
Label1.Caption=""
MeiGui"TX.tat"
Label1.Caption="你和你的名字在我心中"
Sleep23000
nullMeiGuii'画出桃心
Label1.Caption=""
MeiGui"ILU.tat"
Label1.Caption="ILOVEU"
Sleep23000
nullMeiGuii'画出iloveu
Label1.Caption=""
MeiGui"XHM.tat"
Label1.Caption="喜欢吗？
"
Y=MsgBox（"告诉我你喜欢吗？
",vbYesNo,"我想知道"）
IfY=vbYesThen
nullMeiGuii
MeiGui"XL.tat"
Label1.Caption="你喜欢，我很开心"
OpenApp.Path&"\DA.tat"ForAppendAs#1
Print#1,"我喜欢"
Close#1
Else
nullMeiGuii
MeiGui"KL.tat"
Label1.Caption="你不喜欢，我很难过"
OpenApp.Path&"\DA.tat"ForAppendAs#1
Print#1,"我不喜欢"
Close#1
EndIf
Label2.Visible=True
Label2.ForeColor=vbRed
Label2.Caption="点这里退出"
Label2.Top=Picture1.Height-Label2.Height
Label2.Left=Picture1.Width/2-Label2.Width/2
EndSub
PrivateSubMusicPlay（）'音乐播放函数
mName=App.Path&"\DDN.mp3"'获取音乐文件地址及文件名，音乐文件放在当前文件夹下，App.Path即为我去程序所在当前文件夹路径
mciSendString"closemovie",0&,0,0
mciSendString"open"&mName&"TYPEMPEGVideoAliasmovie",0&,0,0'注意open后有个空格，TYPE前有个空格，否则播放不成功
mciSendString"playmovierepeat",0&,0,0
mciSendString"playmovie",0&,0,0
EndSub
PrivateSubMeiGui（ByValstrFileAsString）'用玫瑰绘制想要写的字或图片，文件是事先做好的,可以通过代码下面的代码完成
OpenApp.Path&"\"&strFileForInputAs#1
WhileNotEOF
（1）
Sleep2（200）
Input#1,X,Y
i=i+1
LoadImage1（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
EndSub
PrivateSubnullMeiGui（ByValNAsInteger）'通过释放控件数组清屏
Forj=NTo1Step-1
Sleep2（200）
UnloadImage1（j）
Nextj
i=0
EndSub
PrivateFunctionSleep2（TAsLong）'延时函数
DimSavetimeAsLong
Savetime=timeGetTime'记下开始时的时间，以毫秒为单位
WhiletimeGetTimeDoEvents'转让控制权
Wend
EndFunction
PrivateSubPicture1_MouseDown（ButtonAsInteger,ShiftAsInteger,XAsSingle,YAsSingle）'用点描记出要绘制的图画或文字，记录的数据保存在c_drawable.tat，复制出去可用
Picture1.FillStyle=0
Picture1.FillColor=vbRed
Picture1.Circle（X,Y）,0.01,vbRed
OpenApp.Path&"\c_drawable.tat"ForAppendAs#1
Print#1,X&"f,","0.0f,",Y&"f,";记录点击的位置
Close#1
EndSub
PrivateSubDrawLines（ByValXAsLong,ByValYAsLong）'画网格，描记图形时用
Picture1.FillStyle=0
Picture1.FillColor=vbRed
Picture1.Line（0,1）-（0,-1）
Picture1.Line（-ratio/2,0）-（ratio/2,0）
EndSub
程序中用到的图片资源：
红玫瑰.gif
ILU.tat文件记录的数据
15752295
15303450
15754590
15155775
14856885
14708025
38852310
38553465
39004590
38405760
38406900
37657995
45608040
56107995
70653045
60154065
58655340
60156420
66757320
71407590
77557080
81606165
81604995
76653840
85352850
88053765
90904980
93155985
95556870
100507485
107556660
112205595
114304515
116853525
118502730
125252685
131702685
142052685
124053735
124204875
124505820
124206780
123907545
134107500
144757590
131255040
139354995
160802685
160653810
162155010
165606090
171457200
179707260
184806345
186605175
189003930
189303195
190052625
其他文件数据附于文末
运行时截图：
程序运行是动态的，这是瞬间截图
TX.tat数据
升级会员 