Ver. 1.0 Beta, Don't have a compiler? Now you can write simple scripts ONLINE! This is a basic version -does not include all the Pascal statements. Only to learn basics

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.

 

ON-LINE scripts!

This website uses cookie files in order to provide Google services (advertisements, analitycs) and Facebook. If you want to block using cookies, turn them off in your browser settings. Need a help? Click me