Buchempfehlung
Visual Basic 6 Kochbuch
Visual Basic 6 Kochbuch
Viele praktische Tipps zum Programmieren mit Visual Basic 6, die sich oft auch auf FB übertragen lassen. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Formel-Parser

Uploader:Redakteurnemored
Datum/Zeit:19.11.2014 23:00:52
Hinweis: Dieser Quelltext ist Bestandteil des Projekts Formel-Parser und Termberechnung, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

/'
  Copyright (c) 2014 by nemored

  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated
  documentation files (the "Software"), to deal in the Software without restriction, including without limitation
  the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and
  to permit persons to whom the Software is furnished to do so, subject to the following conditions:

  The above copyright notice and this permission notice shall be included in all copies or substantial portions of
  the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO
  THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
  TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
  SOFTWARE.

  Version 2014-11-24
'/


#ifndef CALCULATE_DATATYPE
  #define CALCULATE_DATATYPE double
#endif

namespace Calculate
  enum Errors
    NoError = 0
    ErrorNoValue
    ErrorMissingBracket
    ErrorMissingValue
    ErrorWrongDecimalPoint
    ErrorWrongExponent
    ErrorIllegalSymbol
    ErrorNotANumber
    ErrorUndefinedFunction
    ErrorUndefinedVariable
    ErrorOverwriteFunction
    ErrorIllegalValue
  end enum
  enum Tokens
    Nil = 0
    Number
    Plus
    Minus
    Asterisk
    Slash
    Backslash
    Exponent
    Equal
    BracketLeft
    BracketRight
    OpMod
    OpShl
    OpShr
    OpAnd
    OpOr
    OpXor
    OpEqv
    OpImp
    OpNot
    Variable
    Func
    Seperator
  end enum

  type TVariable
    as string id
    as CALCULATE_DATATYPE value
    declare constructor
    declare constructor(i as string, v as CALCULATE_DATATYPE)
  end type
  constructor TVariable
  end constructor
  constructor TVariable(i as string = "", v as CALCULATE_DATATYPE = 0)
    this.id    = i
    this.value = v
  end constructor

  type TToken
    as TToken ptr prev, nxt
    as Tokens token
    as string value
    declare property size(last as TToken ptr) as integer
    declare constructor
    declare sub add(t as Tokens, v as string)
    declare function del as TToken ptr
    declare sub delAll
    declare sub delFromCurrent
    declare sub replace(last as TToken ptr, t as Tokens, v as string)
  end type
  constructor TToken
  end constructor
  property TToken.size(last as TToken ptr) as integer
    dim cur as TToken ptr = @this, ret as integer = 0
    do while cur
      if cur = last then exit do
      cur = cur->nxt
      if cur andalso cur->token <> Tokens.Nil then ret += 1
    loop
    return ret
  end property
  sub TToken.add(t as Tokens, v as string)
    dim as TToken ptr newToken = new TToken
    newToken->nxt  = this.nxt
    newToken->prev = @this
    newToken->token = t
    newToken->value = v
    this.nxt = newToken
    if newToken->nxt then newToken->nxt->prev = newToken
  end sub
  function TToken.del as TToken ptr
    dim as TToken ptr cur = this.nxt
    if cur then this.nxt->prev = this.prev
    if this.prev then this.prev->nxt = cur
    this.token = 0
    this.value = ""
    this.prev  = 0
    this.nxt   = 0
    delete @this
    return cur
  end function
  sub TToken.delAll
    dim as TToken ptr current = @this
    do while current->prev
      current = current->prev
    loop
    current->delFromCurrent
  end sub
  sub TToken.delFromCurrent
    dim as TToken ptr current = @this
    do
      current = current->del
    loop until current = 0
  end sub
  sub TToken.replace(last as TToken ptr, t as Tokens, v as string)
    if last <> @this then
      dim as TToken ptr cur = this.nxt
      do while cur <> 0 and cur <> last
        cur = this.nxt->del
      loop
      if cur then cur->del
    end if
    this.token = t
    this.value = v
  end sub

  dim shared as TVariable globalVar(), localVar()
  dim shared as Errors CalcError
  dim shared as string CalcErrorTerm
  const NaN = -sqr(-1)
  declare sub debug(debugString as string)
  declare function debugCalcString(first as TToken ptr, last as TToken ptr = 0) as string
  declare function eval overload(t as string) as CALCULATE_DATATYPE
  declare function eval(byval first as TToken ptr, byval last as TToken ptr = 0) as CALCULATE_DATATYPE
  declare function evalSearch(token as integer, first as TToken ptr, last as TToken ptr) as TToken ptr
  declare function getVar overload(variable as string) as CALCULATE_DATATYPE
  declare function getVar(tok as TToken ptr) as CALCULATE_DATATYPE
  declare sub setVar(variable as string, value as CALCULATE_DATATYPE, scop as integer = 0)
