Jump to content

Archived

This topic is now archived and is closed to further replies.

mtbmlody

Pomoc! Pascal! musze napisac program

Recommended Posts

Witam mam za zadanie napisanie kalkulatora string który np po wpisaniu wyrazenie 12*4/3-2+7*2 poda mi odrazu wynik. Szukalem w necie nic nie znalalzem mam napisane tyle i wisze niewiem co dalej zrobic prosze o pomoc.

 

program Project1;

 

{$APPTYPE CONSOLE}

 

{warunki zmiennych}

var

wyrazenie,wyrazenie1:string;

pamiec0,pamiec1,pamiec2:string;

pamiec1u,pamiec2u,e,i,j,k,b:integer;

 

begin

 

{zerowanie pamieci zmiennych}

pamiec0:='';

pamiec1:='';

pamiec2:='';

 

{podanie wyrazenia matematycznego do obliczenia}

writeln('podaj wyrazenie ');

readln(wyrazenie);

 

{wyszukiwanie pierwszego znaku (znaku mnożenia) }

for i:=1 to length(wyrazenie) do

begin

pamiec0:=pamiec0+wyrazenie;

if wyrazenie='*' then

{natrafienie na znak}

begin

for k:=i+1 to length(wyrazenie) do

{wprowadzenie do pamieci2 liczby po znaku}

begin

if wyrazenie[j]=('+') then break;

if wyrazenie[j]=('-') then break;

if wyrazenie[j]=('*') then break;

if wyrazenie[j]=('/') then break;

pamiec2:=pamiec2+wyrazenie[k];

end;

for j:=i-1 downto 1 do

begin

{wprowadzenie do pamieci1 wyrazenie przed znakiem}

if wyrazenie[j]=('+') then break;

if wyrazenie[j]=('-') then break;

if wyrazenie[j]=('*') then break;

if wyrazenie[j]=('/') then break;

pamiec1:=wyrazenie[j]+pamiec1;

end;

for e:=1 to j do wyrazenie1:=wyrazenie;

 

end;

 

end;

writeln(pamiec0);

writeln(pamiec1);

writeln(pamiec2);

val(pamiec1,pamiec1u,B);

val(pamiec2,pamiec2u,B);

writeln(pamiec1u*pamiec2u);

readln;

 

 

end.

Share this post


Link to post
Share on other sites

Aha moj kalkulator ma sie ograniczac tylko do +, -, /, * nic wiecej.

Co to ma do rzeczy? :blink: Tak czy siak musisz podzielić długie wyrażenie na kilka członów i w ten sposób liczyć. Musisz uwzględnić priorytety operatorów - pamiętaj, że przed dodawaniem jest mnożenie. :)

Share this post


Link to post
Share on other sites

A mają być nawiasy? Bo jak nie to metoda łopatologiczną dałoby się, no ale tak to interpreter wyrażeń powinien być, będzie na przyszłość, na 4programmers.net jest chyba takowy kod

Share this post


Link to post
Share on other sites

Odwrotna notacja Polska może Ci pomoże chociaż nie bawiłem się w nią. Ale i tak musisz ciąg oddzielać jakoś wyłapując odpowiednie człony.

Share this post


Link to post
Share on other sites

Na gamedev widziałem ciekawy artykulik o odwrotnej notacjii polskiej. Z tego co pamietam to nawet kodzik był.

Share this post


Link to post
Share on other sites

jesli chodzi o nawiasy to nie ma ich byc to ma byc prosty pogramik z ktoreym nie umie dac sobie rady. ma on tylko * / + - tak zeby pokazywal sie sam wynik z danego wyrazenia

Share this post


Link to post
Share on other sites

Witam :)

 

Mam dla Ciebie program, który napisałem jakieś dwa latka temu. Jest to prosty kalkulator, właśnie taki, jakiego potrzebujesz :) Niestety, w pierwotnej wersji program napisany został dla aplikacji windows i po przeniesieniu kodu na konsole, okazało się, iż zawiera błąd. Ponieważ cierpię na brak wolnego czasu, nie debugowałem, dopisałem małą łatkę usuwającą ten bug. Pozdrawiam :)

 

ps. posiadam też wersje kalkulatora w C++

 

KOD

program Calc;

 

