Fibonacci Serisi

Private Sub Form_Activate()
Print "Enter a number"
End Sub

Private Sub CmbFibSeries_Click()
On Error GoTo FbError
Cls
Print Fibonacci(TxtNumber.Text) ' Print the series on the form
FbError:
If Err.Number = 13 Then
Print "Enter a valid number." & Chr(13) & "-n to 0 or 0 to n numbers."
TxtNumber.Text = "": TxtNumber.SetFocus
ElseIf Err.Number = 6 Then
Print "To many numbers." & Chr(13) & "Enter a 10 digit number."
TxtNumber.Text = "": TxtNumber.SetFocus
End If
End Sub

Private Function Fibonacci(ByVal N As Long) As String
On Error GoTo FiboError
'***************************************************
' Author: Arun Banik (India)
' Created: 30-April-2004
' Purpose: An Algorithm that creates the Fibonacci _
members of a series.
' Parameters: It takes only one argument, ie the _
number which starts the series.
' Description: Generates a series of numbers, each _
number is a sum of the previous _
number. Eg: 0 1 1 2 3 5 8 etc. _
The starting number can be any _
value, +ve or -ve. No recursions used.
'***************************************************
Dim i, j, k, m, Fib
j = N: k = 0: m = 0

For i = j + 1 To j + 10 ' i always starts with j + 1 _
We will generate 11 numbers.

If j <= 1 Then
If i <= 2 Then
If j < 0 Then ' We will process -ve values till i is 2
If j > -1 Then
j = j + k: m = k: k = j
Fib = Fib & Chr(13) & j
Else
Fib = Fib & Chr(13) & j
m = k: k = j: j = k + m
End If
Else ' We will process +ve values till value of i is 2
Fib = Fib & Chr(13) & j
If j = 0 Then
k = j: j = i
Else
j = j + k
Fib = Fib & Chr(13) & j
k = j
End If
End If
Else ' If value of i is more than 2
If j < 0 Then ' We will process the remaining -ve values
Fib = Fib & Chr(13) & j
m = k: k = j: j = k + m
Else ' We will process the remaining +ve values
m = k: j = i - j: k = j
Fib = Fib & Chr(13) & j
End If
End If
Else ' If value of j is more than 1
If k = 0 Then
k = j
Fib = Fib & Chr(13) & j
End If
k = k + m: m = k - m: j = k
Fib = Fib & Chr(13) & j
End If


Next
Fibonacci = Fib
FiboError:
If Err.Number <> 0 Then
MsgBox Err.Description, vbInformation, "Error in Function"
End If
End Function

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

fibonacci serisi