VB爱心屏保

小歆13年前软件源码01473
'运行后可以后到一个由圆画成的爱心,送给好孩呵呵 
'分辨率=1024*768 
'要生成文件的后缀名为scr 
'窗体样式要改为Me.BorderStyle = 0 
Dim X1, Y1, X2, Y2 As Integer 
Dim I As Integer 
Dim J As Boolean 
Dim K As Integer 

Dim WithEvents Label1 As Label '声明一个label 
Dim WithEvents Timer1 As Timer '声明一个timer 

Private Sub Form_Activate() 
I = 100 
K = 100 
X1 = Me.Width / 2 
Y1 = Me.Height / 3 
X2 = X1 
Y2 = Y1 

Rem 设置label的位置 
Label1.Top = Me.Height / 2 - Label1.Height / 2 
Label1.Left = Me.Width / 2 - Label1.Width / 2 
End Sub 

Private Sub Form_Load() 
Me.BackColor = &H0& '窗体的背景色为黑色 
Me.FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255) '窗体的填充色为随机 
Me.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255) '窗体的前景色为随机 
Me.DrawMode = 13 '窗体输出的外观为13 
Me.DrawWidth = 2 '窗体输出的线条宽度为2 
Me.FillStyle = 7 '窗体的填充样式为7 

Set Label1 = Me.Controls.Add("VB.Label", "Label1") '设置label 
Set Timer1 = Me.Controls.Add("VB.Timer", "Timer1") '设置timer 

Label1.Visible = True 'label可见性为true 
Label1.AutoSize = True 'label自动调整大小 
Label1.BackStyle = 0 'label背景色为透明 
Label1.Caption = "I LOVE YOU" '设置标题 
Label1.Font.Size = 60 '字体大小为60 
Label1.ForeColor = &HFF00& 'label前景色为黑色 

Timer1.Enabled = True 'timer为有效 
Timer1.Interval = 10 'timer时间 间隔为0.001秒 

Me.WindowState = 2 '窗体展开样式 
End Sub 

Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Static currentX, currentY As Single 
Dim orignX, orignY As Single 
'把当前的鼠标值赋给orignX和orignY 
orignX = X 
orignY = Y 
'初始化currentX和currentY 
If currentX = 0 And currentY = 0 Then 
currentX = orignX 
currentY = orignY 
Exit Sub 
End If 
If Abs(orignX - currentX) > 1 Or Abs(orignY - currentY) > 1 Then 
End 
End If 
End Sub 

Private Sub Timer1_Timer() 
Me.Circle (X1, Y1), 250 '在窗体上画圆 
Me.Circle (X2, Y2), 250 '在窗体上画圆 

If Y1 <= Me.Height - 1200 Then '在指定高度运行 
X1 = X1 + K 
Y1 = Y1 - I 
X2 = X2 - K 
Y2 = Y2 - I 
I = I - 2 
If Y1 <= Me.Height / 3 Then 
K = K - 1 
ElseIf Y1 >= Me.Height / 3 Then 
K = K - 5 
End If 
Else 
I = 100 
K = 100 
X1 = Me.Width / 2 
Y1 = Me.Height / 3 
X2 = X1 
Y2 = Y1 

Me.FillColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255) '窗体的填充色为随机 
Me.ForeColor = RGB(Rnd * 255, Rnd * 255, Rnd * 255) '窗体的前景色为随机 

End If 

Me.DrawWidth = 3 '窗体输出的线条宽度为3 
'在窗体上随机画点 
Me.PSet (Rnd * Me.Width, Rnd * Me.Height), RGB(Rnd * 225, Rnd * 225, Rnd * 225) 
Me.DrawWidth = 2 '窗体输出的线条宽度为2 
End Sub 
'''''''''''''''''''''''''''''' 
'在窗体上单击鼠标时退出程序 
Private Sub Form_Click() 
End 
End Sub 
'在窗体上按下按键时退出程序 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 
End 
End Sub 

'在窗体上移动鼠标时退出程序 
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
Static currentX, currentY As Single 
Dim orignX, orignY As Single 
'把当前的鼠标值赋给orignX和orignY 
orignX = X 
orignY = Y 
'初始化currentX和currentY 
If currentX = 0 And currentY = 0 Then 
currentX = orignX 
currentY = orignY 
Exit Sub 
End If 
If Abs(orignX - currentX) > 1 Or Abs(orignY - currentY) > 1 Then 
End 
End If 
End Sub 

相关文章

VB代码优化的六条军规

       在优化程序代码大小的诸多技术中,大多包括从代码中删除不必要的元素。在编译应用程序时,Visual Basic自动删除某些元素。而标识符名称、...

VB自删除模块源码

运行后能够删除自己。 提示:不要在VB的IDE下运行,否则会删除VB6.exe。一定要编译后运行。 下载地址:VB自删除源码.rar 部分源码: Pri...

Discuz附件下载权限绕过工具.png

[小歆][Discuz附件下载权限绕过工具][V1.1][2014.03.13]

Discuz附件下载权限绕过工具V1.1 本软件利用Discuz论坛的漏洞来下载论坛的附件。 【Discuz3.X的有部分好像已经失效了,自测,我刚刚测试了一个3.X论坛还是...

实现VB与EXCEL的无缝连接

  VB是常用的应用软件开发工具之一,由于VB的报表功能有限,而且一但报表格式发生变化,就得相应修改程序,给应用软件的维护工作带来极大的不便。因此有很多程序员现在已经充分利用EXECL的强大...

VB获取本机公网IP源码

Function HttpGet(url) With CreateObject("Msxml2.ServerXMLHTTP") .open "GET", url, Fa...

VB字符串函数大全

Abs(number) 返回绝对值。 Array(arglist) 创建一个数组。 Asc(string) 返回字符串第一个字符的ANSI码。 Atn(number) 返回反...

发表评论    

◎欢迎参与讨论,请在这里发表您的看法、交流您的观点。