Ver. 1.0 Beta, Nie masz kompilatora? Teraz możesz pisać skrypty ONLINE! Wersja podstawowa -nie zawiera wszystkich poleceń Pascala. Służy do nauki podstaw

Pascal

Profesjonalny kalkulator w Pascalu


Wykorzystując poniższy moduł możesz rozwiązywać dowolne działania matematyczne z nawiasami, pierwiastkami i zmiennymi wewnątrz swojego programu. Dzięki niemu łatwo zbudujesz kalkulator, który rozwiąże dowolne działania -obojętnie jak zagnieżdżone


Cały algorytm mieści się w dołączonym module Math. Komputer analizuje wyrażenie, po czym zaczyna rozwiązywać siebie -zagnieżdżając się w nawiasach oraz zachowując kolejność działań.


Niestety algorytm nie korzysta z odwrotnej notacji polskiej i nie jest przez to doskonały. Nadaje się jednak wystarczająco do szybkiego rozwiązywania dowolnych działań



Wykorzystanie modułu kalkulatora



{$N+}
USES MAth;
VAR X:Single;
   i:Byte;

BEGIN

 Math_ZdefiniujZmienna('x', @X, 1);
 FOR i:=1 TO 10
 DO BEGIN
  x:=i;
  WriteLn(Math_ObliczWyrazenie('x*x-9'):10:3);
 END;


END.


Moduł matematyczny - kalkulator



{*************************************************************************}
{*************************************************************************}
{*************************************************************************}
{$N+}

UNIT  Math;


INTERFACE

{*************************************************************************}

TYPE
    PListMath      =^TListMath;
    PZmienna       =^TZmienna;

{*************************************************************************}

    TListMath      = RECORD

      {WZKAZNIK NA KOLEJNY ELEMENT}
      Next         : PListMath;

      {WSKAZNIK NA POPRZEDNI ELEMENT}
      Prev         : PListMath;

      {WSKAZNIK NA PIERWSZE I OSTATNIE DZIECKO}
      FirstCh,
      LastCh       : PListMath;
      Parent       : PListMath;

      {JAK MA TRAKTOWAC PODANA WARTOSC}
      CASE         Typ:Byte  OF

      {0      - LICZBA
       1      - DZIECKO CZYLI WYRAZENIE W KOLEJNYM NAWIASIE OKRESLONE ADRESEM
       2      - ZMIENNA OKRESLONA PRZEZ ADRES
       3      - FUNKCJA OKRESLONA PRZEZ ADRES
       4      - NIEROZPOZNANA INSTRUKCJA}

      0:
        (
          {JAKA LICZBA MA TU BYC}
          Liczba       : Single;

          {OPERACJA ZA TA LICZBA}
          Op           : Byte;

          {ZMIANA ZNAKU}
          ZmienZnak    : Boolean);


      1:
        (
          {JESLI MA WLASNE ARGUMENTY LUB ZAGNIEZDZONY NAWIAS}
          Child        : PListMath;

          {OPERACJA ZA DZIECKIEM}
          Oper         : Byte;

          {CZY MA ZMIENIC ZNAK DZIECKU}
          ZmienZnk     : Boolean);

      2:
        (
          {GDY WYSTAPI ZMIENNA PRZECHOWUJE JEJ ADRES W PAMIECI}
          Zmienna      : PZmienna;

          {OPERACJA ZA TA LICZBA}
          Operacja     : Byte;

          {ZMIANA ZNAKU}
          Znak         : Boolean
          );

      3:
        (
          {GDY WYSTAPI ZMIENNA PRZECHOWUJE JEJ ADRES W PAMIECI}
          Funkcja      : PZmienna;

          Children     : PListMath;
          );

      END;


{*************************************************************************}

    TZmienna       = OBJECT

      {ADRES W PAMIECI TEJ ZMIENNEJ}
      Adres        : Pointer;

      {NAZWA UZYWANA PRZEZ MODUL}
      Nazwa        : Char;

      {CZY BEDZIE TO ZMIENNA CZY FUNKCJA (0 ZMIENNA 1 FUNKCJA)}
      Typ          : Byte;

      {NASTEPNA ZMIENNA}
      Next         : PZmienna;

    END;

{*************************************************************************}


{*************************************************************************}

FUNCTION  Math_ObliczWyrazenie(CONST S:STRING):Single;
PROCEDURE Math_ZdefiniujZmienna(Nazwa:Char; Adres:Pointer; Typ:Byte);
PROCEDURE Math_FreeAll;

