Текущий архив: 2006.10.08;
Скачать: CL | DM;

Вниз

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

← →
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.


---

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

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

---

← →
TUser ©   (2006-09-17 10:00) [10]

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

---

← →
Kerk ©   (2006-09-17 12:27) [11]

http://kladovka.net.ru

---

Страницы: 1 вся ветка

Текущий архив: 2006.10.08;
Скачать: CL | DM;

Наверх

Память: 0.52 MB
Время: 0.069 c