end namespace

' pre-defined constants
Calculate.setVar "e",  2.718281828459045
Calculate.setVar "pi", 3.141592653589793

sub Calculate.debug(debugString as string)
  #ifdef CALCULATE_DEBUG
    print debugstring
  #endif
end sub

function Calculate.debugCalcString(first as Calculate.TToken ptr, last as Calculate.TToken ptr) as string
  #ifdef CALCULATE_DEBUG
    dim as Calculate.TToken ptr cur = first
    dim as string debugString = "eval "
    do while cur
      if cur->Token <> Calculate.Tokens.Nil then debugString &= " " & cur->value
      if cur = last then exit do
      cur = cur->nxt
    loop
    return debugString
  #else
    return ""
  #endif
end function

function Calculate.eval(t as string) as CALCULATE_DATATYPE
  dim as integer position = 0, char, lastToken = Calculate.Tokens.Nil, numberPos = 0, skipping = 0
  dim as Calculate.TToken ptr listStart = new Calculate.TToken, listCurrent = listStart
  dim as string numberString
  Calculate.CalcError = Calculate.NoError
  do while position < len(t)
    char = t[position]
    ' skip space
    if char = 9 or char = 32 then
      position += 1
      skipping = -1
      continue do
    else
      skipping = 0
      if numberPos > 0 and (char = 69 or char = 101) then
        lastToken = Calculate.Tokens.Number
        listCurrent->add(Calculate.Tokens.Number, numberString)
        listCurrent = listCurrent->nxt
        numberPos = 0
      end if
    end if
    ' continue number
    if numberPos then
      select case char
        case 48 to 57  ' number
          numberString += chr(char)
        case 46        ' decimal point
          if numberPos = 1 then
            numberString += "."
            numberPos = 2
          else
            Calculate.CalcError = Calculate.ErrorWrongDecimalPoint
            exit do
          end if
        case 69, 101   ' e, E
          if numberPos > 2 then
            Calculate.CalcError = Calculate.ErrorWrongDecimalPoint
            exit do
          end if
          if position = len(t)-1 orelse _
              t[position+1] <> 43 and t[position+1] <> 45 and t[position+1] < 48 and t[position+1] > 57 then
            Calculate.CalcError = Calculate.ErrorWrongExponent
            exit do
          end if
          if t[position+1] = 43 or t[position+1] = 45 then
            if position = len(t)-2 orelse t[position+2] < 48 and t[position+2] > 57 then
              Calculate.CalcError = Calculate.ErrorWrongExponent
              exit do
            end if
            numberString += "e" + chr(t[position+1], t[position+2])
            position += 2
          else
            numberString += "e+" + chr(t[position+1])
            position += 1
          end if
          numberPos = 3
        case else
          lastToken = Calculate.Tokens.Number
          listCurrent->add(Calculate.Tokens.Number, numberString)
          listCurrent = listCurrent->nxt
          numberPos = 0
      end select
    ' start number?
    else
      select case char
        case 48 to 57  ' number
          numberPos = 1
          numberString = chr(char)
        case 46        ' decimal point
          numberPos = 2
          numberString = "."
        case 43, 45    ' sign +, -
          if lastToken <> Calculate.Tokens.Number _
             and lastToken <> Calculate.Tokens.BracketLeft _
             and lastToken <> Calculate.Tokens.BracketRight _
             and lastToken <> Calculate.Tokens.Equal _
             and lastToken <> Calculate.Tokens.Variable _
             and lastToken <> Calculate.Tokens.Func _
             and lastToken <> Calculate.Tokens.Seperator then
            numberPos = 1
            numberString = chr(char)
        end if
      end select
    end if
    ' no number
    if numberPos = 0 then
      numberString = ""
      select case char
        case 40 : lastToken = Calculate.Tokens.BracketLeft  ' (
        case 41 : lastToken = Calculate.Tokens.BracketRight ' )
        case 42 : lastToken = Calculate.Tokens.Asterisk     ' *
        case 43 : lastToken = Calculate.Tokens.Plus         ' +
        case 45 : lastToken = Calculate.Tokens.Minus        ' -
        case 47 : lastToken = Calculate.Tokens.Slash        ' /
        case 59 : lastToken = Calculate.Tokens.Seperator    ' ;
        case 61 : lastToken = Calculate.Tokens.Equal        ' =
        case 92 : lastToken = Calculate.Tokens.Backslash    ' \
        case 94 : lastToken = Calculate.Tokens.Exponent     ' ^
        case 65 to 90, 95, 97 to 122
          ' search end of word
          dim as integer p = position + 1
          do while p < len(t)
            if t[p]<>95 and not(t[p]>47 and t[p]<58) and not(t[p]>64 and t[p]<91) and not(t[p]>96 and t[p]<123) then exit do
            p += 1
          loop
          numberString = mid(t, position+1, p-position)
          select case lcase(mid(t, position+1, p-position))
            case "mod" : lastToken = Calculate.OpMod
            case "shl" : lastToken = Calculate.OpShl
            case "shr" : lastToken = Calculate.OpShr
            case "not" : lastToken = Calculate.OpNot
            case "and" : lastToken = Calculate.OpAnd
            case "or"  : lastToken = Calculate.OpOr
            case "xor" : lastToken = Calculate.OpXor
            case "eqv" : lastToken = Calculate.OpEqv
            case "imp" : lastToken = Calculate.OpImp
            case "sin", "cos", "tan", "asin", "acos", "atan", "atn", "abs", "sgn", "sqr", _
                 "exp", "log", "ln", "int", "cint", "fix", "frac"
              lastToken = Calculate.Tokens.Func
            case else
              lastToken = Calculate.Tokens.Variable
          end select
          position = p - 1
        case else
          Calculate.CalcError = Calculate.ErrorIllegalSymbol
          exit do
      end select
      #ifdef CALCULATE_DEBUG
        if numberString = "" then numberString = chr(t[position])
      #endif
      listCurrent->add(lastToken, numberString)
      listCurrent = listCurrent->nxt
    end if
    position += 1
  loop
  if numberPos then
    listCurrent->add(Calculate.Tokens.Number, numberString)
    listCurrent = listCurrent->nxt
  end if

  dim as CALCULATE_DATATYPE ret = iif(Calculate.CalcError, 0, Calculate.eval(listStart->nxt))
  listStart->delAll
  erase Calculate.localVar
  return iif(Calculate.CalcError, 0, ret)