{*************************************************************************}

FUNCTION IntToStrX(I:Single):STRING;
FUNCTION Math_ObliczListe(First:PListMath):Single;

{*************************************************************************}


IMPLEMENTATION
USES Standard;
CONST
     {ILE OPERACJI}
     MaxOP      =6;

     {ILE STANDARDOWYCH FUNKCJI}
     MaxFunc    =3;

     {PRIORYTETY PODSTAWOWYCH OPERACJI}
     Prioryt    : ARRAY[1..MaxOP] OF BYTE=
     (1, 1, 2, 2, 3, 0);

     {ZNAKI STANDARDOWYCH OPERACJI}
     Znak       : ARRAY[1..MaxOP] OF CHAR=
     ('+','-','*','/','^','x');

     {STANDARDOWE FUNKCJE}
     Funkcje    : ARRAY[1..MaxFunc] OF CHAR=
     ('!','%','@');

     {SPODZIEWANE WARTOSCI}
     M_LICZBA     = 1;
     M_NAWIASO    = 2;
     M_NAWIASZ    = 3;
     M_MINUS      = 4;
     M_OPERATOR   = 5;
     M_STFUNKCJA  = 6;
     M_ZMIENNA    = 7;
     M_FUNKCJA    = 8;
     M_BLAD       = 9;

     {ILE MOZLIWYCH SPODZIEWANYCH WARTOSCI}
     M_Max        = 9;


{*************************************************************************}


VAR  FirstEl,
    LastEl         : PListMath;

    FirstZm        : PZmienna;

    Mozliwe        : ARRAY[1..M_Max] OF Boolean;
    Req            : ARRAY[1..M_Max] OF Boolean;
    Nawias         : Byte;



{*************************************************************************}
FUNCTION IntToStrX(I:Single):STRING;
VAR S:STRING;
   j:Single;
   n:Integer;


BEGIN

 j:=1;
 n:=1;
 WHILE j  BEGIN
   j:=j*10;
   Inc(n);
 END;

 IF Round(I)<>I THEN
 Str(I:n:4, S) ELSE
 Str(Round(I):n-1, S);

 IntToStrX:=S;
END;

{*************************************************************************}

PROCEDURE Off(ID:Byte);
BEGIN
 Mozliwe[ID]:=FALSE;
END;

{************************************}

PROCEDURE SetPossibleValues(Typ:Byte);
BEGIN

 {GDY NIE ROZPOZNANO ELEMENTU MOZLIWE WARTOSCI ZOSTANA NIEZMIENIONE}
 IF Typ=M_BLAD THEN Exit;

 {ZAKLADAMY ZE WSZYSTKIE DZIALANIA BEDA MOZLIWE}
 FillChar(Mozliwe, SizeOf(Mozliwe), TRUE);

 {KIEDY OSTATNIO ROZPOZNANYM ELEMENTYM BYLA:}
 CASE Typ OF

   M_LICZBA:
     BEGIN
       {NIEMOZLIWE BEDA OBIEKTY}
       Off(M_LICZBA);
       Off(M_NAWIASO);
       Off(M_MINUS);
       Off(M_ZMIENNA);
       Off(M_FUNKCJA);

       {JESLI NIE MA NAWIASU OTWARTEGO TO NIE MOZNA GO ZAMKNAC}
       IF Nawias=0 THEN Off(M_NAWIASZ);
     END;

   M_NAWIASO:
     BEGIN
       {O 1 NAWIAS WIECEJ}
       Inc(Nawias);

       {NIEMOZLIWE BEDA OBIEKTY}
       Off(M_OPERATOR);
       Off(M_STFUNKCJA);
     END;

   M_NAWIASZ:
     BEGIN
       {O 1 NAWIAS MNIEJ}
       Dec(Nawias);

       {NIEMOZLIWE BEDA OBIEKTY}
       Off(M_LICZBA);
       Off(M_NAWIASO);
       Off(M_MINUS);
       Off(M_STFUNKCJA);
       Off(M_ZMIENNA);
       Off(M_FUNKCJA);

       {JESLI NIE MA NAWIASU OTWARTEGO TO NIE MOZNA GO ZAMKNAC}
       IF Nawias=0 THEN Off(M_NAWIASZ);
     END;

   M_MINUS:
     BEGIN
       {NIEMOZLIWE BEDA OBIEKTY}
       Off(M_NAWIASZ);
       Off(M_MINUS);
       Off(M_OPERATOR);
       Off(M_STFUNKCJA);
     END;

   M_OPERATOR:
     BEGIN
       {NIEMOZLIWE BEDA OBIEKTY}
       Off(M_NAWIASZ);
       Off(M_MINUS);
       Off(M_OPERATOR);
       Off(M_STFUNKCJA);
     END;

   M_STFUNKCJA:
     BEGIN
       {W TYM WYPADKU STANDARDOWE FUNKCJE OPROCZ POTEGI}
       Off(M_LICZBA);
       Off(M_NAWIASO);
       Off(M_MINUS);
       Off(M_STFUNKCJA);
       Off(M_ZMIENNA);
       Off(M_FUNKCJA);

       {JESLI NIE MA NAWIASU OTWARTEGO TO NIE MOZNA GO ZAMKNAC}
       IF Nawias=0 THEN Off(M_NAWIASZ);
     END;

   M_ZMIENNA:
     BEGIN
       {NIEMOZLIWE BEDA OBIEKTY}
       Off(M_LICZBA);
       Off(M_NAWIASO);
       Off(M_MINUS);
       Off(M_ZMIENNA);
       Off(M_FUNKCJA);

       {JESLI NIE MA NAWIASU OTWARTEGO TO NIE MOZNA GO ZAMKNAC}
       IF Nawias=0 THEN Off(M_NAWIASZ);
     END;

   M_FUNKCJA:
     BEGIN
       {NIEMOZLIWE BEDA OBIEKTY}
       Off(M_LICZBA);
       Off(M_NAWIASZ);
       Off(M_MINUS);
       Off(M_OPERATOR);
       Off(M_STFUNKCJA);
       Off(M_FUNKCJA);
     END;
 END;

