Курсовая (обратная польская запись) / polskayazapic

unit polskayazapic;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Math, Menus;
 
type
  TForm1 = class(TForm)
    edit1: TEdit;
    edit2: TEdit;
    button1: TButton;
    button2: TButton;
    label3: TLabel;
    label4: TLabel;
    mainmenu1: TMainMenu;
    n1: TMenuItem;
    n2: TMenuItem;
    n3: TMenuItem;
    n6: TMenuItem;
    info: TMemo;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  Expression: string;
  Razbor: TStringList;
 
implementation
 
{$R *.dfm}
 
(* Получение приоритета *)
function GetPriority( c: char ): byte;
begin
   Result := 0;
   case c of
      '(': Result := 1;
      '+', '-': Result := 2;
      '*', '/': Result := 3;
      '^', '!': Result := 4;
      'c', 's', 'l', 'e': Result := 5;
      'n': Result := 6;
   end;
end;
 
(* Переводим строку с формулой в обратную польскую запись *)
procedure ParseString( s: string; var _Stack: TStringList );
var
  Ms: TMemoryStream;
  Temp: TStringList; // Временный стек для знаков и геометрических функций
  flag: boolean;
begin
   Temp := TStringList.Create;
   Ms := TMemoryStream.Create;
   Ms.WriteBuffer( s[1], Length( s ) );
   Ms.Position := 0;
   with TParser.Create( Ms ) do
   begin
      while Token <> toEof do
      begin
         // Если это число, помещаем его в выходной стек
         if ( TokenString[1] in ['0'..'9'] ) then
            if flag then
            begin
               _Stack[_Stack.Count-1] := _Stack[_Stack.Count-1] + TokenString;
               flag := false;
            end
            else
               _Stack.Add( TokenString );
         // Если это разделитель дробной части
         if ( TokenString[1] in [DecimalSeparator] ) then
         begin
            _Stack[_Stack.Count-1] := _Stack[_Stack.Count-1] + TokenString;
            flag := true;
         end;
         // Если это знак (или геометрическая функция), то...
         if ( TokenString[1] in ['+','-','/','*','^','!','c','s','l','n','e'] ) then
         begin
            // ...если стек пустой, помещаем знак в стек ...
            if Temp.Count = 0 then
               Temp.Add( TokenString )
            else
            begin
               // ... если приоритер текущей операции выше, чем приоритет
               // последней операции в стеке, помещаем знак в стек ...
               if GetPriority( TokenString[1] ) > GetPriority( Temp.Strings[Temp.Count-1][1] ) then
                  Temp.Add( TokenString )
               else
               begin
                  // ... иначе извлекаем из стека все операции, пока
                  // не встретим операцию с более высшим приоритетом
                  while true do
                  begin
                     _Stack.Add( Temp.Strings[Temp.Count-1] );
                     Temp.Delete( Temp.Count-1 );
                     if Temp.Count = 0 then Break;
                     if GetPriority( TokenString[1] ) > GetPriority( Temp.Strings[Temp.Count-1][1] ) then
                        Break;
                  end;
                  //добавить в стек текущую операцию
                  Temp.Add( TokenString );
               end;
            end;
         end;
         // Если это открывающая скобка, помещаем ее в стек операций
         if ( TokenString[1] in ['('] ) then
            Temp.Add( TokenString );
         // Если это закрывающая скобка, извлекаем из стека операций в
         // выходной стек все операции, пока не встретим открывающую скобку.
         // Сами скобки при зтом уничтожаются.
         if ( TokenString[1] in [')'] ) then
         while true do
         begin
            if Temp.Count = 0 then Break;
            if Temp.Strings[Temp.Count-1] = '(' then
            begin
               Temp.Delete( Temp.Count-1 );
               Break;
            end;
            _Stack.Add( Temp.Strings[Temp.Count-1] );
            Temp.Delete( Temp.Count-1 );
         end;
         NextToken;
      end;
   end;
   Ms.Free;
   // Если по окончании разбора строки с формулой, в стеке операций
   // еще чтото осталось, извлекаем все в выходной стек
   if Temp.Count <> 0 then
      while Temp.Count <> 0 do
      begin
         _Stack.Add( Temp.Strings[Temp.Count-1] );
         Temp.Delete( Temp.Count-1 );
      end;
   Temp.Free;
end;
 
(* Рассчитываем выражение в постфиксной форме *)
function Calculate( var _Stack: TStringList ): real;
var
  i: integer;
  a1, a2: real;
  Temp: TStringList; // Временный стек для рассчетов
begin
   Result := 0;
   Temp := TStringList.Create;
   for i := 0 to _Stack.Count-1 do
      // Если зто число, помещаем его в стек для рассчета, иначе ...
      if _Stack.Strings[i][1] in ['0'..'9'] then
         Temp.Add( _Stack.Strings[i] )
      else
      begin
         // ... Вынимаем из стека рассчета последнее число
         a2 := StrToFloat( Temp.Strings[Temp.Count-1] );
         Temp.Delete( Temp.Count-1 );
         // если для выполнения операции требуется 2 аргумента,
         // вынимаем из стека рассчета еще одно число
         if _Stack.Strings[i][1] in ['+','-','/','*','^'] then
         begin
            a1 := StrToFloat( Temp.Strings[Temp.Count-1] );
            Temp.Delete( Temp.Count-1 );
         end;
         // Производим рассчет
         case _Stack.Strings[i][1] of
            '+': Temp.Add( FloatToStr( a1 + a2 ) );
            '-': Temp.Add( FloatToStr( a1 - a2 ) );
            '/': Temp.Add( FloatToStr( a1 / a2 ) );
            '*': Temp.Add( FloatToStr( a1 * a2 ) );
            '^': Temp.Add( FloatToStr( Power( a1, a2 ) ) );
            'c': Temp.Add( FloatToStr( cos( a2 ) ) );
            's': Temp.Add( FloatToStr( sin( a2 ) ) );
            'l': Temp.Add( FloatToStr( ln( a2 ) ) );
            'n': Temp.Add( FloatToStr( -a2 ) );
            'e': Temp.Add( FloatToStr( exp( a2 ) ) );
         end;
      end;
   Result := StrToFloat( Temp.Strings[0] );
   Temp.Free;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  i: integer;
begin
   Razbor.Clear;
   Edit2.Clear;
   Expression := AnsiLowerCase( Edit1.Text );
   Expression := StringReplace( Expression, '+', ' + ', [rfReplaceAll, rfIgnoreCase] );
   Expression := StringReplace( Expression, '-', ' - ', [rfReplaceAll, rfIgnoreCase] );
   ParseString( Expression, Razbor );
   for i := 0 to Razbor.Count-1 do
      Edit2.Text := Edit2.Text + Razbor.Strings[i] + ' ';
end;
 
 
 
procedure TForm1.Button1Click(Sender: TObject);
begin
Close;
end;

 
initialization
  Razbor := TStringList.Create;
 
finalization
  Razbor.Free;
 
end.