Musze napisać program kalkulator w języku Pascal na zaliczenie programowania napisałem już funkcje liczące zadania i grafikę ale nie mam bladego pojęcia jak to połączyć przyznaje z programowania jestem totalnie ciemny mogl by mi ktos posłużyć pomocą i powiedzieć w jaki sposób to zrobić by działał tak jak normalny kalkulator z góry dziękuje 
o to kody ::
Funkcje :
uses crt;
VAR a,b,l,wynikh,x1,x2:integer;
o, d,c: char;
e,s:string;
reszta,i,j:integer;
wx,wy,w,x,y,a1,b1,c1,a2,b2,c2,pdelta,delta:real;
wynik:array[1..20]of integer;
function dodawanie(a,b:integer):integer;
begin
dodawanie:=a+b;
end;
function odejmowanie(a,b:integer):integer;
begin
odejmowanie:=a-b;
end;
function mnozenie(a,b:integer):integer;
begin
mnozenie:=a*b;
end;
function dzielenie(a,b:real):real;
begin
dzielenie:=a/b;
end;
function potegowanie(a,b:integer):integer;
var i:integer; pot: integer;
begin
pot:=a;
for i:=2 to b DO pot:=pot*a;
potegowanie := pot;
end;
function pierwiastkowaniek(a:real):real;
begin
pierwiastkowaniek:=sqrt(a);
end;
function pierwiastkowaniex(a,b:real):real;
begin
b:=1/b;
pierwiastkowaniex:=Exp(b*Ln(a));
end;{to mam z neta wiec trzeba mu powiedziec}
function binarne(l:integer):string;
begin
e:=' ';
repeat
if l mod 2=0
then e:='0'+e
else e:='1'+e;
l:=l div 2;
until l=0;
binarne:=e;
end;
function oct(l:integer):string;
begin
i:=1;
while (l>7) do
begin
reszta:=l mod 8;
wynik[i]:=reszta;
l:=l div 8;
i:=i+1;
if l<8 then
begin
wynik[i]:=l;
break;
end;
end;
for j:=i downto 1 do
begin
str(wynik[j],e);
s:=s+e;
end;
oct:=s;
end;
function heks(l:integer):string;
begin
s := '';
repeat
wynikh := l MOD 16;
if wynikh = 1 then s := '1' + s;
if wynikh = 2 then s := '2' + s;
if wynikh = 3 then s := '3' + s;
if wynikh = 4 then s := '4' + s;
if wynikh = 5 then s := '5' + s;
if wynikh = 6 then s := '6' + s;
if wynikh = 7 then s := '7' + s;
if wynikh = 8 then s := '8' + s;
if wynikh = 9 then s := '9' + s;
if wynikh = 10 then s := 'A' + s;
if wynikh = 11 then s := 'B' + s;
if wynikh = 12 then s := 'C' + s;
if wynikh = 13 then s := 'D' + s;
if wynikh = 14 then s := 'E' + s;
if wynikh = 15 then s := 'F' + s;
l := l DIV 16;
until l = 0;
heks:=s;
end;
begin
REPEAT
clrscr;
writeln('Wybierz jakie dzialanie chcesz wykonac i wpisz liczbe odpowiadajaca');
writeln('(liczby musza byc wieksze do 0)');
writeln('1.Dodawanie');
writeln('2.Odejmowanie');
writeln('3.Mnozenie');
writeln('4.Dzielenie');
writeln('5.Potegowanie');
writeln('6.Pierwiastkowanie ');
writeln('7.Binarne ');
writeln('8.Oktalny ');
writeln('9.Szesnastkowy ');
writeln('0.Zaawansowane ');
REPEAT
c:=readkey;
IF (ord(c)<48) or (ord(c)>57) THEN writeln('Zly wybor ( wybierz od 1 do 6)');
UNTIL (ord(c)>=48) and (ord(c)<=57);
IF c='1' THEN Begin
clrscr;
writeln('podaj liczby ktore chcesz dodac');
readln(a);
readln(b);
dodawanie(a,b);
writeln('wynik z dodawania wynosi ',dodawanie(a,b));
readln;
end;
IF c='2' THEN Begin
clrscr;
writeln('podaj liczby ktore chcesz odjac');
readln(a);
readln(b);
odejmowanie(a,b);
writeln('wynik z odejmowania wynosi ',odejmowanie(a,b));
readln;
end;
IF c='3' THEN Begin
writeln('podaj liczby ktore chcesz pomnozyc');
readln(a);
readln(b);
mnozenie(a,b);
writeln('wynik z mnozenia wynosi ',mnozenie(a,b));
readln;
end;
IF c='4' THEN Begin
writeln('podaj liczby ktore chcesz podzielic');
readln(a);
readln(b);
dzielenie(a,b);
writeln('wynik z dodawania wynosi ',dzielenie(a,b));
readln;
end;
IF c='5' THEN Begin
write('podaj liczbe ktora chcesz spotegowac: ');
readln(a);
write('podaj do ktorej potegi: ');
readln(b);
potegowanie(a,b);
writeln('wynik z potegowania wynosi: ',potegowanie(a,b));
readln;
end;
IF c='6' THEN Begin
writeln('czy chcesz pierwiastek kwadratowy czy inny? K/I');
d:=readkey;
REPEAT
IF (d<>'k') AND (d<>'i') THEN Begin
writeln('wybierz k lub i');
d:=readkey;
end;
UNTIL (d='k') OR (d='i');
End;
IF d='k' THEN Begin
writeln('podaj liczbe z ktorej chcesz otrzymac pierwiastek kwadratowy: ');
readln(a);
pierwiastkowaniek(a);
writeln('wynik z pierwiastkowania kwadratowego liczby: ',a,' wynosi ',pierwiastkowaniek(a):0:2);
readln;
end;
IF d='i' THEN Begin
writeln('podaj liczbe ktora chcesz spierwiastkowac: ');
readln(a);
writeln('a teraz ktorego stopnia ma byc pierwiastek: ');
readln(b);
pierwiastkowaniex(a,b);
writeln('Pierwiastek stopnia ',b,' liczby ',a,' wynosi: ',pierwiastkowaniex(a,b):0:2);
readln;
end;
IF c='7' THEN Begin
write ('podaj jak liczbe chcesz zamienic na binarna: ');
readln (l);
writeln ('po zamianie:= ',binarne(l));
readln;
end;
IF c='8' THEN Begin
clrscr;
write('podaj liczbe ');
readln(l);
write('liczba ',l,' w kodzie osemkowym to: ',oct(l));
readkey;
end;
IF c='9' THEN Begin
clrscr;
Write('Podaj liczbe: ');
Readln(l);
Write('liczba',l,'w kodzie szesnastkowym to: ',heks(l));
readkey;
end;
IF c='0' THEN Begin
Repeat
clrscr;
writeln('1.Rozwiazywanie Ukˆadu rownan');
writeln('2.Rozwiazanie Rownania liniowe');
writeln('3.Rozwiazanie Rownania kwadratowe ');
c:=readkey;
IF (ord(c)<48) or (ord(c)>51)THEN writeln('Zly wybor ( wybierz od 1 do 6)');
UNTIL (ord(c)>=48) and (ord(c)<=51);
IF c='1' THEN Begin
writeln('Wprowadz liczby ukladu rowanan');
writeln('a1+/-b1=c1');
writeln('a2+/-b2=c2');
write('a1: ');
readln(a1);
write('b1: ');
readln(b1);
write('c1: ');
readln(c1);
write('a2: ');
readln(a2);
write('b2: ');
readln(b2);
write('c2: ');
readln(c2);
w:=(a1*b2)-(a2*b1);
wx:=(c1*b2)-(c2*b1);
wy:=(a1*c2)-(a2*c1);
if(w<>0) THEN begin
writeln;
writeln( 'Uklad jest oznaczony :');
x:=wx/w;
y:=wy/w;
writeln('x:= ',x:0:2);
writeln('y:= ',y:0:2);
end;
if (wx=0) and (wy=0) and (w=0) then writeln('uklad jest nieoznaczony');
if(w=0) and ((wy=0) or (wx=0)) then writeln('uklad jest sprzeczny');
readln;
end;
IF c='2' THEN Begin
clrscr;
writeln('rownanie liniowe postac := ax+/-b=c');
write('podaj a : ');
readln(a);
write('podaj b : ');
readln(b);
write('podaj c : ');
readln(l);
if a<>0 then begin
writeln('Uklad jest oznaczony');
x:=(l-b)/a;
write('x:= ',x:0:2);
end;
if (a=0) and (b=0) then begin
writeln('Rowananie tozsammosciowe');
writeln('Rozwiazaniem rowanania jest kazda liczba ');
end;
if (a=0) and (b<>0) then begin
writeln('Rownnie sprzeczne ');
writeln('Brak rozwiazan');
end;
end;
if c='3' Then Begin
writeln('Rownanie kwadratowe , postac ax^2 + bx +c =0');
write('podaj a : ');
readln(a1);
write('podaj b: ');
readln(b1);
write('podaj c: ');
readln(c1);
delta:=(b1*b1)-(4*a1*c1);
pdelta:=pierwiastkowaniek(delta);
if delta>0 then begin
c2:=(-b1+pdelta)/(2*a1);
b2:=(-b1-pdelta)/(2*a1);
writeln('Delta > 0 wiec rownanie ma dwa pierwiastki ');
writeln('x1:= ', c2:0:2);
writeln('x2:= ', b2:0:2);
end;
if delta = 0 then begin
writeln('Delta = 0 wiec rownanie ma jeden pierwiastek ' );
c2:=-b1/(2*a1);
writeln('x0:= ',c2:0:2);
end;
if delta<0 then begin
writeln('Delta jest mniejsza zero , rownanie nie ma zadnego pierwiastka');
end;
readln;
end;
end;
clrscr;
writeln('czy chcesz jeszcze raz? T/N');
o:=readkey;
REPEAT
IF (o<>'t') AND (o<>'n') THEN Begin
writeln('Tylko T lub N');
o:=readkey;
end;
UNTIL (o='t') OR (o='n');
UNTIL o='n';
end.
Grafika:
uses crt;
VAR mx,my,mklik:integer;
procedure pokazmysz; assembler;
asm
mov ax, 0001h
int 33h
end;
procedure ukryjmysz; assembler;
asm
mov ax, 0002h
int 33h
end;
procedure wezmysz(var x,y,butt:integer);
var temp1,temp2,temp3:word;
begin
asm
mov ax, 0003h
int 33h
mov temp1, bx
mov temp2, cx
mov temp3, dx
end;
butt:=temp1;
x:=temp2;
y:=temp3;
end;
procedure curoff; assembler;
asm
mov ah,01h
mov ch,10h
mov cl,00h
int 10h
end;
procedure curon; assembler;
asm
mov ah,01h
mov ch,07h
mov cl,07h
int 10h
end;
procedure graf(x1,y1,x2,y2,kol1,kol2:byte;napis:string);
begin
window(x1,y1,x2,y2);
textattr:=16*kol1+kol2;
clrscr;
writeln;
writeln(napis);
end;
procedure SetCharAttr(x,y:byte; znak:char; kolor,tlo:byte);
begin
gotoxy(x,y);
mem[$B800:160*(y-1)+2*(x-1)]:=ord(znak);
mem[$B800:160*(y-1)+2*(x-1)+1]:=kolor+16*tlo;
end;
procedure graf2(xx1,yy1,xx2,yy2,col1,col2:byte);
begin
window(xx1,yy1,xx2,yy2);
textattr:=16*col1+col2;
write;
clrscr;
end;
begin
clrscr;
textmode(c80);
window(1,1,80,25);
textattr:=16*black+white;
write(' KALKULATOR ');
writeln;writeln;
begin
repeat
graf(15,5,65,24,8,0,'');
graf(17,6,63,7,15,0,'');
graf(18,9,22,11,1,14,' 7 ');
graf(18,13,22,15,1,14,' 4 ');
graf(18,17,22,19,1,14,' 1 ');
graf(18,21,22,23,1,14,' 0 ');
graf(26,9,30,11,1,14,' 8 ');
graf(26,13,30,15,1,14,' 5 ');
graf(26,17,30,19,1,14,' 2 ');
graf(26,21,30,23,1,14,' . ');
graf(34,9,38,11,1,14,' 9 ');
graf(34,13,38,15,1,14,' 6 ');
graf(34,17,38,19,1,14,' 3 ');
graf(34,21,38,23,5,0,' = ');
graf(42,9,46,11,5,0,' DEL');
graf(42,13,46,15,5,0,' - ');
graf(42,17,46,23,5,0, ' +');
graf(50,9,54,11,5,0,' C ');
graf(50,13,54,15,5,0,' * ');
graf(50,17,54,19,5,0,' % ');
graf(58,9,63,11,5,0,' sqrt');
graf(58,13,62,15,5,0,' /');
graf(58,17,62,19,5,0,' pot');
graf(48,21,63,23,4,15,' Zaawansowane>>');
graf(66,7,67,9,7,0,'');
SetCharAttr(67,7,'b',1,7);
SetCharAttr(67,8,'i',1,7);
SetCharAttr(67,9,'n',1,7);
graf(66,11,67,13,7,0,'');
SetCharAttr(67,11,'o',1,7);
SetCharAttr(67,12,'k',1,7);
SetCharAttr(67,13,'t',1,7);
graf(66,15,67,17,7,0,'');
SetCharAttr(67,15,'h',1,7);
SetCharAttr(67,16,'e',1,7);
SetCharAttr(67,17,'x',1,7);
graf2(17,6,63,7,15,0);
repeat
pokazmysz;
wezmysz(mx,my,mklik);
if (mx>=328) and (mx<=360) and (my>=128) and (my<=176) and (mklik=1) then write('+');
if (mx>=264) and (mx<=296) and (my>=160) and (my<=176) and (mklik=1) then write('=');
if (mx>=136) and (mx<=168) and (my>=160) and (my<=176) and (mklik=1) then write('0');
if (mx>=136) and (mx<=168) and (my>=128) and (my<=148) and (mklik=1) then write('1');
if (mx>=200) and (mx<=232) and (my>=128) and (my<=148) and (mklik=1) then write('2');
if (mx>=264) and (mx<=296) and (my>=128) and (my<=148) and (mklik=1) then write('3');
if (mx>=136) and (mx<=168) and (my>=96) and (my<=112) and (mklik=1) then write('4');
if (mx>=200) and (mx<=232) and (my>=96) and (my<=112) and (mklik=1) then write('5');
if (mx>=264) and (mx<=296) and (my>=96) and (my<=112) and (mklik=1) then write('6');
if (mx>=136) and (mx<=168) and (my>=64) and (my<=80) and (mklik=1) then write('7');
if (mx>=200) and (mx<=232) and (my>=64) and (my<=80) and (mklik=1) then write('8');
if (mx>=264) and (mx<=296) and (my>=64) and (my<=80) and (mklik=1) then write('9');
if (mx>=328) and (mx<=360) and (my>=64) and (my<=80) and (mklik=1) then write('DEL');
if (mx>=392) and (mx<=424) and (my>=64) and (my<=80) and (mklik=1) then write('C');
if (mx>=392) and (mx<=424) and (my>=96) and (my<=112) and (mklik=1) then write('*');
if (mx>=392) and (mx<=424) and (my>=128) and (my<=148) and (mklik=1) then write('%');
if (mx>=456) and (mx<=496) and (my>=64) and (my<=80) and (mklik=1) then write('sqrt');
if (mx>=456) and (mx<=488) and (my>=96) and (my<=112) and (mklik=1) then write('/');
if (mx>=456) and (mx<=488) and (my>=128) and (my<=144) and (mklik=1) then write('pot');
if (mx>=376) and (mx<=496) and (my>=160) and (my<=176) and (mklik=1) then write('Zaawansowane>>');
if (mx>=328) and (mx<=360) and (my>=96) and (my<=112) and (mklik=1) then write('-');
if (mx>=200) and (mx<=232) and (my>=160) and (my<=176) and (mklik=1) then write('.');
if (mx>=520) and (mx<=528) and (my>=40) and (my<=64) and (mklik=1) then write('bin');
if (mx>=520) and (mx<=528) and (my>=80) and (my<=96) and (mklik=1) then write('okt');
if (mx>=520) and (mx<=528) and (my>=112) and (my<=128) and (mklik=1) then write('hex');
delay(66);
until mklik=2;
until mklik=2 ;
end;
end.
o to kody ::
Funkcje :
uses crt;
VAR a,b,l,wynikh,x1,x2:integer;
o, d,c: char;
e,s:string;
reszta,i,j:integer;
wx,wy,w,x,y,a1,b1,c1,a2,b2,c2,pdelta,delta:real;
wynik:array[1..20]of integer;
function dodawanie(a,b:integer):integer;
begin
dodawanie:=a+b;
end;
function odejmowanie(a,b:integer):integer;
begin
odejmowanie:=a-b;
end;
function mnozenie(a,b:integer):integer;
begin
mnozenie:=a*b;
end;
function dzielenie(a,b:real):real;
begin
dzielenie:=a/b;
end;
function potegowanie(a,b:integer):integer;
var i:integer; pot: integer;
begin
pot:=a;
for i:=2 to b DO pot:=pot*a;
potegowanie := pot;
end;
function pierwiastkowaniek(a:real):real;
begin
pierwiastkowaniek:=sqrt(a);
end;
function pierwiastkowaniex(a,b:real):real;
begin
b:=1/b;
pierwiastkowaniex:=Exp(b*Ln(a));
end;{to mam z neta wiec trzeba mu powiedziec}
function binarne(l:integer):string;
begin
e:=' ';
repeat
if l mod 2=0
then e:='0'+e
else e:='1'+e;
l:=l div 2;
until l=0;
binarne:=e;
end;
function oct(l:integer):string;
begin
i:=1;
while (l>7) do
begin
reszta:=l mod 8;
wynik[i]:=reszta;
l:=l div 8;
i:=i+1;
if l<8 then
begin
wynik[i]:=l;
break;
end;
end;
for j:=i downto 1 do
begin
str(wynik[j],e);
s:=s+e;
end;
oct:=s;
end;
function heks(l:integer):string;
begin
s := '';
repeat
wynikh := l MOD 16;
if wynikh = 1 then s := '1' + s;
if wynikh = 2 then s := '2' + s;
if wynikh = 3 then s := '3' + s;
if wynikh = 4 then s := '4' + s;
if wynikh = 5 then s := '5' + s;
if wynikh = 6 then s := '6' + s;
if wynikh = 7 then s := '7' + s;
if wynikh = 8 then s := '8' + s;
if wynikh = 9 then s := '9' + s;
if wynikh = 10 then s := 'A' + s;
if wynikh = 11 then s := 'B' + s;
if wynikh = 12 then s := 'C' + s;
if wynikh = 13 then s := 'D' + s;
if wynikh = 14 then s := 'E' + s;
if wynikh = 15 then s := 'F' + s;
l := l DIV 16;
until l = 0;
heks:=s;
end;
begin
REPEAT
clrscr;
writeln('Wybierz jakie dzialanie chcesz wykonac i wpisz liczbe odpowiadajaca');
writeln('(liczby musza byc wieksze do 0)');
writeln('1.Dodawanie');
writeln('2.Odejmowanie');
writeln('3.Mnozenie');
writeln('4.Dzielenie');
writeln('5.Potegowanie');
writeln('6.Pierwiastkowanie ');
writeln('7.Binarne ');
writeln('8.Oktalny ');
writeln('9.Szesnastkowy ');
writeln('0.Zaawansowane ');
REPEAT
c:=readkey;
IF (ord(c)<48) or (ord(c)>57) THEN writeln('Zly wybor ( wybierz od 1 do 6)');
UNTIL (ord(c)>=48) and (ord(c)<=57);
IF c='1' THEN Begin
clrscr;
writeln('podaj liczby ktore chcesz dodac');
readln(a);
readln(b);
dodawanie(a,b);
writeln('wynik z dodawania wynosi ',dodawanie(a,b));
readln;
end;
IF c='2' THEN Begin
clrscr;
writeln('podaj liczby ktore chcesz odjac');
readln(a);
readln(b);
odejmowanie(a,b);
writeln('wynik z odejmowania wynosi ',odejmowanie(a,b));
readln;
end;
IF c='3' THEN Begin
writeln('podaj liczby ktore chcesz pomnozyc');
readln(a);
readln(b);
mnozenie(a,b);
writeln('wynik z mnozenia wynosi ',mnozenie(a,b));
readln;
end;
IF c='4' THEN Begin
writeln('podaj liczby ktore chcesz podzielic');
readln(a);
readln(b);
dzielenie(a,b);
writeln('wynik z dodawania wynosi ',dzielenie(a,b));
readln;
end;
IF c='5' THEN Begin
write('podaj liczbe ktora chcesz spotegowac: ');
readln(a);
write('podaj do ktorej potegi: ');
readln(b);
potegowanie(a,b);
writeln('wynik z potegowania wynosi: ',potegowanie(a,b));
readln;
end;
IF c='6' THEN Begin
writeln('czy chcesz pierwiastek kwadratowy czy inny? K/I');
d:=readkey;
REPEAT
IF (d<>'k') AND (d<>'i') THEN Begin
writeln('wybierz k lub i');
d:=readkey;
end;
UNTIL (d='k') OR (d='i');
End;
IF d='k' THEN Begin
writeln('podaj liczbe z ktorej chcesz otrzymac pierwiastek kwadratowy: ');
readln(a);
pierwiastkowaniek(a);
writeln('wynik z pierwiastkowania kwadratowego liczby: ',a,' wynosi ',pierwiastkowaniek(a):0:2);
readln;
end;
IF d='i' THEN Begin
writeln('podaj liczbe ktora chcesz spierwiastkowac: ');
readln(a);
writeln('a teraz ktorego stopnia ma byc pierwiastek: ');
readln(b);
pierwiastkowaniex(a,b);
writeln('Pierwiastek stopnia ',b,' liczby ',a,' wynosi: ',pierwiastkowaniex(a,b):0:2);
readln;
end;
IF c='7' THEN Begin
write ('podaj jak liczbe chcesz zamienic na binarna: ');
readln (l);
writeln ('po zamianie:= ',binarne(l));
readln;
end;
IF c='8' THEN Begin
clrscr;
write('podaj liczbe ');
readln(l);
write('liczba ',l,' w kodzie osemkowym to: ',oct(l));
readkey;
end;
IF c='9' THEN Begin
clrscr;
Write('Podaj liczbe: ');
Readln(l);
Write('liczba',l,'w kodzie szesnastkowym to: ',heks(l));
readkey;
end;
IF c='0' THEN Begin
Repeat
clrscr;
writeln('1.Rozwiazywanie Ukˆadu rownan');
writeln('2.Rozwiazanie Rownania liniowe');
writeln('3.Rozwiazanie Rownania kwadratowe ');
c:=readkey;
IF (ord(c)<48) or (ord(c)>51)THEN writeln('Zly wybor ( wybierz od 1 do 6)');
UNTIL (ord(c)>=48) and (ord(c)<=51);
IF c='1' THEN Begin
writeln('Wprowadz liczby ukladu rowanan');
writeln('a1+/-b1=c1');
writeln('a2+/-b2=c2');
write('a1: ');
readln(a1);
write('b1: ');
readln(b1);
write('c1: ');
readln(c1);
write('a2: ');
readln(a2);
write('b2: ');
readln(b2);
write('c2: ');
readln(c2);
w:=(a1*b2)-(a2*b1);
wx:=(c1*b2)-(c2*b1);
wy:=(a1*c2)-(a2*c1);
if(w<>0) THEN begin
writeln;
writeln( 'Uklad jest oznaczony :');
x:=wx/w;
y:=wy/w;
writeln('x:= ',x:0:2);
writeln('y:= ',y:0:2);
end;
if (wx=0) and (wy=0) and (w=0) then writeln('uklad jest nieoznaczony');
if(w=0) and ((wy=0) or (wx=0)) then writeln('uklad jest sprzeczny');
readln;
end;
IF c='2' THEN Begin
clrscr;
writeln('rownanie liniowe postac := ax+/-b=c');
write('podaj a : ');
readln(a);
write('podaj b : ');
readln(b);
write('podaj c : ');
readln(l);
if a<>0 then begin
writeln('Uklad jest oznaczony');
x:=(l-b)/a;
write('x:= ',x:0:2);
end;
if (a=0) and (b=0) then begin
writeln('Rowananie tozsammosciowe');
writeln('Rozwiazaniem rowanania jest kazda liczba ');
end;
if (a=0) and (b<>0) then begin
writeln('Rownnie sprzeczne ');
writeln('Brak rozwiazan');
end;
end;
if c='3' Then Begin
writeln('Rownanie kwadratowe , postac ax^2 + bx +c =0');
write('podaj a : ');
readln(a1);
write('podaj b: ');
readln(b1);
write('podaj c: ');
readln(c1);
delta:=(b1*b1)-(4*a1*c1);
pdelta:=pierwiastkowaniek(delta);
if delta>0 then begin
c2:=(-b1+pdelta)/(2*a1);
b2:=(-b1-pdelta)/(2*a1);
writeln('Delta > 0 wiec rownanie ma dwa pierwiastki ');
writeln('x1:= ', c2:0:2);
writeln('x2:= ', b2:0:2);
end;
if delta = 0 then begin
writeln('Delta = 0 wiec rownanie ma jeden pierwiastek ' );
c2:=-b1/(2*a1);
writeln('x0:= ',c2:0:2);
end;
if delta<0 then begin
writeln('Delta jest mniejsza zero , rownanie nie ma zadnego pierwiastka');
end;
readln;
end;
end;
clrscr;
writeln('czy chcesz jeszcze raz? T/N');
o:=readkey;
REPEAT
IF (o<>'t') AND (o<>'n') THEN Begin
writeln('Tylko T lub N');
o:=readkey;
end;
UNTIL (o='t') OR (o='n');
UNTIL o='n';
end.
Grafika:
uses crt;
VAR mx,my,mklik:integer;
procedure pokazmysz; assembler;
asm
mov ax, 0001h
int 33h
end;
procedure ukryjmysz; assembler;
asm
mov ax, 0002h
int 33h
end;
procedure wezmysz(var x,y,butt:integer);
var temp1,temp2,temp3:word;
begin
asm
mov ax, 0003h
int 33h
mov temp1, bx
mov temp2, cx
mov temp3, dx
end;
butt:=temp1;
x:=temp2;
y:=temp3;
end;
procedure curoff; assembler;
asm
mov ah,01h
mov ch,10h
mov cl,00h
int 10h
end;
procedure curon; assembler;
asm
mov ah,01h
mov ch,07h
mov cl,07h
int 10h
end;
procedure graf(x1,y1,x2,y2,kol1,kol2:byte;napis:string);
begin
window(x1,y1,x2,y2);
textattr:=16*kol1+kol2;
clrscr;
writeln;
writeln(napis);
end;
procedure SetCharAttr(x,y:byte; znak:char; kolor,tlo:byte);
begin
gotoxy(x,y);
mem[$B800:160*(y-1)+2*(x-1)]:=ord(znak);
mem[$B800:160*(y-1)+2*(x-1)+1]:=kolor+16*tlo;
end;
procedure graf2(xx1,yy1,xx2,yy2,col1,col2:byte);
begin
window(xx1,yy1,xx2,yy2);
textattr:=16*col1+col2;
write;
clrscr;
end;
begin
clrscr;
textmode(c80);
window(1,1,80,25);
textattr:=16*black+white;
write(' KALKULATOR ');
writeln;writeln;
begin
repeat
graf(15,5,65,24,8,0,'');
graf(17,6,63,7,15,0,'');
graf(18,9,22,11,1,14,' 7 ');
graf(18,13,22,15,1,14,' 4 ');
graf(18,17,22,19,1,14,' 1 ');
graf(18,21,22,23,1,14,' 0 ');
graf(26,9,30,11,1,14,' 8 ');
graf(26,13,30,15,1,14,' 5 ');
graf(26,17,30,19,1,14,' 2 ');
graf(26,21,30,23,1,14,' . ');
graf(34,9,38,11,1,14,' 9 ');
graf(34,13,38,15,1,14,' 6 ');
graf(34,17,38,19,1,14,' 3 ');
graf(34,21,38,23,5,0,' = ');
graf(42,9,46,11,5,0,' DEL');
graf(42,13,46,15,5,0,' - ');
graf(42,17,46,23,5,0, ' +');
graf(50,9,54,11,5,0,' C ');
graf(50,13,54,15,5,0,' * ');
graf(50,17,54,19,5,0,' % ');
graf(58,9,63,11,5,0,' sqrt');
graf(58,13,62,15,5,0,' /');
graf(58,17,62,19,5,0,' pot');
graf(48,21,63,23,4,15,' Zaawansowane>>');
graf(66,7,67,9,7,0,'');
SetCharAttr(67,7,'b',1,7);
SetCharAttr(67,8,'i',1,7);
SetCharAttr(67,9,'n',1,7);
graf(66,11,67,13,7,0,'');
SetCharAttr(67,11,'o',1,7);
SetCharAttr(67,12,'k',1,7);
SetCharAttr(67,13,'t',1,7);
graf(66,15,67,17,7,0,'');
SetCharAttr(67,15,'h',1,7);
SetCharAttr(67,16,'e',1,7);
SetCharAttr(67,17,'x',1,7);
graf2(17,6,63,7,15,0);
repeat
pokazmysz;
wezmysz(mx,my,mklik);
if (mx>=328) and (mx<=360) and (my>=128) and (my<=176) and (mklik=1) then write('+');
if (mx>=264) and (mx<=296) and (my>=160) and (my<=176) and (mklik=1) then write('=');
if (mx>=136) and (mx<=168) and (my>=160) and (my<=176) and (mklik=1) then write('0');
if (mx>=136) and (mx<=168) and (my>=128) and (my<=148) and (mklik=1) then write('1');
if (mx>=200) and (mx<=232) and (my>=128) and (my<=148) and (mklik=1) then write('2');
if (mx>=264) and (mx<=296) and (my>=128) and (my<=148) and (mklik=1) then write('3');
if (mx>=136) and (mx<=168) and (my>=96) and (my<=112) and (mklik=1) then write('4');
if (mx>=200) and (mx<=232) and (my>=96) and (my<=112) and (mklik=1) then write('5');
if (mx>=264) and (mx<=296) and (my>=96) and (my<=112) and (mklik=1) then write('6');
if (mx>=136) and (mx<=168) and (my>=64) and (my<=80) and (mklik=1) then write('7');
if (mx>=200) and (mx<=232) and (my>=64) and (my<=80) and (mklik=1) then write('8');
if (mx>=264) and (mx<=296) and (my>=64) and (my<=80) and (mklik=1) then write('9');
if (mx>=328) and (mx<=360) and (my>=64) and (my<=80) and (mklik=1) then write('DEL');
if (mx>=392) and (mx<=424) and (my>=64) and (my<=80) and (mklik=1) then write('C');
if (mx>=392) and (mx<=424) and (my>=96) and (my<=112) and (mklik=1) then write('*');
if (mx>=392) and (mx<=424) and (my>=128) and (my<=148) and (mklik=1) then write('%');
if (mx>=456) and (mx<=496) and (my>=64) and (my<=80) and (mklik=1) then write('sqrt');
if (mx>=456) and (mx<=488) and (my>=96) and (my<=112) and (mklik=1) then write('/');
if (mx>=456) and (mx<=488) and (my>=128) and (my<=144) and (mklik=1) then write('pot');
if (mx>=376) and (mx<=496) and (my>=160) and (my<=176) and (mklik=1) then write('Zaawansowane>>');
if (mx>=328) and (mx<=360) and (my>=96) and (my<=112) and (mklik=1) then write('-');
if (mx>=200) and (mx<=232) and (my>=160) and (my<=176) and (mklik=1) then write('.');
if (mx>=520) and (mx<=528) and (my>=40) and (my<=64) and (mklik=1) then write('bin');
if (mx>=520) and (mx<=528) and (my>=80) and (my<=96) and (mklik=1) then write('okt');
if (mx>=520) and (mx<=528) and (my>=112) and (my<=128) and (mklik=1) then write('hex');
delay(66);
until mklik=2;
until mklik=2 ;
end;
end.
