frmtree.frm

一个可以生成美丽仿真树的软件源码,可以真真体现树的效果

    If myTree.recisionValueHi > 0 And startY < myTree.recisionValueHi Then Exit Function    ' It cut high branches.
    
    If myTree.recisionLevelLow > 0 And myTree.recisionValueLow = 0 And myTree.currentStep = myTree.recisionLevelLow - 1 Then myTree.recisionValueLow = startY ' this line and following are for recision level for lower branches
    If myTree.recisionValueLow > 0 And startY > myTree.recisionValueLow And myTree.currentStep > myTree.recisionLevelLow * 0.8 Then startAngle = startAngle Mod 180 + 90 'Exit Function   ' I prefer to change branch direction to up, but you can cut it.
    
    DoEvents
    
    myTree.currentStep = myTree.currentStep + 1
    
    
    ' different width for branches from root to leaves.
    branchWidth = (myTree.widthSize / 50) * (15 + myTree.totalSteps / 4) / (myTree.currentStep ^ ((myTree.widthScale ^ 1.2 - 50) / 75 + 0.2))
    If branchWidth < 1 Then branchWidth = 1

    
    ' length of branch.
    branchSize = (myTree.totalSteps - myTree.currentStep * myTree.leafLevel / 50) * IIf(myTree.leafLevel >= 50, myTree.leafLevel / 50, (myTree.leafLevel + 50) / 100)
    branchSize = IIf(branchSize > 0, branchSize, 1) * (Me.Height / myTree.totalSteps ^ 1.9) * IIf(myTree.fixSize, 1, Rnd(1) * 1.7 + 0.1) * myTree.maxSize / 80
    
    ' more control for height of tree's trunk.
    If myTree.currentStep < 3 Then branchSize = branchSize + Me.Height / (30 * myTree.currentStep) + branchSize * (myTree.trunkHeight / 10 - 4) / (myTree.currentStep + 1.5) * myTree.totalSteps / 15
    
    'calculating end points. [ * Pi / 180] is for changing degrees to radians.
    endX = Sin(startAngle * Pi / 180) * branchSize + startX
    endY = Cos(startAngle * Pi / 180) * branchSize + startY
    
    ' Color of branch
    branchColor = RGB(100, 255 * myTree.currentStep / myTree.totalSteps, 35)
    
    ' this paint tree branch.
    If myTree.currentStep >= myTree.startingBranch Then
        Me.DrawWidth = branchWidth
        Me.Line (startX, startY)-(endX, endY), branchColor
    End If
    
    'this is for making flowers and is the main enhancement from last version.
    If myTree.flowerNeed > 0.1 Then makeFlower endX, endY
    
    
    ' this calculate degree for next branch. beginners can try angleGrow=30
    angleGrow = myTree.sizeOfAngel * IIf(myTree.fixAngel, 1, Rnd(1) * 4 - 2)
    
    ' following line is only for widening effect, in ver 2.
    angleGrow = angleGrow + Sin(angleGrow * Pi / 180) * ((myTree.wideLevel - 500) * 0.3) * myTree.totalSteps / myTree.currentStep


    ' in ver 2, I added this item for different number of branches per step from root to leaves. it uses B.P.S Scale Slider
    branchCount = myTree.branchPerStep + myTree.branchPerStep * 2 * ((myTree.branchPerStepScale - 50) / 50) * ((myTree.currentStep) / myTree.totalSteps)
    If branchCount < 1 Then branchCount = 1
    
    ' this is the place that function run itself again.
    For j = 1 To Int(branchCount)
        newAngle = startAngle * (1 - (myTree.windDirection - 50) / 700) - angleGrow / 2 + angleGrow * (j - branchCount / 2) * IIf(myTree.fixAngel, 1, 1.1 - Rnd(1) * 0.25) ' Mod 360  'for Wind effect I added [* (1 - (myTree.windDirection - 50) / 700)] .
        nextBranch endX, endY, newAngle
    Next
    
    'nextBranch = True
mustOut:
    myTree.currentStep = myTree.currentStep - 1
End Function


'**************************************************************************
'Following lines added in version 2 (except: Form_QueryUnload).



' this procedure makes one Flower and put it on Tree
' because of some reasons, I used another way for making Flowers (not painting), maybe a little difficult for beginners. (one reason : I want to change flowers to fruits after a few seconds)
' I make all of flowers from one base flower at run time [imgFlower(0)], this is like when you make TextBoxes or Menus in run time.
Private Sub makeFlower(ByVal endX As Integer, ByVal endY As Integer)
    Dim i As Integer
    
    If myTree.currentStep > myTree.totalSteps / 2 Then ' flowers are only on higher branches
        If Int(Rnd(1) * myTree.currentStep * 30 ^ ((10 + myTree.branchPerStep) / 10) / myTree.flowerNeed) = 1 Then ' how many flowers ?
            i = imgFlower.UBound + 1 ' get highest number of index (last flower) and add one
            If i > 32760 Then myTree.flowerNeed = 0.1 'almost my Maximum Flowers, this change in variable "flowerNeed" is for preventing from running this procedure again. see "nextBranch" function (I can use another new variable for this.)
            Load imgFlower(i)        ' make new flower from base flower
            With imgFlower(i)        ' following lines set properties of new flower
                .Picture = imgFlower(0).Picture ' I used only one type of flower, you can use multi shapes and use a random statement.
                .Width = 25 + Int(Rnd(1) * ((myTree.flowerSize / 5) ^ 1.6) * 3)
                .Height = .Width
                .Left = endX
                .Top = endY
                .Tag = "Flower" ' I used this property to know this object is a flower or a fruit
                .Visible = True
            End With
        End If
    End If