{$APPTYPE CONSOLE}

 

uses

SysUtils;

 

var

Wyr: String;

x : Integer;

tmp: String;

 

{

* - mnozenie

/ - dzielenie

+ - dodawanie

- - odejmowanie

}

 

function Calc(w: String): String;

var

x : Integer;

l : Integer;

p1: Integer;

p2: Integer;

p3: Integer;

p4: Integer;

t1: Integer;

t2: Integer;

t : Integer;

begin

x :=0;

l :=0;

p1:=0;

p2:=0;

p3:=0;

p4:=0;

t1:=0;

t2:=0;

t :=0;

 

// Mnozenie

 

for x:=Length(w) downto 1 do

begin

if w[x]='*' then

begin

p2:=x-1;

for l:=p2 downto 1 do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=1) then

begin

if l=1 then p1:=l else p1:=l+1;

break;

end;

end;

t1:=StrToInt(Copy(w,p1,p2-p1+1));

 

p3:=x+1;

for l:=p3+1 to Length(w) do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=Length(w)) then

begin

if l=Length(w) then p4:=l else p4:=l-1;

break;

end;

end;

t2:=StrToInt(Copy(w,p3,p4-p3+1));

 

t:=t1*t2;

Delete(w,p1,p4-p1+1);

Insert(IntToStr(t),w,p1);

end;

end;

 

// Dzielenie

 

for x:=Length(w) downto 1 do

begin

if w[x]='/' then

begin

p2:=x-1;

for l:=p2 downto 1 do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=1) then

begin

if l=1 then p1:=l else p1:=l+1;

break;

end;

end;

t1:=StrToInt(Copy(w,p1,p2-p1+1));

 

p3:=x+1;

for l:=p3+1 to Length(w) do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=Length(w)) then

begin

if l=Length(w) then p4:=l else p4:=l-1;

break;

end;

end;

t2:=StrToInt(Copy(w,p3,p4-p3+1));

 

t:=t1 div t2;

Delete(w,p1,p4-p1+1);

Insert(IntToStr(t),w,p1);

end;

end;

 

// Dodawanie

 

for x:=Length(w) downto 1 do

begin

if w[x]='+' then

begin

p2:=x-1;

for l:=p2 downto 1 do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=1) then

begin

if l=1 then p1:=l else p1:=l+1;

break;

end;

end;

t1:=StrToInt(Copy(w,p1,p2-p1+1));

 

p3:=x+1;

for l:=p3+1 to Length(w) do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=Length(w)) then

begin

if l=Length(w) then p4:=l else p4:=l-1;

break;

end;

end;

t2:=StrToInt(Copy(w,p3,p4-p3+1));

 

t:=t1+t2;

Delete(w,p1,p4-p1+1);

Insert(IntToStr(t),w,p1);

end;

end;

 

// Odejmowanie

 

for x:=Length(w) downto 1 do

begin

if (w[x]='-') and (x>1) then

begin

if w[x-1]='-' then begin p2:=x-2; p3:=x; end else

begin p2:=x-1; p3:=x+1; end;

for l:=p2 downto 1 do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=1) then

begin

if l=1 then p1:=l else p1:=l+1;

break;

end;

end;

t1:=StrToInt(Copy(w,p1,p2-p1+1));

 

for l:=p3+1 to Length(w) do

begin

if (w[l]='*') or (w[l]='/') or (w[l]='+') or

(w[l]='-') or (l=Length(w)) then

begin

if l=Length(w) then p4:=l else p4:=l-1;

break;

end;

end;

t2:=StrToInt(Copy(w,p3,p4-p3+1));

 

t:=t1-t2;

Delete(w,p1,p4-p1+1);

Insert(IntToStr(t),w,p1);

end;

end;

 

result:=w;

end;

 

begin

write('Podaj wyrazenie: ');

readln(wyr);

 

// petla usuwa spacje z wyrazenia

 

for x:=Length(Wyr) downto 1 do

begin

if (Wyr[x]=chr(32)) then Delete(Wyr,x,1);

end;

 

// latka naprawiajaca blad

 

if (Wyr[Length(Wyr)-1]='*') or (Wyr[Length(Wyr)-1]='/') or

(Wyr[Length(Wyr)-1]='+') or (Wyr[Length(Wyr)-1]='-') then