end function

function Calculate.eval(byval first as Calculate.TToken ptr, byval last as Calculate.TToken ptr = 0) as CALCULATE_DATATYPE
  dim as CALCULATE_DATATYPE value
  dim as string calcString = Calculate.debugCalcString(first, last)
  if first andalso first->token = Calculate.Tokens.Nil then first = first->nxt

  ' no token (error)
  if first = 0 then
    Calculate.CalcError = ErrorMissingValue
    return 0
  end if

  Calculate.debug calcString
  dim as Calculate.TToken ptr listCurrent = first, firstBracket
  dim as integer depth = 0

  ' search brackets and seperators
  do while listCurrent
    if listCurrent->token = Calculate.Tokens.Nil then
      if listCurrent = last then exit do
      if listCurrent->nxt = 0 then last = listCurrent
      listCurrent = listCurrent->nxt
      continue do
    end if
    if listCurrent->token = Calculate.Seperator then
      if depth then
        Calculate.CalcError = ErrorMissingBracket
        return 0
      else
        dim as CALCULATE_DATATYPE dummy = Calculate.eval(first, listCurrent->prev)
        value = Calculate.eval(listCurrent->nxt, last)
        Calculate.debug "() returns " & value
        return value
      end if
    end if
    if listCurrent->token = Calculate.BracketLeft then
      if depth = 0 then firstBracket = listCurrent
      depth += 1
    elseif listCurrent->token = Calculate.BracketRight then
      if depth = 0 then
        Calculate.CalcError = ErrorMissingBracket
        return 0
      end if
      depth -= 1
      if depth = 0 then
        firstBracket->replace(listCurrent->prev, Calculate.Tokens.Number, _
                      str(Calculate.eval(firstBracket->nxt, listCurrent->prev)))
        listCurrent->token = Calculate.Tokens.Nil
      end if
    end if
    if listCurrent = last then exit do
    if listCurrent->nxt = 0 then last = listCurrent
    listCurrent = listCurrent->nxt
  loop

  ' single token (must be a number or variable)
  if first->size(last) = 0 then
    if first->token = Calculate.Tokens.Number then
      Calculate.debug "return single value " & first->value
      return val(first->value)
    elseif first->token = Calculate.Tokens.Variable then
      Calculate.debug "return var value " & Calculate.getVar(first)
      return Calculate.getVar(first)
    else
      Calculate.CalcError = ErrorMissingValue
      return 0
    end if
  end if

  ' definition
  if first->nxt->token = Calculate.Tokens.Equal then
    if first->Token = Calculate.Tokens.Variable then
      dim as CALCULATE_DATATYPE ret = Calculate.eval(first->nxt->nxt, last)
      Calculate.setVar(first->value, ret, -1)
      if Calculate.CalcError then
        return 0
      else
        Calculate.debug "define " & first->value & " = " & ret
        return ret
      end if
    else
      Calculate.CalcError = ErrorIllegalSymbol
      return 0
    end if
  end if

  ' function
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.Func, first, last)
  if listCurrent then
    value = Calculate.getVar(listCurrent)
    if Calculate.CalcError then return 0
    if last = listCurrent->nxt then last = listCurrent
    listCurrent->token = Calculate.Tokens.Number
    listCurrent->value = str(value)
    listCurrent->nxt->token = Calculate.Tokens.Nil
    value = Calculate.eval(first, last)
    Calculate.debug "function " & listCurrent->value & " returns " & value
    return value
  end if
  ' xor, imp, eqv
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.OpXor + 2^Calculate.Tokens.OpImp _
                                   + 2^Calculate.Tokens.OpEqv, first, last)
  if listCurrent then
    dim as CALCULATE_DATATYPE l = Calculate.eval(first, listCurrent->prev), r = Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "xor,imp,eqv values " & l & " , " & r
    select case listCurrent->token
      case Calculate.Tokens.OpXor : return l xor r
      case Calculate.Tokens.OpImp : return l imp r
      case Calculate.Tokens.OpEqv : return l eqv r
    end select
  end if
  ' or
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.OpOr, first, last)
  if listCurrent then
    dim as CALCULATE_DATATYPE l = Calculate.eval(first, listCurrent->prev), r = Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "or values " & l & " , " & r
    return l or r
  end if
  ' and
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.OpAnd, first, last)
  if listCurrent then
    dim as CALCULATE_DATATYPE l = Calculate.eval(first, listCurrent->prev)
    dim as CALCULATE_DATATYPE r = Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "and values " & l & " , " & r
    return l and r
  end if
  ' not
  listCurrent = first
  do while listCurrent
    if listCurrent->token = Calculate.Tokens.OpNot then
      value = Calculate.eval(listCurrent->nxt, last)
      if Calculate.CalcError then
        return 0
      else
        listCurrent->replace(last->prev, Calculate.Tokens.Number, str(not value))
        last->token = Calculate.Tokens.Nil
        Calculate.debug "not returns " & not value
        return Calculate.eval(first, last)
      end if
    end if
    if listCurrent = last then exit do
    listCurrent = listCurrent->nxt
  loop
  ' +, -
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.Plus + 2^Calculate.Tokens.Minus, first, last)
  if listCurrent andalso listCurrent <> first then
    dim as CALCULATE_DATATYPE l = Calculate.eval(first, listCurrent->prev), r = Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "+,- values " & l & " , " & r
    select case listCurrent->token
      case Calculate.Tokens.Plus  : return l + r
      case Calculate.Tokens.Minus : return l - r
    end select
  end if
  ' shr, shl
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.OpShr + 2^Calculate.Tokens.OpShl, first, last)
  if listCurrent then
    dim as CALCULATE_DATATYPE l = Calculate.eval(first, listCurrent->prev), r = Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "shr,shl values " & l & " , " & r
    select case listCurrent->token
      case Calculate.Tokens.OpShr : return l shr r
      case Calculate.Tokens.OpShl : return l shl r
    end select
  end if
  ' mod
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.OpMod, first, last)
  if listCurrent then
    value = Calculate.eval(first, listCurrent->prev) mod Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "mod returns " & value
    return value
  end if
  ' \
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.Backslash, first, last)
  if listCurrent then
    value = Calculate.eval(first, listCurrent->prev) \ Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "\ returns " & value
    return value
  end if
  ' /, *
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.Slash + 2^Calculate.Tokens.Asterisk, first, last)
  if listCurrent then
    dim as CALCULATE_DATATYPE l = Calculate.eval(first, listCurrent->prev), r = Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "/,* values " & l & " , " & r
    select case listCurrent->token
      case Calculate.Tokens.Slash    : return l / r
      case Calculate.Tokens.Asterisk : return l * r
    end select
  end if
  ' sign
  if first->token = Calculate.Tokens.Plus  then
    value = Calculate.eval(first->nxt, last)
    Calculate.debug "+ returns " & value
    return value
  end if
  if first->token = Calculate.Tokens.Minus then
    value = -Calculate.eval(first->nxt, last)
    Calculate.debug "- returns " & value
    return value
  end if
  ' ^
  listCurrent = Calculate.evalSearch(2^Calculate.Tokens.Exponent, first, last)
  if listCurrent then
    value = Calculate.eval(first, listCurrent->prev) ^ Calculate.eval(listCurrent->nxt, last)
    Calculate.debug "^ returns " & value
    return value
  end if
  ' nothing found
  Calculate.CalcError = Calculate.Errors.ErrorIllegalValue
  return 0
