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