Преобразование инфиксной записи в префиксную

unit Unit1;
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls;
 
const
  MAXPRIORITY=3; // больше любого из используемых приоритетов
  DIGITS=['0','1','2','3','4','5','6','7','8','9']; // цифры
  SIGNS=['+','-','*','/']; // знаки операций
 
type
  // ссылка на узел дерева выражения
  TreePtr = ^TreeNode;
  // узел дерева выражения
  TreeNode = record
    info: char;            // операнд или знак
    left, right: TreePtr; // ссылки на левое и правое поддеревья
  end;
  TfrmMain = class(TForm)
    Label1: TLabel;
    editExpression: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    btnCalc: TButton;
    treeExpression: TTreeView;
    lblPrefix: TLabel;
    lblInfix: TLabel;
    lblPostfix: TLabel;
 
procedure btnCalcClick(Sender: TObject);
  private
    root: TreePtr; // корень дерева выражения
    // возвращает приоритет знака
    function Priority (sign: char): integer;
    // построение дерева выражения
    function BuildTree (str: string): TreePtr;
    // проверяет, верно ли составлено выражение
    function ExpressionIsRight (str: string): boolean;
    // отображаем дерево в памяти на компонент
    procedure ShowTree;
    procedure ShowTreeNode (node: TreePtr; visnode: TTreeNode);
    // обходы с записью выражения
    procedure LKPturn (node: TreePtr); // инфикс
    procedure LPKturn (node: TreePtr); // постфикс
    procedure KLPturn (node: TreePtr); // префикс
  public
    { Public declarations }
  end;
 
var
  frmMain: TfrmMain;
 
implementation
{$R *.dfm}
 
{-----------------------------------------
Функция возвращает приоритет арифметического знака
-----------------------------------------}
function TfrmMain.Priority (sign: char): integer;
begin
  case sign of
    '+','-': Priority:=0;
    '*','/': Priority:=1;
  end;
end;
 
{-----------------------------------------
Построение дерева выражения по строке, содержащей однозначные числа-операнды и
знаки арифметических операций (без скобок)
-----------------------------------------}
function TfrmMain.BuildTree (str: string): TreePtr;
var
  tmp: TreePtr;
  i: integer;
  priormin, imin: integer;
  leftstr, rightstr: string;
begin
  // остался всего один символ в строке и это
  // обязательно операнд
  if length(str)=1 then begin
    // создаем новый лист с этим операндом
    New(tmp);
    tmp^.info:=str[1];
    tmp^.left:=nil;
    tmp^.right:=nil;
    Result:=tmp;
  end
  // обрабатываем длинную строку
  else begin
    // находим самый правый знак с наименьшим приоритетом
    i:=length(str);
    priormin:=MAXPRIORITY; // заведомо больше любого
    imin:=i;
    while i>=1 do begin
      // нашли очередной минимум
      if ((str[i] in SIGNS)and(Priority(str[i])<priormin)) then begin
        priormin:=Priority(str[i]);
        imin:=i;
      end; // if
      i:=i-1;
    end; // while
    // создаем узел дерева с найденным знаком
    New(tmp);
    tmp^.info:=str[imin];
    // выделяем левую и правую подстроку относительно этого знака
    leftstr:=Copy(str,1,imin-1);
    rightstr:=Copy(str,imin+1,length(str)-imin);
    // строим поддерево по каждой подстроке
    tmp^.left:=BuildTree(leftstr);
    tmp^.right:=BuildTree(rightstr);
    Result:=tmp;
  end; // else
end;
 
{-----------------------------------------
Правильно ли выражение?
-----------------------------------------}
function TfrmMain.ExpressionIsRight(str: string): boolean;
var
  i: integer;
begin
  Result:=true;
  for i:=2 to length(str) do
    // нельзя, чтобы рядом стояло два знака или два числа
    if ((str[i] in SIGNS)and(str[i-1] in Signs))or
       ((str[i] in DIGITS)and(str[i-1] in DIGITS)) then
         Result:=FALSE;
end;
 
{-----------------------------------------
Сборка расчета: получаем строку выражения, строим дерево, показываем дерево,
показываем разные записи выражения
-----------------------------------------}
procedure TfrmMain.btnCalcClick(Sender: TObject);
begin
  if editExpression.Text='' then begin
    MessageDlg('Ошибка! Выражение не должно быть пустым', mtError, [mbOK], 0);
    exit;
  end;
  if not ExpressionIsRight(editExpression.Text) then begin
    MessageDlg('Ошибка! Выражение должно состоять из однозначных чисел и '+
               'знаков +, -, *, / и быть составлено правильно. Например, '+
               '5+3*7', mtError, [mbOK], 0);
    exit;
  end;
  // строим дерево выражения
  root := BuildTree(editExpression.Text);
  // показываем дерево
  ShowTree;
  // показываем выражения
  lblInfix.Caption := '';
  LKPturn (root);
  lblPrefix.Caption := '';
  KLPturn (root);
  lblPostfix.Caption := '';
  LPKturn (root);
end;
 
{-----------------------------------------
Отображаем дерево в памяти на компонент TTreeView
-----------------------------------------}
procedure TfrmMain.ShowTree;
var
  tmp: TreePtr;
  vistmp: TTreeNode;
begin
  TreeExpression.Items.Clear;
  // обход
  ShowTreeNode (root, nil);
end;
 
{-----------------------------------------
Обход: приделываем узлы к визуальному дереву
-----------------------------------------}
procedure TfrmMain.ShowTreeNode(node: TreePtr; visnode: TTreeNode);
begin
  if (node<>nil) then begin
    visnode := TreeExpression.Items.AddChild(visnode, node^.info);
    ShowTreeNode(node^.left, visnode);
    ShowTreeNode(node^.right, visnode);
  end;
end;
 
{-----------------------------------------
Вывод строки арифметического выражения в инфиксном виде: A+B (ЛКП-обход)
-----------------------------------------}
procedure TfrmMain.LKPturn (node: TreePtr);
begin
  if node<>nil then begin
    LKPturn(node^.left);
    lblInfix.Caption := lblInfix.Caption + node^.info;
    LKPturn(node^.right);
  end;
end;
 
{-----------------------------------------
Вывод строки арифметического выражения в префиксном виде: +АВ (КЛП-обход)
-----------------------------------------}
procedure TfrmMain.KLPturn(node: TreePtr);
begin
  if node<>nil then begin
    lblPrefix.Caption := lblPrefix.Caption + node^.info;
    KLPturn(node^.left);
    KLPturn(node^.right);
  end;
end;
 
{-----------------------------------------
Вывод строки арифметического выражения в постфиксном виде
(обратная польская запись): АВ+ (ЛПК-обход)
-----------------------------------------}
procedure TfrmMain.LPKturn(node: TreePtr);
begin
  if node<>nil then begin
    LPKturn(node^.left);
    LPKturn(node^.right);
    lblPostfix.Caption := lblPostfix.Caption + node^.info;
  end;
end;
 
end.