VB爱心屏保

小歆14年前 (2012-06-02)软件源码03559

'运行后可以后到一个由圆画成的爱心,送给好孩呵呵 
'分辨率=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