home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / Mathematic581462272002.psc / MathTool.cls < prev    next >
Encoding:
Visual Basic class definition  |  2002-02-27  |  4.6 KB  |  153 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "MathTool"
  10. Attribute VB_GlobalNameSpace = True
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. ' Jonathan A. Feucht
  15. ' Mathematics simulator
  16. '-------------------------
  17. ' This is the main class. It can be used by remote classes. It works to solve
  18. ' expressions and to set or modify variables.
  19.  
  20. Option Explicit
  21.  
  22. Type Variable   ' A variable has a reference name and a value
  23.     Name As String
  24.     Constant As Boolean
  25.     Value As Double
  26. End Type
  27.  
  28. ' Initialize useful constants
  29. Private Sub Class_Initialize()
  30.  
  31.     SetVar "pi", Atn(1) * 4, True
  32.     SetVar "e", Exp(1), True
  33.  
  34. End Sub
  35.  
  36. ' Removes all unwanted characters from an expression.
  37. Public Function CleanExpression(Expression As String) As String
  38.  
  39.   Dim i As Integer, CurChar As String, RetStr As String
  40.  
  41.     Expression = LCase$(Expression)
  42.     For i = 1 To Len(Expression)
  43.         CurChar = Mid$(Expression, i, 1)
  44.         If Asc(CurChar) > 32 Then   ' If it's a good character, add it to the return string.
  45.             ' We don't allow parenteses in an expression, since IsNumeric ("(7)")
  46.             ' is true and IsNumeric ("[7]") is false. This is important.
  47.             If CurChar = "(" Or CurChar = "{" Then
  48.               CurChar = "["
  49.             ElseIf CurChar = ")" Or CurChar = "}" Then
  50.               CurChar = "]"
  51.             End If
  52.             RetStr = RetStr & CurChar
  53.         End If
  54.     Next i
  55.     CleanExpression = RetStr
  56.  
  57. End Function
  58.  
  59. ' Returns the number of entries in the Vars() array
  60. Public Function GetVarCount() As Integer
  61.  
  62.     GetVarCount = VarCnt
  63.  
  64. End Function
  65.  
  66. ' Returns the Name property for the Vars(Index) array entry
  67. Public Function GetVarName(Index As Integer) As String
  68.  
  69.     GetVarName = Vars(Index).Name
  70.  
  71. End Function
  72.  
  73. ' Returns the Value property for the Vars(Index) array entry
  74. Public Function GetVarValue(Index As Integer) As Double
  75.  
  76.     GetVarValue = Vars(Index).Value
  77.  
  78. End Function
  79.  
  80. ' Returns the Constant property for the Vars(Index) array entry
  81. Public Function IsVarConstant(Index As Integer) As Boolean
  82.  
  83.     IsVarConstant = Vars(Index).Constant
  84.  
  85. End Function
  86.  
  87. ' Create or modify a variable
  88. Public Sub SetVar(VarName As String, Value As Double, Optional Constant As Boolean)
  89.  
  90.   Dim i As Integer, VarCount As Integer, CurChar As String
  91.  
  92.     On Error Resume Next
  93.       ' Minimum 1 character
  94.       If VarName = "" Then
  95.           Err.Raise Assignment, , "Variable names can have at least 1 character"
  96.           Exit Sub '>---> Bottom
  97.       End If
  98.       ' Maximum 15 characters
  99.       If Len(VarName) > 15 Then
  100.           Err.Raise Assignment, , "Variable names can have at most 15 characters"
  101.           Exit Sub '>---> Bottom
  102.       End If
  103.       ' First character must be a letter
  104.       If IsNumeric(Left$(VarName, 1)) Then
  105.           Err.Raise Assignment, , "First character of variable name must be a letter"
  106.           Exit Sub '>---> Bottom
  107.       End If
  108.       ' Capitalize the name
  109.       VarName = UCase$(VarName)
  110.       ' Check for invalid characters
  111.       For i = 1 To Len(VarName)
  112.           CurChar = Mid$(VarName, i, 1)
  113.           ' Only allow letters, numbers, and an underscore
  114.           If Not ((CurChar >= "A" And CurChar <= "Z") Or (CurChar >= "0" And CurChar <= "9") Or (CurChar = "_")) Then
  115.               Err.Raise Assignment, , "Invalid character in variable name"
  116.           End If
  117.       Next i
  118.       VarCount = VarCnt
  119.       ' Check to see if variable already exists
  120.       For i = 1 To VarCount
  121.           ' If so, change the value
  122.           If Vars(i).Name = VarName Then
  123.               If Vars(i).Constant Then
  124.                   Err.Raise Assignment, , VarName & " is constant"
  125.                   Exit Sub '>---> Bottom
  126.               End If
  127.               Vars(i).Value = Value
  128.               Exit Sub '>---> Bottom
  129.           End If
  130.       Next i
  131.       ' Otherwise, add the variable
  132.       ReDim Preserve Vars(1 To VarCount + 1)
  133.       Vars(VarCount + 1).Name = VarName
  134.       Vars(VarCount + 1).Value = Value
  135.       Vars(VarCount + 1).Constant = Constant
  136.  
  137. End Sub
  138.  
  139. ' Solves an expression, returns the answer
  140. Public Function Solve(Expression As String) As Double
  141.  
  142.   Dim Equat As New Exp
  143.  
  144.     If Err.Number > 0 Then Exit Function
  145.     ' Remove unwanted characters
  146.     Equat.Expression = CleanExpression(Expression)
  147.     ' Solve the equation
  148.     Equat.SolveExpression
  149.     ' Return the value of the equation
  150.     Solve = Equat.GetValue
  151.     
  152. End Function
  153.