end function

function Calculate.evalSearch(token as integer, first as Calculate.TToken ptr, last as Calculate.TToken ptr) _
         as Calculate.TToken ptr
  dim as Calculate.TToken ptr listCurrent = last
  do while listCurrent
    if bit(token, listCurrent->token) then return listCurrent
    if listCurrent = first then return 0
    listCurrent = listCurrent->prev
  loop
  return 0
end function

function Calculate.getVar(variable as string) as CALCULATE_DATATYPE
  for i as integer = 0 to ubound(Calculate.localVar)
    if Calculate.localVar(i).id = variable then return Calculate.localVar(i).value
  next
  for i as integer = 0 to ubound(Calculate.globalVar)
    if Calculate.globalVar(i).id = variable then return Calculate.globalVar(i).value
  next
  Calculate.CalcError = Calculate.ErrorUndefinedVariable
  Calculate.CalcErrorTerm = variable
  return Calculate.NaN
  return 0
end function

function Calculate.getVar(tok as Calculate.TToken ptr) as CALCULATE_DATATYPE
  dim as CALCULATE_DATATYPE v
  if Calculate.CalcError then return 0
  if tok = 0 then
    Calculate.CalcError = Calculate.ErrorIllegalSymbol
    return 0
  end if
  ' check if it's a function
  if tok->token = Calculate.Tokens.Func then
    if tok->nxt = 0 orelse _
          tok->nxt->token <> Calculate.Tokens.Number _
          and tok->nxt->token <> Calculate.Tokens.Variable _
          and tok->nxt->token <> Calculate.Tokens.Func then
      Calculate.CalcError = Calculate.ErrorMissingValue
      return 0
    else
      if tok->nxt->token = Calculate.Tokens.Number then
        v = val(tok->nxt->value)
      else
        v = Calculate.getVar(tok->nxt)
        if Calculate.CalcError then return 0
      end if
    end if
  else
    ' check if it's a defined variable
    return Calculate.getVar(tok->value)
  end if
  select case tok->value
    case "sin"
      return sin(v)
    case "cos"
      return cos(v)
    case "tan"
      return tan(v)
    case "asin"
      if v < -1 or v > 1 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = "asin(" & v & ")"
        return Calculate.NaN
      end if
      return asin(v)
    case "acos"
      if v < -1 or v > 1 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = "acos(" & v & ")"
        return Calculate.NaN
      end if
      return acos(v)
    case "atan", "atn"
      return atn(v)
    case "abs"
      return abs(v)
    case "sgn"
      return sgn(v)
    case "sqr"
      if v < 0 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = "sqr(" & v & ")"
        return Calculate.NaN
      end if
      return sqr(v)
    case "exp"
      return exp(v)
    case "log", "ln"
      if v <= 0 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = tok->value & "(" & v & ")"
        return Calculate.NaN
      end if
      return log(v)
    case "int"
      return int(v)
    case "cint"
      return cint(v)
    case "fix"
      return fix(v)
    case "frac"
      return frac(v)
  end select
  Calculate.CalcError = Calculate.ErrorUndefinedVariable
  Calculate.CalcErrorTerm = tok->value
  return 0
