Post by Guilect on Dec 4, 2006 9:22:02 GMT -5
now do you see what you started matthew.
'===================================================================================================
Option Explicit
'===================================================================================================
Dim Width
Width = 600
'===================================================================================================
Class STRUC_FERN
Dim a(4)
Dim b(4)
Dim c(4)
Dim d(4)
Dim e(4)
Dim f(4)
Dim p(4)
Dim lmtsx
Dim lmtsy
Dim lmtdx
Dim lmtdy
Dim xscale
Dim yscale
Dim xoffset
Dim yoffset
End Class
'===================================================================================================
Const Title = "Fern using Fractals"
'===================================================================================================
Sub SetFernStyle()
Dim SF
Set SF = New STRUC_FERN
With SF
.a(0) = 0
.b(0) = 0
.c(0) = 0
.d(0) = 0.16
.e(0) = 0
.f(0) = 0
.a(1) = 0.2
.b(1) = -0.26
.c(1) = 0.23
.d(1) = 0.22
.e(1) = 0
.f(1) = 1.6
.a(2) = -0.51
.b(2) = 0.28
.c(2) = 0.26
.d(2) = 0.24
.e(2) = 0
.f(2) = 1.6
.a(3) = 0.85
.b(3) = 0.04
.c(3) = -0.04
.d(3) = 0.85
.e(3) = 0
.f(3) = 2
.p(0) = 328
.p(1) = 2621
.p(2) = 4915
.p(3) = 32767
.xscale = 30
.yscale = 30
.xoffset = Width / 2
.yoffset = -75
.lmtsx = 0
.lmtsy = 0
.lmtdx = 640
.lmtdy = 340
DrawFern SF
End With
End Sub
'===================================================================================================
Sub DrawFern(SF)
Dim i , px, py
Dim j , k
Dim newx, x, y
Dim xloc, yloc
x = 0
y = 0
With SF
For i = 1 To 20000
j = 20000 * Rnd + 1
k = IIf(j < .p(0), 0, IIf(j < .p(1), 1, IIf(j < .p(2), 2, 3)))
newx = (.a(k) * x + .b(k) * y + .e(k))
y = (.c(k) * x + .d(k) * y + .f(k))
x = newx
px = x * .xscale + .xoffset
py = (y * .yscale + .yoffset)
graphics.setpoint px, 350- py, -16711936
if key.pressed(1) or key.pressed(0) = True then Exit Sub
If i Mod 100 = 0 Then
system.processMessages
graphics.display
End If
Next 'i
End With
End Sub
dim bRunning
bRunning = True
sub main()
if (graphics.initialize <> True) then exit sub
graphics.setTitle Title
key.initialize
graphics.clear 255
SetFernStyle
do while bRunning = True
if key.pressed(1) or key.pressed(0) = True then bRunning = False
system.processMessages
loop
key.terminate
graphics.terminate
end sub
Call Main()
Function IIf (exp1, exp2, default)
If exp1 then
IIf = exp2
Else
IIf = default
End If
End Function