begin

tmp:=Wyr[Length(Wyr)];

Wyr[Length(Wyr)]:='0';

Insert(tmp,Wyr,Length(Wyr)+1);

end;

 

Wyr:=Calc(Wyr);

writeln('Wynik: '+Wyr);

readln(wyr);

end.

 

Share this post


Link to post
Share on other sites

Dziękuje Brainer :)

Spoko, nie ma sprawy! :)

 

@Topic Tu masz ten kodzik, o którym pisałem wcześniej. Sorka za fatalne formatowanie - Ci z Eksperta wcale nie stosują się do reguł Borlanda. :P

CODEunit BinMath;

 

interface

uses Classes;

 

type TFunkcjaObliczen0arg = function : Double;

type TFunkcjaObliczen1arg = function(A : Double) : Double;

type TFunkcjaObliczen2arg = function(A,B : Double) : Double;

type TFunkcjaObliczen3arg = function(A,B,C : Double) : Double;

type TFunkcjaObliczen4arg = function(A,B,C,D : Double) : Double;

 

 

type TStosDane = class

private

Nazwa : String;

Priorytet : Integer;

public

constructor Create(S : String; I : Integer);

end;

 

type TStos = class

private

FLista : TList;

public

constructor Create;

destructor Destroy; override;

 

procedure Dodaj(S : String; Priorytet : Integer = 0);

function Zdejmij : String;

 

function Istnieje : Boolean;

 

function AktualnyPriorytet : Integer;

procedure Wyczysc;

end;

 

type TZmienneDane = class

private

Nazwa : String;

Wartosc : Double;

public

constructor Create(N : String;W : Double);

end;

 

type TFunkcjeDane = class

private

Nazwa : String;

Priorytet : Integer;

Adres : Pointer;

Argumentow : Integer;

public

constructor Create(N : String; P : Integer; D : Pointer; A : Integer);

end;

 

type TObliczenia = class

private

FListaFunkcji : TList; //lista funkcji

FZmienne : TList; //lista zmiennych

FStosONP : TStos; //stos do konwersji na ONP

FStosWynik : TStos; //stos do obliczenia wyniku

FWyrazenie : String; //wprowadzone wyrażenie

FONP : String; //wyrażenie zamienione na ONP

 

FKodError : Integer; //kod błędu

 

procedure GenerujONP; //generowanie ONP

 

public

procedure Wyrazenie(S : String); //wprowadzenie wyrażenia

function Wynik : Double; //odczytanie wyniku

 

function ONP : String; //odczytanie wyrażenia ONP

function Blad : Integer; //odczytanie kodu błędu

function BladOpis :String; //opis występującego błędu

 

//zarządzanie obsługiwanymi funkcjami

procedure FunkcjeRejestruj(Nazwa : String; Priorytet : Integer; Arg : Integer; Adres : Pointer);

function FunkcjeID(Nazwa : String) : Integer;

function FunkcjeInfo(Id : Integer) : TFunkcjeDane;

procedure FunkcjeWyczysc;

 

//obsługa zmiennych

procedure ZmienneDodaj(N : String; W : Double);

procedure ZmienneWyczysc;

 

//konstruktor i destruktor

constructor Create;

destructor Destroy; override;

end;

 

 

implementation

uses SysUtils,Math;

 

const

MY_PI=3.14159265358979323846;

MY_E=2.7182818285;

 

//sprawdzenie, czy podany ciąg jest liczbą

function CzyLiczba(S : String) : Boolean;

var Blad: Integer;

Wart: Double;

begin

Val(S, Wart, Blad);

Result := (Blad = 0);

end;

 

//zamiana napisu na liczbę typu DOUBLE, z podmianą kropki na przecinek

function STF(A : String) : Double;

var i : Integer;

begin

for i:=1 to Length(A) do if A='.' then A:=',';

Result:=StrToFloat(A);

end;

 

//zamiana liczby DOUBLE na napis, z podmianą przecinka na kropkę

function FTS(A : Double) : String;

var i : Integer;

begin

Result:=FloatToStr(A);

for i:=1 to length(Result) do if Result=',' then Result:='.';

end;

 

function BIN_DODAWANIE(A,B : Double) : Double;

