Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
8
Добавлен:
16.12.2017
Размер:
6.88 Кб
Скачать
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.
Соседние файлы в папке Курсовая (обратная польская запись)
  • #
    16.12.2017159 б7polskaya.identcache
  • #
    16.12.2017876 б7polskaya.res
  • #
    16.12.2017161 б7polskaya.stat
  • #
    16.12.20178.98 Кб8polskayazapic.dcu
  • #
    16.12.20171.69 Кб8polskayazapic.dfm
  • #
    16.12.20176.88 Кб8polskayazapic.pas
  • #
    16.12.2017766 б9polskaya_Icon.ico