END;

{*************************************************************************}

PROCEDURE On(Val:Byte);
BEGIN
 Req[Val]:=TRUE;
END;

{*************************************************************************}

PROCEDURE UstawWymaganeWartosci(Typ:Byte);
BEGIN
 FillChar(Req, SizeOf(Req), False);
 CASE Typ OF
   M_LICZBA:
     BEGIN
       On(M_OPERATOR);
       On(M_NAWIASZ);
     END;
   M_ZMIENNA:
     BEGIN
       On(M_OPERATOR);
       On(M_NAWIASZ);
     END;
   M_FUNKCJA:
     BEGIN
       On(M_NAWIASO);
     END;


 END;
END;

FUNCTION Math_AddNewElement(Parent:PListMath; Liczba:Single; Typ:Byte; Adres:Pointer; Op:Byte;Znak:Boolean):PListMath;
{*************************************************************************
(RAMKA 1)

     DODAJE NOWA LICZBE, FUNKCJE ALBO ZMIENNA W ZALEZNOSCI OD TYPU:

     0      - LICZBA
     1      - DZIECKO CZYLI WYRAZENIE W KOLEJNYM NAWIASIE OKRESLONE ADRESEM
     2      - ZMIENNA OKRESLONA PRZEZ ADRES
     3      - FUNKCJA OKRESLONA PRZEZ ADRES
     4      - NIEROZPOZNANA INSTRUKCJA
*************************************************************************}
VAR Temp     : PListMath;