begin

Result:=A+B;

end;

 

function BIN_ODEJMOWANIE(A,B : Double) : Double;

begin

Result:=A-B;

end;

 

function BIN_MNOZENIE(A,B : Double) : Double;

begin

Result:=A*B;

end;

 

function BIN_DZIELENIE(A,B : Double) : Double;

begin

Result:=A/B;

end;

 

function BIN_SILNIA(A : Double) : Double;

var X,W,I : Integer;

begin

X:=Round(A);

W:=1;

for i:=1 to X do W:=W*i;

Result:=W;

end;

 

function BIN_SIN(A : Double) : Double;

begin

Result:=Sin(A);

end;

 

function BIN_COS(A : Double) : Double;

begin

Result:=Cos(A);

end;

 

function BIN_COSH(A : Double) : Double;

begin

Result:=CosH(A);

end;

 

function BIN_SINH(A : Double) : Double;

begin

Result:=SinH(A);

end;

 

function BIN_TGH(A : Double) : Double;

begin

Result:=TanH(A);

end;

 

function BIN_CTGH(A : Double) : Double;

begin

Result:=CotH(A);

end;

 

function BIN_ACOS(A : Double) : Double;

begin

Result:=ArcCos(A);

end;

 

function BIN_ASIN(A : Double) : Double;

begin

Result:=ArcSin(A);

end;

 

function BIN_ATG(A : Double) : Double;

begin

Result:=ArcTan(A);

end;

 

function BIN_ACTG(A : Double) : Double;

begin

Result:=(MY_PI/2)-ArcTan(A);

end;

 

function BIN_TG(A : Double) : Double;

begin

Result:=Tan(A);

end;

 

function BIN_CTG(A : Double) : Double;

begin

Result:=CoTan(A) ;

end;

 

function BIN_KOMBINACJE(K,N : Double) : Double;

begin

Result:=BIN_SILNIA(N) / ( BIN_SILNIA(N-K)*BIN_SILNIA(K) );

end;

 

function BIN_ZMIENZNAK(A : Double) : Double;

begin

Result:=-A;

end;

 

function BIN_STALAPI : Double;

begin

Result:=MY_PI;

end;

 

function BIN_STALAE : Double;

begin

Result:=MY_E;

end;

 

function BIN_SECANT(A : Double) : Double;

begin

Result:=Secant(A);

end;

 

function BIN_COSECANT(A : Double) : Double;

begin

Result:=CoSecant(A);

end;

 

function BIN_RADTODEG(A : Double) : Double;

begin

Result:=RadToDeg(A);

end;

 

function BIN_DEGTORAD(A : Double) : Double;

begin

Result:=DegToRad(A);

end;

 

function BIN_GRADTODEG(A : Double) : Double;

begin

Result:=GradToDeg(A);

end;

 

function BIN_DEGTOGRAD(A : Double) : Double;

begin

Result:=DegToGrad(A);

end;

 

function BIN_RADTOGRAD(A : Double) : Double;

begin

Result:=RadToGrad(A);

end;

 

function BIN_GRADTORAD(A : Double) : Double;

begin

Result:=GradToRad(A);

end;

 

function BIN_LOG2(A : Double) : Double;

begin

Result:=Log2(A);

end;

 

function BIN_LOG10(A : Double) : Double;

begin

Result:=Log10(A);

end;

 

function BIN_LOG(A,B : Double) : Double;

begin

Result:=LogN(A,B);

end;

 

function BIN_LOGE(A : Double) : Double;

begin

Result:=BIN_LOG10(A)/BIN_LOG10(MY_E);

end;

 

function BIN_POW(A,B : Double) : Double;

begin

Result:=Power(A,B);

end;

 

function BIN_ABS(A : Double) : Double;

begin

Result:=Abs(A);

end;

 

function BIN_SQRT(A : Double) : Double;

begin

Result:=Sqrt(A);

end;

 

function BIN_SQR(A : Double) : Double;

begin

Result:=Sqr(A);

end;

 

//============================== STOS ==========================================

 

constructor TStosDane.Create(S : String; I : Integer);

begin

inherited Create;

Nazwa:=S;

Priorytet:=I;

end;

 

constructor TStos.Create;

begin

inherited;

FLista:=TList.Create;

