*/
Are you blogging on PH? Get your free blog.
*/

View Tree1\frmTree.frm

Real Tree v1.0 - 3D tree rendering in Visual Basic

Submitted By: M R Khosravi
Rating: (Not rated) (Rate It)


VERSION 5.00
Begin VB.Form frmTree
   AutoRedraw      =   -1  'True
   Caption         =   "...Tree"
   ClientHeight    =   5070
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6705
   Icon            =   "frmTree.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5070
   ScaleWidth      =   6705
   WindowState     =   2  'Maximized
   Begin VB.PictureBox picBack
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   5820
      Index           =   3
      Left            =   4380
      Picture         =   "frmTree.frx":0442
      ScaleHeight     =   5760
      ScaleWidth      =   8010
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   2760
      Visible         =   0   'False
      Width           =   8070
   End
   Begin VB.PictureBox picBack
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   8160
      Index           =   2
      Left            =   2880
      Picture         =   "frmTree.frx":5444
      ScaleHeight     =   8100
      ScaleWidth      =   11520
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   3300
      Visible         =   0   'False
      Width           =   11580
   End
   Begin VB.PictureBox picBack
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   6300
      Index           =   1
      Left            =   5100
      Picture         =   "frmTree.frx":833B
      ScaleHeight     =   6240
      ScaleWidth      =   9000
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   1380
      Visible         =   0   'False
      Width           =   9060
   End
   Begin VB.PictureBox picBack
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      Height          =   6180
      Index           =   0
      Left            =   3630
      Picture         =   "frmTree.frx":D646
      ScaleHeight     =   6120
      ScaleWidth      =   9000
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   2100
      Visible         =   0   'False
      Width           =   9060
   End
End
Attribute VB_Name = "frmTree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const Pi = 3.141592
Dim myStep As Byte

Private Sub Form_Activate()
    ' when you move between Forms, this procedure became active, but I want to run it once, so I use goRender variable
    If goRender Then goRender = False: Call renderMe
End Sub


Private Sub renderMe()
   
    refreshMe

    Me.AutoRedraw = Not fastPaint ' disabling of this property make faster drawing, but your tree is not stable and when you move another Form on the Tree Form, the tree may be clear.
    goOut = False ' this variable is for manually stop
    myStep = 0    ' this is the first step of function so it start from 0
    nextBranch Me.Width / 2, Me.Height - Me.Height / 5, 180
   
'    If Not goOut Then SavePicture Me.Image, App.Path & "\Pic" & Format(Now, "yyyymmdd-hhmmss") & ".bmp"  ' you can use this code for saving picture on hard disk, but "Fast Paint" must be OFF
   
    frmMain.cmdOK.Visible = True
    frmMain.cmdStop.Visible = False
   
End Sub


' this procedure only clean Form and show a new picture as background
Private Sub refreshMe()
    Static newBackground As Byte
   
    Me.AutoRedraw = True
    Me.Cls
    If changeBackground Then newBackground = Int(Rnd(1) * 4)
    Me.PaintPicture picBack(newBackground).Picture, 0, 0, Me.Width, Me.Height, 0, 0, picBack(newBackground).Width, picBack(newBackground).Height
End Sub


' this is the  main function that several times refer to itself
Private Function nextBranch(ByVal startX As Integer, ByVal startY As Integer, ByVal myDegree As Integer) As Boolean
    On Error GoTo mustOut 'this is for overflow error controlling when size of a branche became very high in random states
    Dim j As Byte
    Dim mySize As Single
    Dim endX As Integer, endY As Integer, myWidth As Integer, degreeGrow As Integer
   
    If myStep >= totalSteps Or goOut Then Exit Function
    If brokenBranches > 0 And myStep > 2 Then If Rnd(1) * 100 < brokenBranches Then Exit Function ' this is for making broken branches
    DoEvents
   
    myStep = myStep + 1
   
   
    ' different width for branches from root to leaves. if you are beginner try  myWidth=2
    myWidth = (widthSize / 5) * (15 + totalSteps / 4) / (myStep ^ (widthScale / 10 + 0.5)) ' in new update , for "Width Scale" action I added [^ (widthScale / 10 + 0.5)]
    If myWidth < 1 Then myWidth = 1

    ' length of branch. if you are beginner try  mySize = 500 ( in one line only ,delete following 3 lines) and also with lower values for "Total Steps"
    mySize = ((totalSteps - myStep * leafLevel / 5) * IIf(leafLevel >= 5, leafLevel / 5, (leafLevel + 5) / 10)) / (1 + Abs(leafLevel - 5) / 15)
    mySize = IIf(mySize > 0, mySize, 1) * (Me.Height / totalSteps ^ 1.9) * IIf(fixSize > 0, fixSize / 80, Rnd(1) * 1.5 + 0.1)

    If myStep < 3 Then mySize = mySize * (2 - myStep / 3) ' I added this statement in update (2) because I want higher length for trunk of tree. you can simply remove it !
       
    ' [ * Pi / 180 ] is for changing degrees to radians
    endX = Sin(myDegree * Pi / 180) * mySize + startX
    endY = Cos(myDegree * Pi / 180) * mySize + startY
   
    ' this paint tree branch
    Me.DrawWidth = myWidth
    Me.Line (startX, startY)-(endX, endY), RGB(100, 255 * myStep / totalSteps, 50) ' I prefer different colors from root to leaves
   
    ' this calculate degree for next branch, I made a change [* 2/branchPerStep] in  update3
    degreeGrow = (IIf(fixAngel > 0, fixAngel, (Int(Rnd(1) * 120) - 60))) * 2 / branchPerStep
   
    ' this is the place that function run itself again
    For j = 1 To branchPerStep
        nextBranch endX, endY, (myDegree * (1 - (windDirection - 5) / 100) - degreeGrow / 2 + degreeGrow * (j - branchPerStep / 2)) Mod 360 ' for Wind action, I added this statement in last update [* (1 - (windDirection - 5) / 100)]
    Next
   
   
    'nextBranch = True
mustOut:
    myStep = myStep - 1
End Function


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    goOut = True
End Sub

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.