- Option Explicit
- Dim CreateLines As Integer
- Dim Lines As Integer
- Dim mLine() As Line '树枝
- Dim Fruit() As Shape '果子
- Dim CreateFruit As Integer
- Dim Apple As Integer
- Dim Evaluate As Boolean '是否已经画出了数
- Dim Clear As Integer
- Dim Eraser As Integer
- Dim ShoWApple As Boolean '是否已经显示了果子
- Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) '定时器
- Private Sub Command1_Click() '画出树枝
- If Evaluate=True Then '如果已经画出了树枝
- For Clear=2 To UBound(mLine)
- Set mLine(Clear)=Nothing
- Set Fruit(Clear)=Nothing
- Next
- Controls.Remove("MotherLine")
- For Eraser=2 To UBound(mLine)
- Controls.Remove("linea" & Eraser)
- Controls.Remove("fruta" & Eraser)
- Next
- End If '那么将它们清理
- '否则直接按照TEXT1中设置的数量画出树枝
- '树枝数量
- Lines=Text1.Text
- ReDim mLine(1 To Lines) '定义树枝数组
- Set mLine(1)=Controls.Add("vb.line","MotherLine")
- '初始化树干
- With mLine(1)
- .X1=Form1.ScaleWidth/2
- .X2=Form1.ScaleWidth/2 '据窗体中间
- .Y1=Form1.ScaleHeight
- .Y2=Form1.ScaleHeight-1000 '高度比窗体小1000单位
- .Visible=True '可见
- .BorderWidth=8 '树干宽度8
- .BorderColor=vbBlack '以黑色填充
- End With
- '开始画出树枝
- For CreateLines=2 To Lines
- Set mLine(CreateLines)=Controls.Add("Vb.line","Linea"&CreateLines)
- If CreateLines Mod 2=0 Then
- '向左上方画出随机的直线(树枝)
- With mLine(CreateLines)
- .X1=mLine(CreateLines/2).X2
- .X2=(mLine(CreateLines/2).X2)-Int(Rnd*1000)
- .Y1=mLine(CreateLines/2).Y2
- .Y2=mLine(CreateLines/2).Y2)-Int(Rnd*1000)
- .Visible=True
- .BorderColor=vbGreen '以绿色填充
- .BorderWidth=3 '宽度为3
- End With
- Else
- With mLine(CreateLines)
- '向右上方画出随机的直线
- .X1=mLine((CreateLines-1)/2).X2
- .X2=(mLine((CreateLines-1)/2).X2)+Int(Rnd*1000)
- .Y1=mLine((CreateLines-1)/2).Y2
- .Y2=(mLine((CreateLines-1)/2).Y2)-Int(Rnd*1000)
- .Visible=True
- End With
- End If
- DoEvents
- Sleep(50) '每隔0.05秒画出并且显示一个树干
- Next
- ReDim Fruit(2 To Lines)
- '画出每个树枝结出的果子,但是并不马上显示,直到单击了“结出果子”按钮
- For CreateFruit=2 To Lines
- Set Fruit(CreateFruit)=Controls.Add("vb.shape","fruta"&CreateFruit)
- With Fruit(CreateFruit)
- .Width=200
- .Height=200 '结出果子的大小
- .Left=mLine(CreateFruit).X2-100
- .Top=mLine(CreateFruit).Y2-100 '结果位置
- .FillColor=RGB(255,0,0) '以红色填充
- .FillStyle=0 '边框类型
- .Shape=3 '圆形的的果子
- .ZOrder 0
- End With
- Next
- Evaluate=True '设置树枝已经画出标志
- ShoWApple=False '设置显示果子标志
- Command2.Caption="显示果子" '设置结果按钮标题
- End Sub
- Private Sub Command2_Click() '结出果子按钮按下
- On Error GoTo Erro
- If ShoWApple=False Then
- '如果果子没有显示,那么将它们全部显示出来
- For Apple=LBound(Fruit) To UBound(Fruit)
- Fruit(Apple).Visible=True
- DoEvents
- Sleep (50) '每隔0.05秒显示一个果子
- Next
- ShoWApple=True '重新设置显示果子标志
- Command2.Caption="取消果子"
- Else
- '如果果子已经显示,那么将它们全部隐藏
- For Apple=LBound(Fruit) To UBound(Fruit)
- Fruit(Apple).Visible=False
- Next
- ShoWApple=False 重新设置显示果子标志
- Command2.Caption="显示果子"
- End If
- Erro:
- If Err.Number=9 Then
- MsgBox "必须首先画出数,才能结出果子!"
- End If
- End Sub
- Private Sub Form_Load()
- Me.Caption=App.Title '添加应用程序标题
- Me.Left=(Screen.Width-Me.Width)/2
- Me.Top=(Screen.Height-Me.Height)/2 '窗体具中
- Evaluate=False
- ShoWApple=False
- End Sub
- Private Sub Text1_Validate(Cancel As Boolean)
- ‘验证树枝数量是否为0或者1
- If Text1.Text="" Or Text1.Text=1 Then
- Cancel=True
- MsgBox "必须输入树枝的数量!而且要大于1",vbOKOnly,"Error"
- End If
- End Sub
- Private Sub Form_Unload(Cancel As Integer)
- End
- End Sub '代码结束
- //该片段来自于http://www.codesnippet.cn/detail/14122012980.html
来源: http://www.codesnippet.cn/detail/14122012980.html