end;

 

destructor TStos.Destroy;

begin

Wyczysc;

FLista.Free;

inherited;

end;

 

procedure TStos.Dodaj(S : String; Priorytet : Integer = 0);

begin

FLista.Add(TStosDane.Create(S,Priorytet));

end;

 

function TStos.Zdejmij : String;

begin

if FLista.Count>0 then

begin

Result:=TStosDane(FLista.Last).Nazwa;

TStosDane(FLista.Last).Free;

FLista.Delete(FLista.Count-1);

end else Result:='';

end;

 

function TStos.Istnieje : Boolean;

begin

Result:=FLista.Count>0;

end;

 

function TStos.AktualnyPriorytet : Integer;

begin

if FLista.Count>0 then Result:=TStosDane(FLista.Last).Priorytet

else Result:=0;

end;

procedure TStos.Wyczysc;

var i : Integer;

begin

for i:=0 to FLista.Count-1 do TStosDane(FLista.Items).Free;

FLista.Clear;

end;

 

//================ F U N K C J E i Z M I E N N E ============================

 

constructor TZmienneDane.Create(N : String;W : Double);

begin

Nazwa:=N;

Wartosc:=W;

end;

 

constructor TFunkcjeDane.Create(N : String;P : Integer;D : Pointer;A : Integer);

begin

Nazwa:=N;

Priorytet:=P;

Adres:=D;

Argumentow:=A;

end;

 

//====================== O B L I C Z E N I A ===================================

 

constructor TObliczenia.Create;

begin

inherited;

 

//tworzymy niezbędne obiekty

FZmienne:=TList.Create;

FListaFunkcji:=TList.Create;

FStosONP:=TStos.Create;

FStosWynik:=TStos.Create;

 

//zerujemy znacznik błędu

FKodError:=0;

 

//dodajemy obsługę wbudowanych funkcji

//jako parametry funkcji RejestrujFunkcje podajemy NAZWĘ funkcji, jej

//PRIORYTET, liczbę ARGUMENTÓW i ADRES

 

//adres funkcji uzyskamy poprzedzając jej nazwę symbolem @

 

//im wyższy priorytet, tym szybciej dana operacja jest dokonywana

//w naszym przypadku:

// ZMIANA ZNAKU - priorytet 20

// RÓZNE FUNKCJE (sin, cos...) - priorytet 15

// MNOZENIE I DZIELENIE - priorytet 10

// DODAWANIE I ODEJMOWANIE - priorytet 5

 

FunkcjeRejestruj('pi',30,0,@BIN_STALAPI);

FunkcjeRejestruj('e',30,0,@BIN_STALAE);

FunkcjeRejestruj('zmienznak',20,1,@BIN_ZMIENZNAK);

FunkcjeRejestruj('+',5,2,@BIN_DODAWANIE);

FunkcjeRejestruj('-',5,2,@BIN_ODEJMOWANIE);

FunkcjeRejestruj('*',10,2,@BIN_MNOZENIE);

FunkcjeRejestruj('/',10,2,@BIN_DZIELENIE);

FunkcjeRejestruj('abs',15,1,@BIN_ABS);

FunkcjeRejestruj('!',15,1,@BIN_SILNIA);

FunkcjeRejestruj('sin',15,1,@BIN_SIN);

FunkcjeRejestruj('cos',15,1,@BIN_COS);

FunkcjeRejestruj('tan',15,1,@BIN_TG);

FunkcjeRejestruj('tg',15,1,@BIN_TG);

FunkcjeRejestruj('cotan',15,1,@BIN_CTG);

FunkcjeRejestruj('cot',15,1,@BIN_CTG);

FunkcjeRejestruj('ctg',15,1,@BIN_CTG);

FunkcjeRejestruj('sinh',15,1,@BIN_SINH);

FunkcjeRejestruj('cosh',15,1,@BIN_COSH);

FunkcjeRejestruj('tanh',15,1,@BIN_TGH);

FunkcjeRejestruj('tgh',15,1,@BIN_TGH);

FunkcjeRejestruj('cotanh',15,1,@BIN_CTGH);

FunkcjeRejestruj('coth',15,1,@BIN_CTGH);

FunkcjeRejestruj('ctgh',15,1,@BIN_CTGH);