end function

sub Calculate.setVar(variable as string, value as CALCULATE_DATATYPE, scop as integer = 0)
  select case variable
    case "sin", "cos", "tan", "asin", "acos", "atan", "atn", "abs", "sgn", "sqr", _
         "exp", "log", "ln", "int", "cint", "fix", "frac"
      Calculate.CalcError = Calculate.ErrorOverwriteFunction
      Calculate.CalcErrorTerm = variable
      exit sub
  end select
  if scop then
    ' set local variable
    if ubound(Calculate.localVar) < 0 then
      redim Calculate.localVar(0)
      Calculate.localVar(0) = Calculate.TVariable(variable, value)
    else
      for i as integer = 0 to ubound(Calculate.localVar)
        if Calculate.localVar(i).id = variable then Calculate.localVar(i).value = value : exit sub
      next
      redim preserve Calculate.localVar(ubound(Calculate.localVar)+1)
      Calculate.localVar(ubound(Calculate.localVar)) = Calculate.TVariable(variable, value)
    end if
  else
    ' set global variable
    if ubound(Calculate.globalVar) < 0 then
      redim Calculate.globalVar(0)
      Calculate.globalVar(0) = Calculate.TVariable(variable, value)
    else
      for i as integer = 0 to ubound(Calculate.globalVar)
        if Calculate.globalVar(i).id = variable then Calculate.globalVar(i).value = value : exit sub
      next
      redim preserve Calculate.globalVar(ubound(Calculate.globalVar)+1)
      Calculate.globalVar(ubound(Calculate.globalVar)) = Calculate.TVariable(variable, value)
    end if
  end if
end sub