|
' MiniCalc! Version 2.0
' (C) 2007 i-TECH and Kristopher Windsor
Const true = -1, false = 0, program_title = "MiniCalc2 > "
Const history_max = 128
Const calculate_char_assignment = Chr(26)
Const calculate_char_number = "1234567890.", calculate_char_var = "ABCDEFGHIJKLMNOPQRSTUVWXYZ_", calculate_char_operator = "=<>+-*/^"
Const calculate_char_allowed = calculate_char_number & calculate_char_var & calculate_char_operator & calculate_char_assignment & "()%!"
Const calculate_expression_max = 128
Const calculate_number_unspecified = -0.907379150390625 'random hidden value
Const calculate_variable_max = 2048
Const text_margin = 10, text_size_max = 147, text_line_max = 3, text_window_width = 80
Type calculate_variable
As String title
As String expression
As Integer isfunction 'will replace 'x' in expression with another expression
As Integer ison
End Type
Dim Shared As Integer calculate_error, calculate_depth
Dim Shared As calculate_variable calculate_variables(1 To calculate_variable_max)
'[C:\itech\Misc\MiniCalcReloaded\MiniCalc.bas]
'[Declarations generated at 22:00:27 on 09-15-2007]
Declare Function calculate_evaluate (Byref equation As String, ans As Double = 0, Byref xvalue As Double = calculate_number_unspecified) As Double
'[starts at line #90; ends at line #342; is 251 lines long]
'[this function is called by the following subs and functions]
'calculate_evaluate at line #130
'calculate_evaluate at line #216
'calculate_evaluate at line #259
'calculate_evaluate at line #260
'calculate_evaluate at line #262
'program_main at line #609
'[this function calls the following subs and functions]
'calculate_evaluate at line #130
'calculate_evaluate at line #216
'calculate_evaluate at line #259
'calculate_evaluate at line #260
'calculate_evaluate at line #262
Declare Sub calculate_validate (Byref t As String)
'[starts at line #344; ends at line #399; is 54 lines long]
'[this sub is called by the following subs and functions]
'program_main at line #565
Declare Sub calculate_variable_add (Byref t As String)
'[starts at line #401; ends at line #434; is 32 lines long]
'[this sub is called by the following subs and functions]
'program_main at line #608
Declare Sub calculate_variable_load
'[starts at line #436; ends at line #458; is 21 lines long]
'[this sub is called by the following subs and functions]
'program_start at line #478
Declare Sub calculate_variable_save
'[starts at line #460; ends at line #475; is 14 lines long]
'[this sub is called by the following subs and functions]
'program_finish at line #619
Declare Sub program_start
'[starts at line #477; ends at line #479; is 1 lines long]
'[this sub is called by the following subs and functions]
'the main program at line #625
'[this sub calls the following subs and functions]
'calculate_variable_load at line #478
Declare Sub program_main
'[starts at line #481; ends at line #616; is 134 lines long]
'[this sub is called by the following subs and functions]
'the main program at line #626
'[this sub calls the following subs and functions]
'calculate_validate at line #565
'calculate_variable_add at line #608
'calculate_evaluate at line #609
Declare Sub program_finish
'[starts at line #618; ends at line #623; is 4 lines long]
'[this sub is called by the following subs and functions]
'the main program at line #627
'[this sub calls the following subs and functions]
'calculate_variable_save at line #619
Function calculate_evaluate (Byref equation As String, ans As Double = 0, Byref xvalue As Double = calculate_number_unspecified) As Double
Dim As Integer a, b, d, u, factorial_power, number_current, number_negation, operator_current, string_start, variable_index
Dim As Double temp, numbers(1 To calculate_expression_max)
Dim As String character_current, temp_string, variable_title
Dim As String operators(1 To calculate_expression_max)
#macro calculate_number_add()
number_current = number_current + 1: numbers(number_current) = temp * number_negation: number_negation = 1
#endmacro
#macro calculate_simplify()
For b = a + 1 To number_current - 1
Swap numbers(b), numbers(b + 1)
Next b
number_current -= 1
For b = a To operator_current - 1
Swap operators(b), operators(b + 1)
Next b
operator_current -= 1
#endmacro
If equation = "" Or calculate_depth > 64 Then calculate_error = -1: Return 0
calculate_depth += 1: number_negation = 1
'step 1 - extract numbers and operators
For a = 1 To Len(equation)
character_current = Mid(equation, a, 1)
If number_current > operator_current Then operator_current = operator_current + 1: operators(operator_current) = "*"
'parenthesis
If character_current = "(" Then
string_start = a: d = 1
Do
a = a + 1
Select Case Mid(equation, a, 1)
Case "(": d = d + 1
Case ")": d = d - 1
End Select
Loop Until d = 0
temp = calculate_evaluate(Mid(equation, string_start + 1, a - string_start - 1), ans, xvalue)
calculate_number_add()
Elseif Instr(calculate_char_number, character_current) Then
string_start = a
Do
a += 1
Loop Until Instr(calculate_char_number, Mid(equation, a, 1)) = 0 Or a > Len(equation)
temp = Val(Mid(equation, string_start, a - string_start))
a -= 1
calculate_number_add()
Elseif Instr(calculate_char_operator, character_current) Then
'operators
string_start = a
Do
a += 1
Loop Until Instr(calculate_char_operator, Mid(equation, a, 1)) = 0 Or a > Len(equation)
a -= 1
temp_string = Mid(equation, string_start, a - string_start + 1) 'overrides default (implied) multiplication
For b = 1 To Len(temp_string)
If Mid(temp_string, b, 1) = "-" Then Mid(temp_string, b, 1) = "+": number_negation *= -1
Next b
If Instr(" <> >< >= => <= =< ", " " & temp_string & " ") = 0 Then temp_string = Left(temp_string, 1)
If number_current + operator_current = 0 Then
number_current = 1: operator_current = 1
operators(1) = temp_string
If temp_string = "+" Then
numbers(1) = 0 'changes [+2] to [0+2]
Else
numbers(1) = ans 'changes [*2] to [ans*2]
End If
Else
operators(operator_current) = temp_string
End If
Elseif character_current = "%" Then
If number_current = 0 Then number_current = 1: numbers(1) = ans
numbers(number_current) /= 100
Elseif character_current = "!" Then
'factorials (like an operator, but not because 2!+3 cannot be calculated if factorials are operators)
If number_current = 0 Then number_current = 1: numbers(1) = ans
numbers(number_current) = Abs(Int(numbers(number_current)))
factorial_power = numbers(number_current): numbers(number_current) = 1
If factorial_power > 171 Then factorial_power = 171
For b = 2 To factorial_power
numbers(number_current) *= b
Next b
numbers(number_current) = numbers(number_current) * Sgn(factorial_power)
If numbers(number_current) = -1 Then calculate_error = -1
Elseif Instr(calculate_char_var, character_current) Then
'functions and varibles
'find length of variable name
string_start = a
Do
a += 1
Loop Until Instr(calculate_char_var, Mid(equation, a, 1)) = 0 Or a > Len(equation)
variable_title = Mid(equation, string_start, a - string_start)
a -= 1
If variable_title = "X" And xvalue <> calculate_number_unspecified Then
temp = xvalue 'calculate_evaluate(expression, ans)
Elseif variable_title = "ANS" Then
temp = ans
Elseif variable_title = "RND" Then
temp = Rnd
Else
If Instr(" ACOS ASIN ATAN COS INT LN SIN SQR TAN ", " " & variable_title & " ") Then
'built-in functions
'get function x value
string_start = a + 1
If Mid(equation, a + 1, 1) = "(" Then
'loop until proper depth is reached
d = 0
Do
a += 1
If Mid(equation, a, 1) = "(" Then d += 1
If Mid(equation, a, 1) = ")" Then d -= 1
Loop Until d = 0
Else
'loop until end of number is found
Do
a += 1
Loop Until (Instr(calculate_char_number, Mid(equation, a, 1)) = 0 Or a > Len(equation))
a -= 1
End If
temp_string = Mid(equation, string_start, a - string_start + 1)
temp = calculate_evaluate(temp_string, ans, xvalue) 'calculate xvalue for built-in function
Select Case variable_title
Case "ACOS": temp = Acos(temp)
Case "ASIN": temp = Asin(temp)
Case "ATAN": temp = Atn(temp)
Case "COS": temp = Cos(temp)
Case "INT": temp = Int(temp)
Case "LN": temp = Log(temp)
Case "SIN": temp = Sin(temp)
Case "SQR": temp = Sqr(temp)
Case "TAN": temp = Tan(temp)
End Select
Else
'see if variable is defined
variable_index = 0
For b = 1 To calculate_variable_max
With calculate_variables(b)
If variable_title = .title And .ison Then variable_index = b
End With
Next b
If variable_index > 0 Then
'if a function, then get xvalue (next value in equation)
If calculate_variables(variable_index).isfunction Then
'get function input value
string_start = a + 1
If Mid(equation, a + 1, 1) = "(" Then
'loop until proper depth is reached
d = 0
Do
a += 1
If Mid(equation, a, 1) = "(" Then d += 1
If Mid(equation, a, 1) = ")" Then d -= 1
Loop Until d = 0
Else
'loop until end of number is found
Do
a += 1
Loop Until (Instr(calculate_char_number, Mid(equation, a, 1)) = 0 Or a > Len(equation))
a -= 1
End If
temp_string = Mid(equation, string_start, a - string_start + 1)
temp = calculate_evaluate(temp_string, ans, xvalue) 'calculate xvalue for function
temp = calculate_evaluate(calculate_variables(variable_index).expression, ans, temp) 'calculate function value
Else
temp = calculate_evaluate(calculate_variables(variable_index).expression, ans) 'calculate variable value
End If
Else
Print Spc(12); variable_title & " is undefined"
temp = 0
calculate_error = true
End If
End If
End If
calculate_number_add() 'built-in variable, built-in function, user defined: all add temp variable
End If
Next a
If number_current = operator_current Then operator_current -= 1
'step 2 - simplify
If operator_current Then
a = 1
Do
If operators(a) = "^" Then
numbers(a) ^= numbers(a + 1)
calculate_simplify()
Else
a += 1
End If
Loop Until a > operator_current
a = 1
Do
b = a
Select Case operators(a)
Case "*"
numbers(a) *= numbers(a + 1)
Case "/"
numbers(a) /= numbers(a + 1)
Case Else: a += 1
End Select
If a = b Then
calculate_simplify()
End If
Loop Until a > operator_current
a = 1
Do
If operators(a) = "+" Then
numbers(a) += numbers(a + 1)
calculate_simplify()
Else
a += 1
End If
Loop Until a > operator_current
a = 1
Do
b = a
Select Case operators(a)
Case "="
numbers(a) = Iif(numbers(a) = numbers(a + 1), 1, 0)
Case "<"
numbers(a) = Iif(numbers(a) < numbers(a + 1), 1, 0)
Case ">"
numbers(a) = Iif(numbers(a) > numbers(a + 1), 1, 0)
Case "<=", "=<"
numbers(a) = Iif(numbers(a) <= numbers(a + 1), 1, 0)
Case ">=", "=>"
numbers(a) = Iif(numbers(a) >= numbers(a + 1), 1, 0)
Case "<>", "><"
numbers(a) = Iif(numbers(a) <> numbers(a + 1), 1, 0)
Case Else
a += 1
End Select
If a = b Then
calculate_simplify()
End If
Loop Until a > operator_current
End If
calculate_depth -= 1
If calculate_error Then Return 0 Else Return numbers(1)
End Function
Sub calculate_validate (Byref t As String)
Dim As Integer a, b, d
Dim As String assignment
a = Instr(t, calculate_char_assignment)
If a > 0 Then
'remove duplicate assignment characters
While Instr(a + 1, t, calculate_char_assignment) > 0
b = Instr(a + 1, t, calculate_char_assignment)
t = Left(t, b - 1) + Right(t, Len(t) - b)
b -= 1
Wend
'mode assignment to a seperate string
assignment = Right(t, Len(t) - a)
t = Left(t, a - 1)
End If
For a = 1 To Len(t)
If Instr(calculate_char_allowed, Mid(t, a, 1)) = 0 Then t = Left(t, a - 1) + Right(t, Len(t) - a): a -= 1
Next a
d = 0
For a = 1 To Len(t)
Select Case Mid(t, a, 1)
Case "("
d = d + 1
Case ")"
If d = 0 Then
Mid(t, a, 1) = "(": d = d + 1
Else
d = d - 1
End If
End Select
Next a
t = Ucase(t) + String(d, ")")
Do
a = Instr(t, "()")
If a Then t = Left(t, a - 1) + Right(t, Len(t) - a - 1)
Loop Until a = 0
If Len(assignment) Then
'avoid parenthesis while validating function name
d = Right(assignment, 2) = "()"
If d Then assignment = Left(assignment, Len(assignment) - 2)
'see if variable did not have a name
If Len(assignment) > 0 Then
'validate variable / function name
For a = 1 To Len(assignment)
If Instr(calculate_char_var, Mid(assignment, a, 1)) = false Then Mid(assignment, a, 1) = "_"
Next a
t += calculate_char_assignment & assignment
If d Then t += "()"
End If
End If
End Sub
Sub calculate_variable_add (Byref t As String)
'add a variable, and remove variable assignment character from string
Dim As Integer a, isfunction, variable_free, variable_index
Dim As String variable_title
a = Instr(t, calculate_char_assignment)
If a = 0 Then Exit Sub
variable_title = Right(t, Len(t) - a)
isfunction = Right(variable_title, 2) = "()"
If isfunction Then variable_title = Left(variable_title, Len(variable_title) - 2)
t = Left(t, a - 1)
For a = 1 To calculate_variable_max
With calculate_variables(a)
If .ison Then
If .title = variable_title Then variable_index = a
Else
variable_free = a
End If
End With
Next a
If variable_index = 0 Then variable_index = variable_free
If variable_index = 0 Then calculate_error = true: Exit Sub
'works whether variable was already created, or not
With calculate_variables(variable_index)
.title = variable_title
.expression = t
.isfunction = isfunction
.ison = Len(t) > 0
End With
End Sub
Sub calculate_variable_load
Dim As Integer a
Dim As String l
Open "variables.dat" For Input As #1
If Err Then Exit Sub
While Not Eof(1)
a += 1
With calculate_variables(a)
Line Input #1, l
.isfunction = Right(l, 2) = "()"
If .isfunction Then l = Left(l, Len(l) - 2)
.title = l
Line Input #1, .expression
.ison = true
Line Input #1, l 'blank line
End With
Wend
Close #1
End Sub
Sub calculate_variable_save
Dim As Integer a
Open "variables.dat" For Output As #1
For a = 1 To calculate_variable_max
With calculate_variables(a)
If .ison Then
Print #1, .title;
If .isfunction Then Print #1, "()" Else Print #1,
Print #1, .expression
Print #1,
End If
End With
Next a
Close #1
End Sub
Sub program_start
calculate_variable_load
End Sub
Sub program_main
Dim As Integer a, b, history_current, text_color, text_cursor_location, text_cursor_row, text_cursor_toggle
Dim As Double ans
Dim As String Key, t
Dim As String history(1 To history_max)
Randomize Timer
Width 80,25
Color 15
Cls
Locate 1, 1, 0
text_color = 9
Print program_title + "(C) 2007 Kristopher Windsor"
Print
Do
text_color = (text_color - 9) Mod 5 + 10: Color text_color
text_cursor_row = Csrlin
While text_cursor_row > 20
text_cursor_row = text_cursor_row - 1
Locate 25: Print
Wend
If t > "" And t <> history(history_max) Then
For a = 1 To history_max - 1
Swap history(a), history(a + 1)
Next a
history(history_max) = t
End If
history_current = history_max + 1
text_cursor_location = 0
text_cursor_toggle = 0
Key = ""
t = ""
Do
Select Case Key
Case Chr(255, 71) 'home
text_cursor_location = 0
Case Chr(255, 72) 'up arrow
If history_current > 1 Then
If Len(history(history_current - 1)) > 0 Then
history_current -= 1
t = history(history_current)
text_cursor_location = Len(t)
End If
End If
Case Chr(255, 75) 'left arrow
If text_cursor_location > 0 Then text_cursor_location -= 1
Case Chr(255, 77) 'right arrow
If text_cursor_location < Len(t) Then text_cursor_location += 1
Case Chr(255, 79) 'end
text_cursor_location = Len(t)
Case Chr(255, 80) 'down arrow
Select Case history_max - history_current
Case 0
history_current += 1
t = ""
Case Is >= 1
history_current += 1
t = history(history_current)
text_cursor_location = Len(t)
End Select
Case Chr(255, 83) 'delete
If text_cursor_location < Len(t) Then t = Left(t, text_cursor_location) + Right(t, Len(t) - text_cursor_location - 1)
Case Chr(8) 'backspace
If text_cursor_location > 0 Then t = Left(t, text_cursor_location - 1) + Right(t, Len(t) - text_cursor_location): text_cursor_location -= 1
Case Chr(27), Chr(255, 107) 'escape or alt-f4
Exit Sub 'program_quit
Case Else
If Len(Key) = 1 And Len(t) < text_size_max And Instr(calculate_char_allowed, Key) > 0 Then
t = Left(t, text_cursor_location) + Key + Right(t, Len(t) - text_cursor_location)
text_cursor_location += 1
End If
End Select
Locate text_cursor_row, 1
Print Left(program_title + Left(t, text_cursor_location) + Chr(95 + (text_cursor_toggle) * 73) + Right(t, Len(t) - text_cursor_location) + Space(text_line_max * text_window_width), _
text_line_max * text_window_width);
If Len(Key) = 0 Then Sleep 250: text_cursor_toggle = Not text_cursor_toggle
Key = Ucase(Inkey)
If Key = Chr(9) Then Key = calculate_char_assignment
Loop Until Key = Chr(13)
calculate_validate t
For a = text_cursor_row To text_cursor_row + text_line_max - 1
Locate a, 1
Print Space(text_window_width);
Next a
Locate text_cursor_row, 1: Print program_title + t
Select Case t
Case ""
Print Spc(12); "Press [Esc] to Quit"
Case "CLS": Cls : Print program_title + "CLS"
Case "EXIT": Exit Sub
Case "HELP"
Print
Print Spc(12); "--Built-in Variables--"
Print Spc(12); "ACOS() ASIN() ANS RND ATAN() COS()"
Print Spc(12); "INT() LN() SIN() SQR() TAN()"
Print
Print Spc(12); "--Commands--"
Print Spc(12); "CLS,EXIT,HELP,SMILEY,VARS"
Print
Print Spc(12); "--Assigning Variables--"
Print Spc(12); "1+(2*3)" & calculate_char_assignment & "X || 2X+3" & calculate_char_assignment & "FUNCTION()"
Print
Case "SMILEY"
Print Spc(12); Chr(1, 32, 2)
Case "VARS"
Print
Print Spc(12); "--Assigned Variables--"
For a = 1 To calculate_variable_max
With calculate_variables(a)
If .ison Then
Print Spc(12);
Print .title;
If .isfunction Then Print "()";
Print "=" & .expression
Sleep 100
End If
End With
Next a
Print
Case Else
calculate_error = 0
calculate_variable_add t 'attempt to add variable
If Len(t) > 0 Then ans = calculate_evaluate(t, ans)
If Abs(ans) < 1E-15 Then ans = 0
End Select
Print Spc(text_margin); "> " + Ltrim(Str(ans)); : If calculate_error Then Print " (Error)";
Print : Print
Loop
End Sub
Sub program_finish
calculate_variable_save
Color 7
Locate ,, 1
Cls
End Sub
program_start
program_main
program_finish
System
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in