FunkcjeRejestruj('secant',15,1,@BIN_SECANT);

FunkcjeRejestruj('sec',15,1,@BIN_SECANT);

FunkcjeRejestruj('cosecant',15,1,@BIN_COSECANT);

FunkcjeRejestruj('csc',15,1,@BIN_COSECANT);

FunkcjeRejestruj('arcsin',15,1,@BIN_ASIN);

FunkcjeRejestruj('arccos',15,1,@BIN_ACOS);

FunkcjeRejestruj('arctan',15,1,@BIN_ATG);

FunkcjeRejestruj('arctg',15,1,@BIN_ATG);

FunkcjeRejestruj('arccotan',15,1,@BIN_ACTG);

FunkcjeRejestruj('arcctg',15,1,@BIN_ACTG);

FunkcjeRejestruj('radtodeg',15,1,@BIN_RADTODEG);

FunkcjeRejestruj('degtorad',15,1,@BIN_DEGTORAD);

FunkcjeRejestruj('gradtodeg',15,1,@BIN_GRADTODEG);

FunkcjeRejestruj('degtograd',15,1,@BIN_DEGTOGRAD);

FunkcjeRejestruj('radtograd',15,1,@BIN_RADTOGRAD);

FunkcjeRejestruj('gradtorad',15,1,@BIN_GRADTORAD);

FunkcjeRejestruj('loge',15,1,@BIN_LOGE);

FunkcjeRejestruj('ln',15,1,@BIN_LOGE);

FunkcjeRejestruj('log2',15,1,@BIN_LOG2);

FunkcjeRejestruj('log10',15,1,@BIN_LOG10);

FunkcjeRejestruj('log',15,2,@BIN_LOG);

FunkcjeRejestruj('power',15,2,@BIN_POW);

FunkcjeRejestruj('^',15,2,@BIN_POW);

FunkcjeRejestruj('combination',15,2,@BIN_KOMBINACJE);

FunkcjeRejestruj('sqr',15,1,@BIN_SQR);

FunkcjeRejestruj('sqrt',15,1,@BIN_SQRT);

end;

 

destructor TObliczenia.Destroy;

begin

//zwalniamy pamięć

FunkcjeWyczysc;

ZmienneWyczysc;

 

FZmienne.Free;

FListaFunkcji.Free;

 

FStosONP.Free;

FStosWynik.Free;

inherited;

end;

procedure TObliczenia.ZmienneDodaj(N : String; W : Double);

var i : Integer;

begin

 

//jak nie podano nazwy - błąd

if (N='') then

begin

FKodError:=6;

Exit;

end;

 

//zamieniamy wielkość liter w nazwie na małe

N:=lowercase(N);

 

//sprawdzamy, czy w nazwie zmiennej są tylko dozwolone znaki (a..z i _)

for i:=1 to length(N) do

if not (N in ['a'..'z','_']) then

begin

FKodError:=6;

Exit;

end;

 

//nazwa jest poprawna, więc...

 

//szukamy zmiennej w bazie. Może już jest, wtedy tylko ją uaktualnimy.

for i:=0 to FZmienne.Count-1 do

if TZmienneDane(FZmienne.Items).Nazwa=N then

begin

TZmienneDane(FZmienne.Items).Wartosc:=W;

exit;

end;

 

//to nowa zmienna, dodajemy

FZmienne.Add(TZmienneDane.Create(N,W))

end;

 

procedure TObliczenia.ZmienneWyczysc;

var i : Integer;

begin

for i:=0 to FZmienne.Count-1 do TZmienneDane(FZmienne.Items).Free;

FZmienne.Clear;

end;

 

procedure TObliczenia.FunkcjeRejestruj(Nazwa : String; Priorytet : Integer; Arg : Integer; Adres : Pointer);

begin

FListaFunkcji.Add(TFunkcjeDane.Create(Nazwa,Priorytet,Adres,Arg));

end;

 

procedure TObliczenia.FunkcjeWyczysc;

var i : Integer;

begin

for i:=0 to FListaFunkcji.Count-1 do

TFunkcjeDane(FListaFunkcji.Items).Free;

FListaFunkcji.Clear;

end;

 

function TObliczenia.FunkcjeID(Nazwa : String) : Integer;

