{ **** UBPFD *********** by kladovka.net.ru ****
>>
Для работы функции необходимо определить тип:
type
OperList = array of widestring;
Параметром функции служит массив из переменных и операторов.
Результат - массив из переменных и операторов
Зависимости: SysUtils
Автор: avr555, <a href="mailto:avr555@mail.ru">avr555@mail.ru</a>, ICQ:15782989
Copyright: Переделано с http://algolist.manual.ru/syntax/revpn.php
Дата: 26 мая 2002 г.
********************************************** }
function ConvertToRPN(AStr:OperList):OperList;
var
 i,k:integer;
 Stack : OperList; //Stack
 AResult : OperList; //Tmp for result
 function Prior(AOper:widestring):integer;
 begin
  {Приоритет операции:
  NOT - 8
  унарный "-" - 7
  "*", "/" - 6
  "+", "-" - 5
  ">", "<", "=",
  "<>", ">=",
  "<=" - 4
  "AND" - 3
  "OR" - 2
  "(", ")" - 1
  }
  AOper := trim(AOper);
  result := -1;
  if AOper = 'NOT' then Result := 8;
  if (AOper = '*') or (AOper = '/') then Result := 6;
  if (AOper = '+') or (AOper = '-') then Result := 5;
  if (AOper = '>') or (AOper = '<') or (AOper = '<>') or (AOper = '>=')
  or (AOper = '<=') or (AOper = '=') then Result := 4;
  if AOper = 'AND' then Result := 3;
  if AOper = 'OR' then Result := 2;
  if (AOper = '(') or (AOper = ')') then Result := 1;
 end;
 procedure AddToStack(AOper:widestring);
 begin
  {Добавление элементы в стек}
  SetLength(Stack,High(Stack)+2);
  Stack[High(Stack)] := AOper;
 end;
 procedure AddToResult(AOper:widestring);
 begin
  SetLength(AResult,High(AResult)+2);
  AResult[High(AResult)] := AOper;
 end;
begin
 {Конвертирование строку в Обратную Польскую Нотацию
  Возвращает - массив
  Алгоритм:
  а) если стек пуст, то опеpация из входной стpоки пеpеписывается в стек;
  б) опеpация выталкивает из стека все опеpации с большим или pавным
  пpиоpитетом в выходную стpоку;
  в) если очеpедной символ из исходной стpоки есть откpывающая скобка,
  то он пpоталкивается в стек;
  г) закpывающая кpуглая скобка выталкивает все опеpации из стека до
  ближайшей откpывающей скобки, сами скобки в выходную стpоку не
  пеpеписываются, а уничтожают дpуг дpуга.
 }
 Result := nil;
 AResult := nil;
 i := 0;
 while i <= High(AStr) do
 begin
  if Prior(AStr[i]) = -1 then //Значит просто переменная
  AddToResult(AStr[i])
  else //Операции
  begin
  if High(Stack) = -1 then {a}
  AddToStack(AStr[i])
  else
  begin
  if AStr[i] = '(' then {в}
  AddToStack(AStr[i])
  else
  begin
  if AStr[i] = ')' then {г}
  begin
  k := High(Stack);
  while (k>=0) and (Stack[k] <> '(') do
  begin
  AddToResult(Stack[k]);
  SetLength(Stack,High(Stack)); //Удаляем элемент из стека
  k := k - 1;
  end;
  //Удаляем открывающуюся скобку
  SetLength(Stack,High(Stack)); //Удаляем элемент из стека
  end
  else
  begin
  k := High(Stack);
  while (k>=0) and (Prior(Stack[k]) >= Prior(AStr[i])) do {б}
  begin
  AddToResult(Stack[k]);
  SetLength(Stack,high(Stack)); //Удаляем элемент из стека
  k := k - 1;
  end;
  AddToStack(AStr[i]); //Если не скобка просто добавляем в стек
  end;
  end;
  end;
  end;
  i := i + 1;
 end; //while
 //Сбрасываем все оставшееся из стека
 for i := high(Stack) downto 0 do
 begin
  AddToResult(Stack[i]);
 end;
 result := AResult;
end;

procedure test;

var

 s,s1:widestring;

 tmp,

 rtmp : OperList;

 i:integer;

begin

 s := '(A+B)*(C+D)-E';

 tmp := nil;

 rtmp := nil;

 for i:= 1 to Length(S) do

 begin

  SetLength(tmp, high(tmp)+2);

  tmp[high(tmp)] := S[i];

 end;

 rtmp := ConvertToRPN(tmp);

 s1 := '';

 for i := 1 to High(rtmp) do

 begin

  s1 := s1 + rtmp[i];

 end;

end;