End Sub


'Timer for changing flowers
Private Sub tmrFruits_Timer()
    Dim myNumber As Integer
    Dim j As Byte
    
    If tmrFruits.Interval > 1000 Then tmrFruits.Interval = 10 + (100 - myTree.fruitSpeed) * 5
    If imgFlower.UBound = 0 Or imgFlower.UBound >= 32760 Then timerState (False): Exit Sub ' this is for preventing from errors when be in some random state.
    
    If myTree.fruitCounter >= imgFlower.UBound / 100 * myTree.fruitMaxChange Then
        timerState (False)
    Else
        For j = 0 To myTree.fruitSpeed / 12
            myNumber = Int(Rnd(1) * imgFlower.UBound) + 1 'select a random flower (or fruit) for change
            changeFlower myNumber
            DoEvents
        Next
    End If
End Sub


' this procedure only change a flower to green and then red fruit, but I put an option for a fun part to removing red fruit
Private Sub changeFlower(ByVal myNumber As Integer, Optional ByVal canRemove As Boolean = False)
    On Error GoTo errHandler ' preventing of one run time error : when timer wants to change flowers, you unload flowers (by closing Form)
    
    Select Case imgFlower(myNumber).Tag
        Case "Flower"
            myTree.fruitCounter = myTree.fruitCounter + 1 ' if you put this line in the Case "Fruit" , results became based on Red Fruits. try It !
            imgFlower(myNumber).Tag = "Fruit" ' this means that this is a Green fruit
            imgFlower(myNumber).Picture = imgFruit1.Picture
    
        Case "Fruit"
            imgFlower(myNumber).Tag = "FinalFruit" ' this means that this is a Red final fruit
            imgFlower(myNumber).Picture = imgFruit2.Picture
            ' I prefer that size of Final fruit became a few bigger . if you don't like, you can remove all 2 following lines
            imgFlower(myNumber).Width = imgFlower(myNumber).Width * 1.7
            imgFlower(myNumber).Height = imgFlower(myNumber).Height * 1.7
    
        Case "FinalFruit"
            ' following statement is only for fun part, but I remark it because when it remove a red fruit, it also destroy branches. try it !
'           If canRemove Then imgFlower(myNumber).Visible = False
            
    End Select
   
    ' you can add several cases and make several new differences  in your flowers and fruits (such as new size and color) by controlling "Tag" property

errHandler:    'just go out
End Sub


' this is for reseting, activating and deactivating Fruit Timer
Private Sub timerState(ByVal myAction As Boolean)
    If myAction Then ' when True
        tmrFruits.Interval = 3000
        tmrFruits.Enabled = True
        frmMain.cmdTimerStop.Visible = True
        If playSound Then sndPlaySound App.Path & "\fruit.wav", 1
    Else
        tmrFruits.Enabled = False
        frmMain.cmdTimerStop.Visible = False
        myTree.fruitCounter = 0
    End If
End Sub


'this is only for fun. when you click on a Flower it chang to a green fruit, then red fruit and then remove ( see changeFlower procedure)
Private Sub imgFlower_Click(Index As Integer)
        changeFlower Index, True
End Sub

'this procedure became active when user want to close Form, maybe timer be active or tree is not complete, I must manually deactivate these actions. ( some changes in frmMain)
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    timerState (False)
    goOut = True
End Sub

' for saving picture by pressing "F2"
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 113 Then savePicture
End Sub


'*****************************************************************************
' Saving picture on hard disk in Jpeg format (added in update 2)
' this part uses cJpeg.cls
Public Sub savePicture()
    On Error GoTo errHandler
    Dim myPath As String
    Dim myJpeg As New cJpeg
    
    Me.Caption = "Saving..."
    myPath = App.Path & "\SavedPics\"
    If Dir(myPath, vbDirectory) = "" Then MkDir myPath
    
    myJpeg.Quality = 85
    myJpeg.Comment = "Real Tree 2"
    myJpeg.SampleHDC frmTree.hDC, Me.ScaleWidth / Screen.TwipsPerPixelX, Me.ScaleHeight / Screen.TwipsPerPixelY
    myJpeg.SaveFile myPath & "Pic_" & Format(Now, "yyyy-mm-dd___hh-mm-ss") & ".jpg"
    Set myJpeg = Nothing
    
    Me.Caption = "Tree"
Exit Sub
errHandler:
    MsgBox Err.Description, vbExclamation, "Error Saving Picture"
End Sub