BEGIN
 {TWORZENIE NOWEGO ELEMENTU NA KONCU LISTY}
 New(Temp);
 Math_AddNewElement:=Temp;

 {NIE WIADOMO CZY BEDZIE COS NA KONCU I POCZATKU}
 Temp^.Next:=NIL;
 Temp^.Prev:=NIL;
 Temp^.Parent:=Parent;

 {NOWY ELEMENT BEDZIE BEZDZIETNY}
 Temp^.FirstCh:=NIL;
 Temp^.LastCh:=NIL;


 IF Assigned(Parent) THEN

 {DLA DZIECKA}
 BEGIN

 {JESLI JUZ COS JEST NA LISCIE}
 IF Assigned(Parent^.FirstCh) THEN
 BEGIN
   {NASTEPNYM ELEMENTEM BEDZIE SWIEZO UTWORZONY}
   Parent^.LastCh^.Next:=Temp;

   {POPRZEDNIM NOWO UTWORZONEGO BEDZIE STARY OSTATNI}
   Temp^.Prev:=Parent^.LastCh;

   {OSTATNIM BEDZIE NOWO UTWORZONY}
   Parent^.LastCh:=Temp;
 END ELSE
 BEGIN
   {PIERWSZYM I OSTATNIM BEDZIE NOWO UTWORZONY}
   Parent^.FirstCh:=Temp;
   Parent^.LastCh:=Temp;
 END;

 END ELSE

 {DLA ELEMENTU GLOWNEGO}
 BEGIN
 {JESLI JUZ COS JEST NA LISCIE}
 IF Assigned(FirstEl) THEN
 BEGIN
   {NASTEPNYM ELEMENTEM BEDZIE SWIEZO UTWORZONY}
   LastEl^.Next:=Temp;

   {POPRZEDNIM NOWO UTWORZONEGO BEDZIE STARY OSTATNI}
   Temp^.Prev:=LastEl;

   {OSTATNIM BEDZIE NOWO UTWORZONY}
   LastEl:=Temp;
 END ELSE
 BEGIN
   {PIERWSZYM I OSTATNIM BEDZIE NOWO UTWORZONY}
   FirstEl:=Temp;
   LastEl:=Temp;
 END;
 END;


 {USTALA CZYM BEDZIE TEN ELEMENT (PATRZ RAMKA 1)}
 Temp^.Typ:=Typ;

 CASE Typ OF
   0:
     BEGIN
       {WSTAWIA LICZBE JAKO ELEMENT}
       Temp^.Liczba:=Liczba;

       {ZAZNACZA WYBRANA OPERACJE}
       Temp^.Op:=Op;

       {CZY MA ZMIENIC ZNAK}
       Temp^.ZmienZnak:=Znak;
     END;

   1:
     BEGIN
       {PODSTAWIA ADRES DZIECKA}
       Temp^.Child:=NIL;

     END;

   2:
     BEGIN
       {PODSTAWIA ADRES ZMIENNEJ}
       Temp^.Zmienna:=Adres;

       Temp^.Operacja:=Op;

       Temp^.Znak:=Znak;
     END;

   3:
     BEGIN
       Temp^.Funkcja:=Adres;

       {ZMIENIC v!@!!!!!!!!}
       Temp^.Children:=NIL;
     END;




 END;
END;

{*************************************************************************}

PROCEDURE Math_ZdefiniujZmienna(Nazwa:Char; Adres:Pointer; Typ:Byte);
VAR Temp:PZmienna;
BEGIN
 {NOWE MIEJSCE W PAMIECI NA OPIS ZMIENNEJ}
 New(Temp);

 {DOLACZA NOWA ZMIENNA DO LISTY}
 Temp^.Next:=FirstZm;

 {PIERWSZA ZMIENNA BEDZIE TERAZ NOWO UTWORZONA}
 FirstZm:=Temp;

 {CZY BEDZIE TO FUNKCJA CZY ZMIENNA}
 Temp^.Typ:=Typ;

 {POBIERANIE PARAMETROW}
 Temp^.Nazwa:=Nazwa;
 Temp^.Adres:=Adres;

END;

{*************************************************************************}

PROCEDURE Math_FreeAll;
VAR Temp:PZmienna;
BEGIN
 {DOPLOKI ISTNIEJA JAKIES ZMIENNE}
 WHILE Assigned(FirstZm) DO
 BEGIN
   {POBIERA PIERWSZA Z NICH}
   Temp:=FirstZm;

   {PRZECHODZI DO NASTEPNEJ}
   FirstZm:=FirstZm^.Next;

   {KASUJE POBRANA Z PAMIECI}
   Dispose(Temp);
 END;
END;

{*************************************************************************}

FUNCTION Silnia(x:Single):Single;
VAR i:Byte;
   w:Single;

BEGIN

 {BLAD JESLI SILNIA < 0}
 Silnia:=0;

 IF (x<0) THEN Exit;

 {NA POCZATEK SILNIA BEDZIE ROWNA PODANEJ LICZBIE}
 Silnia:=x;

 {GDY ZBYT DUZA WARTOSC TA LICZBE PROGRAM POTRAKTUJE
 JAK BY NIE BYLA Z SILNIA}
 IF x>12 THEN Exit;

 {PODSTAWIA 1 DO TYMCZASOWEGO WYNIKU}
 w:=1;

 {MNOZY TYMCZASOWY WYNIK PRZEZ KOLEJNA LICZBE}
 FOR i:=2 TO Round(x) DO
   w:=w*i;

 {WYNIKIEM BEDZIE POWSTALA LICZBA PRZEZ MNOZENIE JEJ KOLEJNYCH
 WARTOSCI}
 Silnia:=w;
