VPF::Преобразование строки в выражение

ssb

Дата 18.9.2003, 15:41 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 38
Регистрация: 5.8.2003

Репутация: нет
Всего: нет

Есть у меня поле текстовое, в котором написано выражение, например... Sqr(1+2/568). Нужно посчитать его значение. Как?

Mephisto

Дата 18.9.2003, 16:42 (ссылка)

(нет голосов)

Загрузка ...

Волкъ

Профиль
Группа: Завсегдатай
Сообщений: 1818
Регистрация: 27.8.2003
Где: Питер

Репутация: 2
Всего: 34

Проще всего на калькуляторе. Но если всё же настаиваешь на ВэБе то прийдётся тебе очень долго парить свою голову всякой ерундой. Проще зайди на кульный сайт и поищи там. Я видел там прикольный sample.
А на счет написания кода это уж извини много гем***я.

RAN

Дата 18.9.2003, 16:50 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Экс. модератор
Сообщений: 709
Регистрация: 14.3.2003
Где: Щёлково Моск.обл.

Репутация: нет
Всего: 6

Это интересно. Можно покапать в Excel. Может им можно воспользоваться. В VB я о такой функции не слышал.
А так, есть такие алгоритмы. Они не сложные. Зайди в технологии и алгоритмы и поищи про обратную польскую запись. Я делал на VB такую вещь. Вот код:

Код


'============================================================================
'  РЕШЕНИЕ ВЫРАЖЕНИЙ (Обратная польская запись)
'============================================================================

' Описание стека
Dim st_c(0 To 255) As String * 1
Dim st_k As Integer
Dim NumStack(0 To 255) As Double
Dim iNumStack As Integer
Function CalculateExpression(expr As String) As Variant
  If Trim(expr) = "" Then
      CalculateExpression = ""
      Exit Function
  End If
  
  Dim x As Double, y As Double
  ' Стек пуст
  iNumStack = 0
  st_k = 0
  Dim k As Integer
  k = 1
      ' Повтоpяем , пока не дойдем до '='
  Dim ch As String * 1
  ch = Mid(expr, k, 1)
  While k <= Len(expr) And ch <> "="
                   ' Если очеpедной символ - цифра , то
      If ch = "." Or ch = "," Or (ch >= "0" And ch <= "9") Then
            x = 0
            While ch >= "0" And ch <= "9" And k <= Len(expr)
                x = x * 10
                x = x + (Asc(ch) - 48)
                k = k + 1
                If k <= Len(expr) Then ch = Mid(expr, k, 1)
            Wend
            ch = Mid(expr, k, 1)
            If ch = "." Or ch = "," Then
                k = k + 1
                ch = Mid(expr, k, 1)
                Dim div As Integer
                div = 1
                While ch >= "0" And ch <= "9" And k <= Len(expr)
                    div = div * 10
                    x = x + (Asc(ch) - 48) / div
                    k = k + 1
                    If k <= Len(expr) Then ch = Mid(expr, k, 1)
                Wend
            End If
            NumStack(iNumStack) = x
            iNumStack = iNumStack + 1
      Else
            ' Если очеpедной символ - ')'
          If ch = ")" Then
                         ' то выталкиваем из стека в выходную стpоку
                         ' все знаки опеpаций до ближайшей откpывающей скобки
            While st_c(st_k - 1) <> "("
                iNumStack = iNumStack - 1
                x = NumStack(iNumStack)
                y = NumStack(iNumStack - 1)
                  ' Вычисляем значение
                st_k = st_k - 1
                NumStack(iNumStack - 1) = calc(x, y, st_c(st_k))
            Wend
                  ' Удаляем из стека саму откpывающую скобку
            st_k = st_k - 1
          End If

                    ' Если очеpедной символ - '(' , то
          If ch = "(" Then
              ' заталкиваем её в стек */
              st_c(st_k) = ch
              st_k = st_k + 1
          End If
              
          If ch = "+" Or ch = "-" Or ch = "/" Or ch = "*" Or ch = "x" Or ch = "X" _
                                            Or ch = "х" Or ch = "Х" Then 'рус
                 ' Если следующий символ - знак опеpации , то:
                 ' если стек пуст
                 If st_k = 0 Then
                 ' записываем в него опеpацию
                     st_c(st_k) = ch
                     st_k = st_k + 1
                 Else
                 ' если не пуст
                 ' если пpиоpитет поступившей опеpации больше или равен
                 ' пpиоpитету опеpации на веpшине стека
                     If Prior(st_c(st_k - 1)) >= Prior(ch) Then
                         Do While Prior(st_c(st_k - 1)) >= Prior(ch)
                             iNumStack = iNumStack - 1
                             x = NumStack(iNumStack)
                             y = NumStack(iNumStack - 1)
                             ' Вычисляем значение
                             st_k = st_k - 1
                             NumStack(iNumStack - 1) = calc(x, y, st_c(st_k))
                             If st_k = 0 Then Exit Do
                         Loop
                     End If
                     ' записываем в стек поступившую  опеpацию
                     st_c(st_k) = ch
                     st_k = st_k + 1
                 End If
          End If
          
          k = k + 1
          ch = Mid(expr, k, 1)
      End If
    Wend
       ' после pассмотpения всего выpажения
    While st_k > 0
        iNumStack = iNumStack - 1
        x = NumStack(iNumStack)
        y = NumStack(iNumStack - 1)
        ' Вычисляем значение
        st_k = st_k - 1
        NumStack(iNumStack - 1) = calc(x, y, st_c(st_k))
    Wend
    If iNumStack <> 1 Then
        MsgBox "Ошибка вычисления выражения " & expr, vbOKOnly + vbCritical, "Ошибка"
    Else
        CalculateExpression = NumStack(0)
    End If
End Function

' Функция Prior возвpащает пpиоpитет аpифм. опеpации
Function Prior(ByVal a As String) As Integer
  Select Case a
    Case "*", "x", "X", "х", "Х", "/"
         Prior = 3
    Case "-", "+"
         Prior = 2
    Case "("
         Prior 1
  End Select
End Function

' Выполняет операцию op над x и y
Function calc(x As Double, y As Double, ByVal op As String) As Double
  Select Case op
    Case "*", "x", "X", "х", "Х" 'чтоб можно было не только * использовать, но x рус. и eng. Для наглядности
         calc = y * x
    Case "/"
         calc = y / x
    Case "-"
         calc = y - x
    Case "+"
         calc = y + x
  End Select
End Function

Алгоритм не идеальный. Он для себя писался. Идея где-то позаимствована, но мною доработана. sqr сюда надо добавить и др. необходимые функции.

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| VB6 \| Следующая тема »