var i : Integer;

begin

Result:=-1;

Nazwa:=lowercase(Nazwa);

for i:=0 to FListaFunkcji.Count-1 do

if TFunkcjeDane(FListaFunkcji.Items).Nazwa=Nazwa then

begin

Result:=i;

Break;

end;

end;

 

function TObliczenia.FunkcjeInfo(Id : Integer) : TFunkcjeDane;

begin

if (Id>=0) and (Id

Result:=TFunkcjeDane(FListaFunkcji.Items[id]) else Result:=nil;

end;

 

//zwrócenie kodu błędu

function TObliczenia.Blad :Integer;

begin

Result:=FKodError;

end;

 

//zwrócenie opisu błędu

function TObliczenia.BladOpis :String;

begin

case FKodError of

0 : Result:='';

5 : Result:='Nieprawidłowy zakres zmiennej.';

6 : Result:='Nieprawidłowa nazwa zmiennej.';

8 : Result:='Nie znaleziono takiej zmiennej.';

else Result:='Nieznany błąd.';

end;

end;

 

//zwraca kod ONP dla wyrażenia

function TObliczenia.ONP : String;

begin

Result:=FONP;

end;

 

procedure TObliczenia.Wyrazenie(S : String);

begin

FWyrazenie:=lowercase(trim(S));

FKodError:=0;

GenerujONP;

end;

 

procedure TObliczenia.GenerujONP;

var Start,i : Integer;

Token : String;

Poprzedni : String;

Priorytet,ID : Integer;

begin

Poprzedni:=''; //poprzedni Token

FONP:=''; //początkowa treść kodu ONP

 

FStosONP.Wyczysc; //czyścimy stos ONP

 

 

Start:=1;

while start

begin

 

//pobierzmy pojedynczy token (ciąg znaków, liczbę, operator itp)

for i:=Start to Length(FWyrazenie) do if not (FWyrazenie in ['a'..'z','0'..'9','.','_']) then Break;

if i=Start then Inc(i);

Token:=Copy(FWyrazenie,Start,i-Start);

Start:=i;

 

//użytkownik może używać dowolnych nawiasów, dla nas one wszystkie to jedno: ( i )

if (Token='[') or (Token={') then Token:='(';

if (Token=]') or (Token='}') then Token:=')';

 

//mamy token - operacje na tokenie...

 

 

//jeśli symbolem jest "-" - może to oznaczać bądź to ODJĄĆ, bądź też

//ZMIENZNAK. Kiedy więc poprzedni Token był pusty (początek wyrażenia)

//lub poprzedni Token to "(" - czyli początek wyrażenia w nawiasie,

//jest to ZMIENZNAK!

if (Token='-') and

( (Poprzedni='') or (Poprzedni='(') ) then Token:='zmienznak';

 

 

//jeśli nasz Token to LICZBA, doklejamy ją do wyniku ONP

If CzyLiczba(Token) then FONP:=FONP+Token+' '

else if Token='(' then

begin

//otwieramy nawias

FStosONP.Dodaj('(',0); //dodajemy na stos z priorytetem 0 (zarezerwowany)

 

end else if Token=')' then

begin

//koniec nawiasu

 

//zdejmujemy najpierw ze stosu wszystko do czasu napotkania elementu

//o priorytecie 0, czyli początku nawiasu

while (FStosONP.Istnieje) and (FStosONP.AktualnyPriorytet0) do

FONP:=FONP+FStosONP.Zdejmij+' ';

 

//sam nawias także zdejmijmy

FStosONP.Zdejmij;

 

end else if FunkcjeID(Token)=-1 then

begin

//to nie żadna funkcja (pewnie zmienna), doklejmy do ONP

//nie doklejamy jednak znaku przecinka, który oddziela argumenty

if Token',' then FONP:=FONP+Token+' '

end else

begin

//to funkcja - pobierzmy jej numer

Id:=FunkcjeID(Token);

 

//najpierw zdejmujemy ze stosu wszystko o WYŻSZYCH PRIORYTETACH

Priorytet:=FunkcjeInfo(Id).Priorytet;

while (FStosONP.Istnieje) and (FStosONP.AktualnyPriorytet>=Priorytet) do

FONP:=FONP+FStosONP.Zdejmij+' ';

 

//i teraz na stos naszą funkcję

FStosONP.Dodaj(Token,Priorytet);

end;

 

//zapamiętujemy token jako "Poprzedni"

Poprzedni:=Token;

end;

 

//wszystko co zostało na stosie zdejmujemy

while (FStosONP.Istnieje) do

FONP:=FONP+FStosONP.Zdejmij+' ';

 

end;

 

function TObliczenia.Wynik : Double;

var Start, i,k,id : Integer;

Token : String;

A,B,C,D : String;

Adres : Pointer;

W : Double;

begin

//jak nie mamy ONP - koniec

if FONP='' then

begin

Result:=0;

exit;

end;

 

//czyścimy stos wyniku i dodajemy jako wynik 0

//priorytet nie jest istotny - więc go nie podajemy

FStosWynik.Wyczysc;

FStosWynik.Dodaj('0');

 

//zerujemy kod błędu

FKodError:=0;

 

Start:=1;

while start

begin

 

//pobierzmy pojedynczy token (ciąg znaków, liczbę, operator itp)

for i:=Start to Length(FONP) do if (FONP in [' ']) then Break;

if i=Start then Inc(i);

Token:=Copy(FONP,Start,i-Start);

Start:=i;

 

//wytnijmy białe znaki z końców tego tokena

Token:=trim(Token);

if Token='' then Continue;

 

//jeśli to liczba - to na stos

If CzyLiczba(Token) then FStosWynik.Dodaj(Token)

else if FunkcjeID(Token)=-1 then

begin

//jeśli to nie funkcja, to pewnie zmienna...

k:=0;

for i:=0 to FZmienne.Count-1 do

if TZmienneDane(FZmienne.Items).Nazwa=Token then

begin

k:=1;

break;

end;

if k=1 then FStosWynik.Dodaj(FTS(TZmienneDane(FZmienne.Items).Wartosc)) else FKodError:=8;

end else

begin

//to funkcja, więc pobierzmy jej numer i adres

Id:=FunkcjeID(Token);

Adres:=FunkcjeInfo(Id).Adres;

 

//a teraz w zależności od ilości argumentów...

case FunkcjeInfo(ID).Argumentow of

0: begin

try

W:=TFunkcjaObliczen0arg(Adres);

FStosWynik.Dodaj(FTS(W),0);

except

FKodError:=5;

end;

end;

1: begin

try

A:=FStosWynik.Zdejmij;

W:=TFunkcjaObliczen1arg(Adres)(STF(A));

FStosWynik.Dodaj(FTS(W),0);

except

FKodError:=5;

end;

end;

2: begin

try

B:=FStosWynik.Zdejmij;

if FStosWynik.Istnieje then A:=FStosWynik.Zdejmij else A:='0';

W:=TFunkcjaObliczen2arg(Adres)(STF(A),STF(B));

FStosWynik.Dodaj(FTS(W),0);

except

FKodError:=5;

end;

end;

3: begin

try

C:=FStosWynik.Zdejmij;

if FStosWynik.Istnieje then B:=FStosWynik.Zdejmij else B:='0';

if FStosWynik.Istnieje then A:=FStosWynik.Zdejmij else A:='0';

W:=TFunkcjaObliczen3arg(Adres)(STF(A),STF(B),STF?);

FStosWynik.Dodaj(FTS(W),0);

except

FKodError:=5;

end;

end;

4: begin

try

D:=FStosWynik.Zdejmij;

if FStosWynik.Istnieje then C:=FStosWynik.Zdejmij else C:='0';

if FStosWynik.Istnieje then B:=FStosWynik.Zdejmij else B:='0';

if FStosWynik.Istnieje then A:=FStosWynik.Zdejmij else A:='0';

 

W:=TFunkcjaObliczen4arg(Adres)(STF(A),STF(B),STF?,STF(D));

FStosWynik.Dodaj(FTS(W),0);

except

FKodError:=5;

end;

 

end;

end;

 

end;

 

end;

 

if FKodError=0 then Result:=STF(FStosWynik.Zdejmij)

else Result:=0;

 

end;

end.

 

Mam nadzieję, że pomoże! :)

Share this post


Link to post
Share on other sites

×
×
  • Create New...