END;

{*************************************************************************}

FUNCTION Potega(x, y:Single):Single;
VAR i:Byte;
   w:Single;

BEGIN

 {NA POCZATEK WYNIKIEM BEDZIE LICZBA POTEGOWANA}
 Potega:=x;

 {GDY ZBYT DUZA WARTOSC TA LICZBE PROGRAM POTRAKTUJE
 JAK BY NIE BYLA Z POTEGA}
 IF y>15 THEN Exit;

 {WYNIKIEM TYMCZASOWYM BEDZIE 1}
 w:=1;

 {LICZY POTEGE CZYLI POWTORZONY ILOCZYN y RAZY}
 FOR i:=1 TO ABS(Round(y)) DO
   w:=w*x;

 {GDY POTEGA BEDZIE UJEMNA WYNIKIEM JEST JEJ ODWROTNOSC}
 IF y<0 THEN w:=1/w;

 {ZWRACA WYNIK}
 Potega:=w;

END;

{*************************************************************************}

FUNCTION ObliczLiczbe(i:Byte;l:Single):Single;
BEGIN

 {ZALEZNIE OD FUNKCJI}
 CASE i OF

   {LICZY SILNIE}
   1:l:=Silnia(l);

   {ALBO PROCENT}
   2:l:=l/100;

   {PIERWIASTEK KWADRATOWY}
   3:IF l>0 THEN l:=Sqrt(l) ELSE l:=0;
 END;

 {ZWRACA WYNIK}
 ObliczLiczbe:=l;
END;

{*************************************************************************}

FUNCTION Oblicz(a, b:Single;Op:Byte):Single;
BEGIN
 Oblicz:=0;

 {ZALEZNIE OD OPERACJI}
 CASE Op OF

   {DODAJE}
   1:Oblicz:=a+b;

   {ODEJMUJE}
   2:Oblicz:=a-b;

   {MNOZY}
   3:Oblicz:=a*b;

   {LUB DZIELI}
   4:IF b<>0 THEN Oblicz:=a/b ELSE Oblicz:=a/0.001;

   {I POTEGUJE}
   5:Oblicz:=Potega(a, b);
 END;
END;

{*************************************************************************}

{OBLICZA CALA STRUKTURE DANYCH}




PROCEDURE M_PrzeksztalcNaLiczby(Temp:PListMath);
BEGIN
 {JESLI SA JAKIES NIEROZPOZNANE FUNKCJE PRZEKSZTALCA JE NA LICZBY}
 WHILE Assigned(Temp) DO
   BEGIN
     CASE Temp^.Typ OF
     {DZIECKO}
       1:
         BEGIN
           Temp^.Liczba:=Math_ObliczListe(Temp^.Child);
           Temp^.ZmienZnak:=False;

         END;

     {ZMIENNA}
       2:
         BEGIN
         END;

     {FUNKCJA}
       3:
     END;

     Temp:=Temp^.Next;
   END;
END;


FUNCTION Math_ObliczListe(First:PListMath):Single;

VAR Liczba:Single;
   Temp:PListMath;
   Del:PListMath;


