介绍一个VB小的有趣的程序代码

'万花筒程序

'粘贴下面代码即可, 不用添加任何控件

Private WithEvents Timer1 As Timer

Dim r&, r1&, t&, a1!, a2!, xb!, yb!, s!, b#

Private Sub Form_Load()

      Me.Width = 4500: Me.Height = 4500

      Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2

      Me.AutoRedraw = True

      Me.Caption = "CBM666的万花筒"

      Set Timer1 = Controls.Add("vb.timer", "Timer1")

      Timer1.Interval = 10

End Sub

Private Sub Timer1_Timer()

      Randomize

      r = 340 * Rnd

      If r <> 0 Then

         r1 = 500

         s = r * Rnd

         b = RGB(256 * Rnd, 256 * Rnd, 256 * Rnd)

         For t = 1 To 10000

            a1 = t * 3.1415926 / 180

            a2 = (r1 / r) * a1

            xb = 500 + (-(r1 - r) * Cos(a1) - s * Cos(a2 - a1) + 420) * 4

            yb = 500 + ((r1 - r) * Sin(a1) - s * Sin(a2 - a1) + 380) * 4

            Me.PSet (xb, yb), b

         Next t

      End If

End Sub

窗体放两个Label控件，一个Timer控件：

Dim n As Integer

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case vbKeyUp

If Label1.Top >0 Then Label1.Top = Label1.Top - 50

Case vbKeyDown

If Label1.Top <ScaleHeight - Label1.Height Then Label1.Top = Label1.Top + 50

Case vbKeyLeft

If Label1.Left >0 Then Label1.Left = Label1.Left - 50

Case vbKeyRight

If Label1.Left <ScaleWidth - Label1.Width Then Label1.Left = Label1.Left + 50

End Select

Call check

End Sub

Private Sub check()

If Abs(Label1.Top - Label2.Top) <= 50 And Abs(Label1.Left - Label2.Left) <= 50 Then

n = n + 1

Label2.Move Rnd * ScaleWidth, Rnd * ScaleHeight

End If

End Sub

Private Sub Form_Load()

KeyPreview = True

Randomize

With Label1

.Caption = ""

.BackColor = vbWhite

.Move (ScaleWidth - .Width) / 2, (ScaleHeight - .Height) / 2, 500, 500

End With

With Label2

.Caption = ""

.BackColor = vbYellow

.Move Rnd * ScaleWidth, Rnd * ScaleHeight, 500, 500

End With

Timer1.Interval = 60000

Timer1.Enabled = True

End Sub

Private Sub Timer1_Timer()

MsgBox "这局对准了" &n &"次黄方块"

Unload Me

End Sub

---