//Program pobrano ze strony www.algorytm.org
//Opracował Michał Knasiecki
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Menus;

type
  TForm1 = class(TForm)
    Edit1: TEdit;       //Notacja infiksowa -wejscie
    Edit2: TEdit;       //ONP -wyjscie
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Bevel1: TBevel;
    Button2: TButton;
    MainMenu1: TMainMenu;
    Plik1: TMenuItem;
    Wczytajnotacjinfiksow1: TMenuItem;
    ZapiszONP1: TMenuItem;
    N1: TMenuItem;
    Zakoncz1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Wczytajnotacjinfiksow1Click(Sender: TObject);
    procedure ZapiszONP1Click(Sender: TObject);
    procedure Edit1Change(Sender: TObject);
    procedure Edit2Change(Sender: TObject);
    procedure Zakoncz1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
TYPE wskaznik_stosu=^skladnik_stosu;
        skladnik_stosu=record
        dane:char;
        wskaznik:wskaznik_stosu;
        end;


var
  Form1: TForm1;
  Liczba_Nawiasow:integer=0;
  implementation
function priorytet(op:string):byte;   //bada priorytet operatora
begin
if (op='(') then result:=0;
if (op='+')or(op='-') then result:=1;
if (op='*')or(op='/') then result:=2;
end;
function sprawdzenie(c:char):byte;
begin
if (c='*')or(c='/')or(c='+')or(c='-') then result:=1; //else
//result:=2;
if (c in['a'..'z'])or(c in['A'..'Z'])or(c in['0'..'9']) then result:=2;
if c=')' then result:=0;
if c='(' then result:=3;
end;
procedure nastos(var element:char;
                var wierzcholek:wskaznik_stosu); //Dodaje na stos
var punkt:wskaznik_stosu;
begin
punkt:=wierzcholek;
New(wierzcholek);
with wierzcholek^ do
        begin
        dane:=element;
        wskaznik:=punkt
        end;
end;
procedure zestosu(var element:char;
                var wierzcholek:wskaznik_stosu);  //Zdejmuje ze stosu
var punkt:wskaznik_stosu;
begin
if wierzcholek<>nil then
begin
with wierzcholek^ do
        begin
        element:=dane;
        punkt:=wskaznik;
        end;
Dispose(wierzcholek);
wierzcholek:=punkt;
end;
end;
{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var s:string; //dzialanie wczytane z edit1.text
//    {c,}c2:string; //zmienna pomocnicza do badania liczb i operatorów
    //t:string; //zmienna pomocnicza do wczytywania operatorów ze stosu
    i:integer; //licznik
    element,wierzcholek:wskaznik_stosu;
    c,t,c2:char;
begin
edit2.clear;
s:=edit1.text;    //wczytaj wyrażenie
wierzcholek:=nil;    //Dno stosu
i:=0;
repeat //Badaj wyrażenie znak po znaku
inc(i);
c:=s[i];           //Jesli trafiles na:
if (c='-')and(i=1) then  //Pierwsza liczba jest ujemna
        begin
        edit2.text:=edit2.text+c;
        inc(i);
        c:=s[i];
        end;
if sprawdzenie(c)=0 then     //1- Nawias zamknięty
     begin
     Dec(Liczba_Nawiasow);
       if not(wierzcholek=nil) then begin    //Jesli stos nie jest pusty
        element:=wierzcholek;
        repeat
        t:=element^.dane;
        element:=element^.wskaznik;
        zestosu(t,wierzcholek);     //Zdejmij z niego wszystkie operatory
        if not(t='(') then
        edit2.text:=edit2.text+t; //i wypisz wszystko oprócz nawiasu
        until (element=nil)or(t='(');
       end;
      end;
if sprawdzenie(c)=2 then edit2.text:=edit2.text+c;  //2- Liczby wypisz na wujscie
if sprawdzenie(c)=3 then begin
        nastos(c,wierzcholek); //3- Nawias otwarty wrzuc na stos
        Inc(Liczba_Nawiasow);
        c2:=s[i+1];
        if c2='-' then          //Jesli następną liczbą jest l.ujemna
                begin
                edit2.text:=edit2.text+c2;   //przepisz na wyjscie minus
                inc(i);
                end;
        end;
if sprawdzenie(c)=1 then        //4- Dzialanie
        begin
        if(sprawdzenie(s[i-1])=2) then
        edit2.text:=edit2.text+' '; //Odstęp między argumentami
        if not(wierzcholek=nil) then begin
        element:=wierzcholek;
        repeat
        t:=element^.dane;
        element:=element^.wskaznik;
        if priorytet(c)<=priorytet(t) then //Zdejmij ze stosu dzialania (t) o
                begin                       //priorytecie większym lub równym (c)
                zestosu(t,wierzcholek);    //i wypisz na wyjscie
                edit2.text:=edit2.text+t;
                end;
        until (element=nil)or(priorytet(t)<priorytet(c));
        end;
        NaStos(c,wierzcholek);          //Nastepnie dodaj do stosu
        end;
until i=strlen(Pchar(s));
if not(wierzcholek=nil)then //Wypisz wszystko, co zostalo na stosie
        repeat
        zestosu(t,wierzcholek);
        edit2.text:=edit2.text+t;
        until wierzcholek=nil;
if Liczba_Nawiasow<>0 then
begin
if Liczba_Nawiasow>0 then
MessageDlg('Wyrażenie zawiera zbyt nieprawidlową liczbę nawiasów'+
' zamykających. Jest ich o: '+inttostr(abs(liczba_nawiasow))+' za malo. Wprowadź korektę i wcisnij [Konwertuj]', mtError,
      [mbCancel	], 0);
if Liczba_Nawiasow<0 then
MessageDlg('Wyrażenie zawiera zbyt nieprawidlową liczbę nawiasów'+
' zamykających. Jest ich o: '+inttostr(abs(liczba_nawiasow))+' za duzo. Wprowadź korektę i wcisnij [Konwertuj]', mtError,
      [mbCancel	], 0);
Edit2.clear;
Liczba_Nawiasow:=0;
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
application.Terminate;
end;

procedure TForm1.Wczytajnotacjinfiksow1Click(Sender: TObject);
var f:textfile;
s:string;
begin
edit2.Clear;
if opendialog1.Execute then
 begin
 assignfile(f,opendialog1.filename);
 reset(f);
 readln(f,s);
 edit1.text:=s;
 closefile(f);
 end;
button1.enabled:=true;
end;

procedure TForm1.ZapiszONP1Click(Sender: TObject);
var f:textfile;
begin
if savedialog1.Execute then
 begin
 assignfile(f,savedialog1.filename);
 rewrite(f);
 writeln(f,edit2.text);
 closefile(f);
 end;

end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
if button1.enabled=false then button1.enabled:=true;
end;

procedure TForm1.Edit2Change(Sender: TObject);
begin
if zapiszonp1.Enabled=false then zapiszonp1.Enabled:=true;
end;

procedure TForm1.Zakoncz1Click(Sender: TObject);
begin
application.terminate;
end;

end.