BEGIN
 {GDY NIE BEDZIE NIC BEDZIE 0}
 Math_ObliczListe:=0;

 {I PROCEDURA SIE ZAKONCZY}
 IF NOT Assigned(First) THEN Exit;

 {TYMCZASOWY PIERWSZY ELEMENT}
 Temp:=First;

 {M_PrzeksztalcNaLiczby(Temp);}

 {DOPLOKI JEST COS NA LISCIE}
 WHILE (Assigned(Temp) AND Assigned(Temp^.Next)) OR (Temp^.Typ=1) DO
 BEGIN

   CASE Temp^.Typ OF
     {LICZBA}
     0:IF Temp^.Next^.Typ=0 THEN
       BEGIN
         IF Assigned(Temp^.Prev) THEN
         BEGIN
         {JESLI POPRZEDNI ELEMENT Z OBECNYM MA WIEKSZY PRIORYTET NIZ
          OBECNY Z NASTEPNYM TO GO WYKONUJE}
          IF Prioryt[Temp^.Prev^.Op]>=Prioryt[Temp^.Op] THEN
            BEGIN
              {OBLICZA WYNIK}
              Temp^.Prev^.Liczba:=Oblicz(Temp^.Prev^.Liczba, Temp^.Liczba, Temp^.Prev^.Op);
              Temp^.Prev^.Op:=Temp^.Op;

              {JESLI TRZEBA ZMIENIA ZNAK}
              {IF Temp^.Prev^.ZmienZnak THEN Temp^.Prev^.Liczba:=-Temp^.Prev^.Liczba;}

              {DOWIAZANIA ELEMENTOW}
              Temp^.Prev^.Next:=Temp^.Next;
              Temp^.Next^.Prev:=Temp^.Prev;

              {TYMCZASOWA ZMIENNA DO USUNIECIA}
              Del:=Temp;

              {PRZECHODZI DO POCZATKU}
              Temp:=First;

              {ZWALNIA PAMIEC DRUGIEGO ELEMENTU}
              Dispose(Del);
            END;

         END ELSE
         {JESLI SA TYLKO 2 ELEMENTY}
         IF NOT Assigned(Temp^.Next^.Next) THEN
           BEGIN
             {OBLICZA WYNIK}
             Temp^.Liczba:=Oblicz(Temp^.Liczba, Temp^.Next^.Liczba, Temp^.Op);

             {ZWALNIA PAMIEC}
             Dispose(Temp^.Next);

             {JUZ NIE MA KOLEJNEGO ELEMENTU}
             Temp^.Next:=NIL;

             {WYCHODZI ZA PETLE}
             Break;

           END;

       END;

     {GDY ZNAJDZIE DZIECKO MUSI WYKONAC REKURENCYJNIE ROZWIAZANIE LISTY}
     1:
       BEGIN
         {ZMIENI SIE W LICZBE}
         Temp^.Typ:=0;

         {LICZBA BEDZIE ROZWIAZANIE NAWIASU}
         Temp^.Liczba:=Math_ObliczListe(Temp^.FirstCh);

         IF Temp^.ZmienZnk THEN Temp^.Liczba:=-Temp^.Liczba;

         {PRZECHODZI NA POCZATEK LISTY}
         Temp:=First;
       END;

   END;{CASE'a}


   {JEZELI NIE OBLICZYL JESZCZE WSZYSTKIEGO TO ZACZYNA
    PRZEGLADAC CALA LISTE OD POCZATKU}
   IF Assigned(Temp^.Next) AND (Assigned(Temp^.Next^.Next) OR
      (Temp^.Next^.Typ=1))
      THEN
      Temp:=Temp^.Next
      ELSE
      BEGIN


        IF (Temp^.Next^.Typ=0) AND (Prioryt[Temp^.Prev^.Op]             BEGIN
              {OBLICZA WYNIK}
              Temp^.Liczba:=Oblicz(Temp^.Liczba, Temp^.Next^.Liczba, Temp^.Op);

              Temp^.Op:=MaxOp;

              {JESLI TRZEBA ZMIENIA ZNAK}
              {IF Temp^.ZmienZnak THEN Temp^.Liczba:=-Temp^.Liczba;}

              {TYMCZASOWA ZMIENNA DO USUNIECIA}
              Del:=Temp^.Next;

              {DOWIAZANIA ELEMENTOW}
              Temp^.Next:=NIL;

              {ZWALNIA PAMIEC DRUGIEGO ELEMENTU}
              Dispose(Del);
            END;


        Temp:=First;
      END;
 END;

 {ZWRACA WYNIK}
 Math_ObliczListe:=First^.Liczba;

 {ZWALNIA PAMIEC TYMCZASOWA}
 Dispose(Temp);
END;


{TWORZY STRUKTURE DANYCH I JA OBLICZA}
FUNCTION Math_ObliczWyrazenie(CONST S:STRING):Single;

VAR
   {POCZATEK I KONIEC PRZEDZIALU TEKSTU}
   i,
   j,
   k    : Byte;

   {PRIORYTET}
   p    : Byte;
   Kropka:Boolean;
   codalej:Byte;
   Op:Byte;
   Znaleziono:Byte;
   liczba:Single;
   Temp          :PListMath;
   Tmp           :PZmienna;
   Znk:Boolean;
   Parent,
   BrakujeOperatora:PListMath;

BEGIN

 {STANDARDOWY WYNIK, NP. JESLI NIC NIE BEDZIE PODANE JAKO TEKST}
 Math_ObliczWyrazenie:=0;

 {BEDZIE TO NOWE WYRAZENIE WIEC NIE POWINIEN PAMIETAC STAREGO}
 FirstEl:=NIL;
 Parent:=NIL;

 {OD PIERWSZEGO ZNAKU}
 i:=1;

 {ZAKLADAMY ZE WSZYSTKIE DZIALANIA BEDA MOZLIWE}
 FillChar(Mozliwe, SizeOf(Mozliwe), TRUE);
 Off(M_OPERATOR);
 Off(M_STFUNKCJA);
 Off(M_NAWIASZ);
 Znk:=FALSE;
 Znaleziono:=M_BLAD;

 REPEAT

   {ROZPOCZYNA BADANIE JAKIEGOS ELEMENTU}

   {POSZUKIWANIE LICZBY}
   IF Mozliwe[M_LICZBA] AND ((S[i] IN ['0'..'9']) OR (S[i]='-')) THEN
   BEGIN
     j:=i;
     SetPossibleValues(M_LICZBA);
     Znaleziono:=M_LICZBA;
     kropka:=False;

     WHILE (i<=Byte(S[0])) AND (S[i] IN ['0'..'9']) OR ((S[i]='-') AND (i=j)) OR ((S[i]='.') AND NOT Kropka) DO
     BEGIN
       IF S[i]='.' THEN Kropka:=TRUE;
       Inc(i);
     END;

     IF (i=j+1) AND (S[j]='-') THEN
       BEGIN
         Dec(i);

       END ELSE
       BEGIN

     Liczba:=StrToInt(Copy(S, j, i-j));
     UstawWymaganeWartosci(M_LICZBA);

     IF (i>Byte(S[0])) OR (S[i]=')') THEN

     IF Assigned(Parent) THEN
     BEGIN
       IF Assigned(Parent^.FirstCh)
                       THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                       ELSE Parent^.FirstCh:=Math_AddNewElement(Parent,Liczba, 0, NIL, j, Znk);
     END ELSE

     IF Assigned(FirstEl)
                       THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                       ELSE FirstEl:=Math_AddNewElement(Parent,Liczba, 0, NIL, j, Znk);

     Continue;
     END;
   END;

   {ZNALAZL OPERATOR}
   IF Mozliwe[M_OPERATOR] THEN
   BEGIN
      FOR j:=1 TO MaxOp-1 DO
         IF S[i]=Znak[j] THEN
         IF Znaleziono=M_NAWIASZ THEN
         BEGIN
           {UZUPELNIA INFORMACJE O NAWIASIE}
           SetPossibleValues(M_OPERATOR);
           BrakujeOperatora^.Oper:=j;

           Inc(i);
           Znaleziono:=M_OPERATOR;
           Break;

         END ELSE
         BEGIN
           SetPossibleValues(M_OPERATOR);
           Znaleziono:=M_OPERATOR;

           {ODKLADA ELEMENT NA LISTE}
           IF Req[M_OPERATOR] THEN

           IF Assigned(Parent) THEN
           BEGIN
             IF Assigned(Parent^.FirstCh)
                             THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                             ELSE Parent^.FirstCh:=Math_AddNewElement(Parent,Liczba, 0, NIL, j, Znk);
           END ELSE

           IF Assigned(FirstEl)
                       THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                       ELSE FirstEl:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk);


           Inc(i);
           Break;
         END;
      IF Znaleziono=M_OPERATOR THEN Continue;
   END;

   {FUNKCJA STANDARDOWA}
   IF Mozliwe[M_STFUNKCJA] AND (Znaleziono=M_LICZBA) THEN
     BEGIN
      Op:=0;
      FOR j:=1 TO MaxFunc DO
         IF S[i]=Funkcje[j] THEN
         BEGIN
           UstawWymaganeWartosci(M_LICZBA);
           SetPossibleValues(M_STFUNKCJA);
           Liczba:=ObliczLiczbe(j, Liczba);
           Op:=M_STFUNKCJA;

           Inc(i);

           {JESLI BEDZIE NAWIAS ZAMKNIETY LUB KONIEC ROWNANIA
            DOKLADA DO LISTY}
           IF (i>Byte(S[0])) OR (S[i]=')') THEN
           IF Assigned(Parent) THEN
           BEGIN
             IF Assigned(Parent^.FirstCh)
                             THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                             ELSE Parent^.FirstCh:=Math_AddNewElement(Parent,Liczba, 0, NIL, j, Znk);
           END ELSE
           IF Assigned(FirstEl)
                       THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                       ELSE FirstEl:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk);

           Break;
         END;
       IF Op<>0 THEN Continue;
     END;


   {OTWARCIE NAWIASU}
   IF Mozliwe[M_NAWIASO] AND (S[i]='(') THEN
     BEGIN
       SetPossibleValues(M_NAWIASO);
       Znaleziono:=M_NAWIASO;

       {DODAJE TEN NAWIAS JAKO KOLEJNY ELEMENT (DZIECKO)}
       IF Assigned(Parent) THEN
       BEGIN
         IF Assigned(Parent^.FirstCh)
                         THEN Temp:=Math_AddNewElement(Parent, Liczba, 1, NIL, j, Znk)
                         ELSE
                           BEGIN
                             Parent^.FirstCh:=Math_AddNewElement(Parent,Liczba, 1, NIL, j, Znk);
                             Temp:=Parent^.FirstCh;
                           END;
       END ELSE

         IF Assigned(FirstEl)
                     THEN Temp:=Math_AddNewElement(Parent, 0, 1, NIL, j, Znk)
                     ELSE BEGIN FirstEl:=Math_AddNewElement(Parent, 0, 1, NIL, j, Znk);Temp:=FirstEl;END;

       Parent:=Temp;
       Inc(i);
       Continue;
     END;

   {ZAMKNIECIE NAWIASU}
   IF Mozliwe[M_NAWIASZ] AND (S[i]=')') THEN
     BEGIN
       SetPossibleValues(M_NAWIASZ);

       {RODZICEM BEDZIE RODZIC RODZICA}
       Znaleziono:=M_NAWIASZ;

       {ZAZNACZA, ZE PRZY ZNALEZIENIU KOLEJNEGO OPERATORA MA GO DODAC
        DO RODZICA}
       BrakujeOperatora:=Parent;
       Parent:=Parent^.Parent;
       Inc(i);
       Continue;
     END;

   {ZAMKNIECIE NAWIASU}
   IF Mozliwe[M_MINUS] AND (S[i]='-') THEN
     BEGIN
       SetPossibleValues(M_MINUS);
       Znk:=NOT Znk;
       Znaleziono:=M_MINUS;

       Inc(i);
       Continue;
     END;

   IF Mozliwe[M_LICZBA] THEN
      BEGIN
        Tmp:=FirstZm;

        WHILE Assigned(Tmp) AND (S[i]<>Tmp^.Nazwa) DO
          BEGIN
            Tmp:=Tmp^.Next

          END;

        IF Tmp^.Nazwa=S[i] THEN
        BEGIN

          SetPossibleValues(M_LICZBA);
          Znaleziono:=M_LICZBA;
          UstawWymaganeWartosci(M_LICZBA);

          Liczba:=Single(Tmp^.Adres^);

          Inc(i);

          IF (i>Byte(S[0])) OR (S[i]=')') THEN

          IF Assigned(Parent) THEN
          BEGIN
            IF Assigned(Parent^.FirstCh)
                            THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                            ELSE Parent^.FirstCh:=Math_AddNewElement(Parent,Liczba, 0, NIL, j, Znk);
          END ELSE

          IF Assigned(FirstEl)
                            THEN Temp:=Math_AddNewElement(Parent, Liczba, 0, NIL, j, Znk)
                            ELSE FirstEl:=Math_AddNewElement(Parent,Liczba, 0, NIL, j, Znk);


          Continue;
        END;
      END;

   {ROZPATRYWANY KOLEJNY ZNAK}
   Inc(i);

 {WYJSCIE GDY POBIERZE DO PAMIECI CALE ROWNANIE}
 UNTIL (i>Byte(S[0]));



 IF Znk THEN
    Math_ObliczWyrazenie:=-Math_ObliczListe(FirstEl) ELSE
    Math_ObliczWyrazenie:=Math_ObliczListe(FirstEl);
END;


BEGIN
 {NA POCZATKU NIE MA ZADNYCH ZDEFINIOWANYCH ZMIENNYCH ANI FUNKCJI}
 FirstZm:=NIL;
END.

 

Strona korzysta z plików cookie w celu świadczenia usług Google (reklamy, statytyki) oraz Facebook. Jeśli chcesz zablokować pliki cookies wyłacz je w swojej przeglądarce. Potrzebujesz pomocy? kliknij