mtbmlody Napisano Listopad 24, 2007 Zgłoś Share Napisano Listopad 24, 2007 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. Link do komentarza Udostępnij na innych stronach More sharing options...
Brainer Napisano Listopad 24, 2007 Zgłoś Share Napisano Listopad 24, 2007 Poszukaj na necie analizatora wyrażeń. .: Brainer :. patrick.nusbaum@gmail.com Link do komentarza Udostępnij na innych stronach More sharing options...
mtbmlody Napisano Listopad 24, 2007 Autor Zgłoś Share Napisano Listopad 24, 2007 Aha moj kalkulator ma sie ograniczac tylko do +, -, /, * nic wiecej. Link do komentarza Udostępnij na innych stronach More sharing options...
Brainer Napisano Listopad 24, 2007 Zgłoś Share Napisano Listopad 24, 2007 Aha moj kalkulator ma sie ograniczac tylko do +, -, /, * nic wiecej. Co to ma do rzeczy? 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. .: Brainer :. patrick.nusbaum@gmail.com Link do komentarza Udostępnij na innych stronach More sharing options...
Force Napisano Listopad 24, 2007 Zgłoś Share Napisano Listopad 24, 2007 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 Baza tysięcy lotnisk: http://airportsbase.com Link do komentarza Udostępnij na innych stronach More sharing options...
5corpio Napisano Listopad 24, 2007 Zgłoś Share Napisano Listopad 24, 2007 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. Ot taka mini-strona moja po godzinach http://www.wnetrzekuchni.pl Link do komentarza Udostępnij na innych stronach More sharing options...
KaYou Napisano Listopad 24, 2007 Zgłoś Share Napisano Listopad 24, 2007 Na gamedev widziałem ciekawy artykulik o odwrotnej notacjii polskiej. Z tego co pamietam to nawet kodzik był. "(2b || !(2b)) == question" W. Shakespeare http://jakubniwa.pl - świat sztucznej inteligencji Link do komentarza Udostępnij na innych stronach More sharing options...
Brainer Napisano Listopad 24, 2007 Zgłoś Share Napisano Listopad 24, 2007 Jeśli chodzi o ONP, kodzik był w Ekspecie Plus. Mogę podrzucić jak coś. .: Brainer :. patrick.nusbaum@gmail.com Link do komentarza Udostępnij na innych stronach More sharing options...
mtbmlody Napisano Listopad 25, 2007 Autor Zgłoś Share Napisano Listopad 25, 2007 jesli mogl bys wrzucic bylbymwdzieczny:) pabe@onet.eu Link do komentarza Udostępnij na innych stronach More sharing options...
mtbmlody Napisano Listopad 25, 2007 Autor Zgłoś Share Napisano Listopad 25, 2007 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 Link do komentarza Udostępnij na innych stronach More sharing options...
sazian Napisano Listopad 25, 2007 Zgłoś Share Napisano Listopad 25, 2007 piękny temat Pomoc! Pascal! musze napisac program to pisz Link do komentarza Udostępnij na innych stronach More sharing options...
xevil21 Napisano Listopad 25, 2007 Zgłoś Share Napisano Listopad 25, 2007 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. Link do komentarza Udostępnij na innych stronach More sharing options...
Brainer Napisano Listopad 25, 2007 Zgłoś Share Napisano Listopad 25, 2007 Po pierwsze, formatowanie kodu... Po drugie, używaj tagów .: Brainer :. patrick.nusbaum@gmail.com Link do komentarza Udostępnij na innych stronach More sharing options...
xevil21 Napisano Listopad 25, 2007 Zgłoś Share Napisano Listopad 25, 2007 Po pierwsze, formatowanie kodu... Po drugie, używaj tagów Dziękuje Brainer Link do komentarza Udostępnij na innych stronach More sharing options...
Brainer Napisano Listopad 26, 2007 Zgłoś Share Napisano Listopad 26, 2007 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. 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! .: Brainer :. patrick.nusbaum@gmail.com Link do komentarza Udostępnij na innych stronach More sharing options...
czeri Napisano Grudzień 9, 2007 Zgłoś Share Napisano Grudzień 9, 2007 Gdybyś mi mógł wysłać ten kod ONP to byłbym wdzięczny czeri@vp.pl Link do komentarza Udostępnij na innych stronach More sharing options...
Polecane posty
Zarchiwizowany
Ten temat jest archiwizowany i nie można dodawać nowych odpowiedzi.