Калькулятор

← →
nstur (2006-09-15 16:07) [0]

Подскажите методы или компоненты способные вычислять строковое выражение вводимое пользователем.
Типа: (20+10)/5

← →
Ketmar © (2006-09-15 16:16) [1]

подсказываю метод: разобрать и вычислить.

← →
MBo © (2006-09-15 16:20) [2]

в RXLib есть парсер

← →
Cyrax © (2006-09-15 22:38) [3]

Есть кулькулятор такой интеллектуальный, виндовый.
Так что и компоненты не нужню....

← →
Zeqfreed © (2006-09-15 22:48) [4]

http://www.google.com/search?q=(20%2B10)/5

← →
AlexeyT © (2006-09-16 10:11) [5]

Ищи компоненты на Torry.net по словам: parser math expressions.

← →
DprYg © (2006-09-16 10:16) [6]

> Есть кулькулятор такой интеллектуальный, виндовый.
Такой интеллектуальный, что для того чтобы вычислить какое-то выражение, нужно его перевести в спецкод, который написать в блокноте, скопировать в буфер, а затем из него вставить в окно.

← →
BorisMor © (2006-09-16 21:16) [7]

В постфиксную форму переводим и делаем что надо.
Вот мой самопальный модуль.

{Перевод в постфиксную форму (c) BorisMor Описание с http://alglib.sources.ru/expressions/tosimplerpn.php Исходная формула Польская запись a+b a b + a+b*c a b c * + (a+b)*c a b +c * 123*(a+b)*c 123 a b + * c * 1. Символ английского алфавита, значит мы имеем переменную - считываем ее имя и помещаем в результирующую строку. 2. Цифра, значит мы имеем число - считываем его полностью и помещаем в результирующую строку. 3. Открывающаяся скобка "(" - помещаем ее на стек. 4. Закрывающаяся скобка ")" - переносим операции со стека в результирующую строку до момента пока не сняли со стека "(", открывающуюся скобку в результат не помещаем. Если открывающаяся скобка так и не встретилась, значит в исходном выражение неправильно расставлены скобки помещаем в результат "ERROR" и выходим из алгоритма. 5. Операция "+","-","*","/" - переносим в результат операции с вершины стека до тех пор пока стек не пуст и приоритет текущей операции меньше либо равен приритету операции находящейся на вершине стеке. Затем помещаем текущую операцию на стек. a) если в стеке нет операций, операции кладётся в стек; b) если новая операции имеет больший приоритет , чем верхняя операции в стеке, то новая операции кладётся в стек; c) если новая операция имеет меньший или равный приоритет, чем верхняя операции в стеке, то все операции, находящиеся в стеке, перекладываются в формируемую запись, а новая операции кладётся в стек. После окончанию переносим операции оставшиеся на стеке в результат. Если на стеке осталась открывающаяся скобка, значит в обрабатываемом выражении содержится ошибка, а следовательно помещаем в результат ERROR } unit uPostfix; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Dialogs ; type TTypeChar = (tcNum, tcMath, tcOScob, tcCScob, tcOther); // Вовзращает приоритет операции function PriorityOper(ch: char): integer; // Сравнивает операций: если приоритет newOp больше oldOp то возвращается true function CmpOper(newOp, oldOp: char): boolean; // Разбивает строку value на лексеммы и помещает их в список procedure BreakLex(value: string; ListLex: TStringList); // Вовзращает тип символа function TypeChar(c: Char): TTypeChar; // Перевести в постфиксную форму. Все лексеммы заносит в lsOut procedure Postfix(value: string; lsOut: TStringList); // Результат работы Postfix в виде строки function PostfixStr(value: string): string; // Добавляет в lsOut данные из lsIn под номером ind (строку и Objects) procedure CopyLine(lsSource,lsOut: TStringList; ind: integer); // Простейшая операция над двумя числамми function SimplCalc (op1,op2: Extended ; act: string):Extended; // Подсчет данныых записанных в строке function calcul(value: string) :Extended; implementation //////////////////////////////////////////////////////////////////////////////// // Простейшая операция над двумя числамми function SimplCalc (op1,op2: Extended ; act: string):Extended; var ch: Char; begin result := 0; ch := act[1]; case ch of "+" : result := op1 + op2; "-" : result := op1 - op2; "/" : result := op1 / op2; "*" : result := op1 * op2; end; {case} end; //////////////////////////////////////////////////////////////////////////////// // Подсчет данныых записанных в строке function calcul(value: string) :Extended; var lst: TStringList; i,j: integer; b: boolean; op1,op2, rez: Extended; ch: char; sRez: string; begin result := 0; lst := TStringList.Create; try Postfix(value, lst); // Переводим в постфиксный вид while lst.Count > 1 do begin i := 0; b := false; // Находим первую мат. операцию repeat b := TTypeChar(lst.Objects[i]) = tcMath; if not b then inc(i); until (i > lst.Count) or b; if b then // Нашли какую то операцию ==> берем идущие перед ней 2 числа и выполняем begin ch := lst[i][1]; op2 := StrToFloat(lst[i-1]); op1 := StrToFloat(lst[i-2]); rez := SimplCalc(op1,op2,ch); sRez := FloatToStr(rez); // Убиваем теперь эти данные for j:=i downto i-2 do lst.Delete(j); lst.Insert(i-2,sRez); end; end; result := StrToFloat(lst[0]); finally lst.Free; end; end;

← →
BorisMor © (2006-09-16 21:16) [8]

и продолжение...

//////////////////////////////////////////////////////////////////////////////// // Результат работы Postfix в виде строки function PostfixStr(value: string): string; var lst: TStringList; i: integer; begin result := ""; lst := TStringList.Create; try Postfix(value, lst); for i:=0 to lst.Count-1 do result := result + lst[i] finally lst.Free; end; end; //////////////////////////////////////////////////////////////////////////////// // Копирует из lsIn в lsOut данные под номером ind (строку и Objects) procedure CopyLine(lsSource,lsOut: TStringList; ind: integer); var i: integer; s: string; begin if (ind > lsSource.Count-1) then exit; s := lsSource[ind]; i := lsOut.Add(s); lsOut.Objects[i] := lsSource.Objects[ind]; end; //////////////////////////////////////////////////////////////////////////////// // Вовзращает приоритет операции function PriorityOper(ch: char): integer; begin result := -1; if (ch="+") or (ch="-") then result := 0 else if (ch="*") or (ch="/") or (ch="\") then result := 1 else end; //////////////////////////////////////////////////////////////////////////////// // Сравнение операций. если сзначение newOp больше oldOp то возвращается true function CmpOper(newOp, oldOp: char): boolean; var iNew, iOld: integer; begin iNew := PriorityOper(newOp); iOld := PriorityOper(oldOp); result := iNew > iOld; end; //////////////////////////////////////////////////////////////////////////////// { Вовзращает тип символа tcNum - цифра tcMath - математическая операциия tcOScob - скобка открывается tcCScob - скобка закрывается tcOther - другое } function TypeChar(c: Char): TTypeChar; var bChar: Byte; begin result := tcOther; bChar := ord(c); case bChar of $2A,$2B: result := tcMath; // мат. операции *+ $2C: result := tcNum; // число , $2D: result := tcMath; // мат. операции - $2E: result := tcNum; // число . $2F: result := tcMath; // мат. операции - $30..$39: result := tcNum; // числа $28: result := tcOScob; // ( $29: result := tcCScob; // ) end; end; //////////////////////////////////////////////////////////////////////////////// // Разьивает строку value на лексеммы и помещает их в список procedure BreakLex(value: string; ListLex: TStringList); var s,s1: string; ch: Char; sValue: string; bChar: byte; i,j,k: integer; curType, newType: TTypeChar; cutLex: string; begin ListLex.Clear; if value = "" then exit; // Убиваем не нужные символлы оставляем тольк: цыфры, зпт, тчк, и мат символлы sValue := ""; j := length(value); i := 1; repeat ch := value[i]; // Меняем пару символов --- if ch = "," then ch:="." else if ch = "\" then ch:="/"; // ------------------------ bChar := Ord(ch); if (bChar > $27) and ( bChar < $3A) then sValue := sValue + ch; inc(i); until i > j; j := length(sValue); if j=0 then exit; curType := tcOther; cutLex := ""; i := 1; inc(j); // Сама разбивка на лексеммы while i <= j do begin newType := TypeChar(sValue[i]); if (newType <> curType) then // началась новая лексемма begin if cutLex <> "" then begin k := ListLex.Add(cutLex); ListLex.Objects[k] := Pointer(curType); cutLex := ""; end; {if} curType := newType; end; {if} cutLex := cutLex + sValue[i]; inc(i); end; end; //////////////////////////////////////////////////////////////////////////////// // Перевести в постфиксную форму // Значени заносится в lsOut procedure Postfix(value: string; lsOut: TStringList); var lex, stack: TStringList; i, top: integer; sLex: string; tLex: TTypeChar; begin lsOut.Clear; lex := TStringList.Create; stack := TStringList.Create; try BreakLex(value,lex); // Разбили на лексеммы for i := 0 to lex.Count-1 do // проходимся по спику лексем begin sLex := lex[i]; // лексема tLex := TTypeChar(lex.Objects[i]); // что за лексема case tLex of tcNum : CopyLine(lex,lsOut,i); // цыфры tcOScob : CopyLine(lex,stack,i); // Скобка открыта tcCScob : begin // Скобка закрыта ==> берем данные из стека top := stack.Count-1; while (top > -1) and (stack[top] <> "(") do begin CopyLine(stack,lsOut,top); // Копируем из стека top stack.Delete(top); dec(top); end; {while} if stack[top] = "(" then stack.Delete(top); end; tcMath : // Математическая операция begin top := stack.Count-1; if top < 0 then // в стеке нет числе ==> Заносим операцию в стек CopyLine(lex,stack,i) // цыфры else // В стеке есть данные begin if CmpOper(sLex[1], stack[top][1]) then // приоритет новой операции >= чем в стеке ==> заносим в стек CopyLine(lex,stack,i) else begin while (top > -1) and (stack[top] <> "(") do // Скидываем то что былов стеке begin CopyLine(stack,lsOut,top); // Копируем из стека top stack.Delete(top); dec(top); end; {wile} CopyLine(lex,stack,i); // цыфры end; {else} end; {else} end; end; {case} end; {for} // Выкладываем все что осталось в стеке top := stack.Count-1; while (top > -1) do begin CopyLine(stack,lsOut,top); // Копируем из стека top stack.Delete(top); dec(top); end; finally stack.Free; lex.Free; end; end; //////////////////////////////////////////////////////////////////////////////// end.

Блин... орфография в коментах конечно хромает :)

Алгоритм Дейкстры для перевода в обратную польскую запись - автору в зубы

http://kladovka.net.ru

Калькулятор Найти похожие ветки