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