PHP Kod: Kodu kopyalamak için üzerine çift tıklayın!
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