4 Algorytmy
Uses Crt;

{zadanie 1}
Procedure Zad1;
var A,B,C,D:Real;
Procedure AMAX;Begin writeln('Najwieksza jest liczba I czyli ',A);End;
Procedure BMAX;Begin writeln('Najwieksza jest liczba II czyli ',B);End;
Procedure CMAX;Begin writeln('Najwieksza jest liczba III czyli ',C);End;
Procedure DMAX;Begin writeln('Najwieksza jest liczba IV czyli ',D);End;
Procedure ABMAX;Begin writeln('Najwieksze sa liczby I i II o rownej wartosci ',A);End;
Procedure ACMAX;Begin writeln('Najwieksze sa liczby I i III o rownej wartosci ',A);End;
Procedure ADMAX;Begin writeln('Najwieksze sa liczby I i IV o rownej wartosci ',A);End;
Procedure BCMAX;Begin writeln('Najwieksze sa liczby II i III o rownej wartosci ',B);End;
Procedure BDMAX;Begin writeln('Najwieksze sa liczby II i IV o rownej wartosci ',B);End;
Procedure CDMAX;Begin writeln('Najwieksze sa liczby III i IV o rownej wartosci ',C);End;
Procedure ABCMAX;Begin writeln('Najwieksze sa liczby I,II i III o rownej wartosci ',A);End;
Procedure ACDMAX;Begin writeln('Najwieksze sa liczby I,III i IV o rownej wartosci ',A);End;
Procedure ABDMAX;Begin writeln('Najwieksze sa liczby I,II i IV o rownej wartosci ',A);End;
Procedure BCDMAX;Begin writeln('Najwieksze sa liczby II,III i IV o rownej wartosci ',B);End;

Begin
A:=35.20;B:=26.76;
C:=23.98;D:=42.53;
{tutaj nie wiem czy te liczby ma podac uzytkownik, czy maja byc wprowadzone w kodzie...
jezeli w kodzie to np
------------------
A:=35.20;B:=26.76;
C:=23.98;D:=42.53;
------------------
i wtedy "drukowanie"
-------------------------------------------------------
writeln('Liczby: I=',A,' II=',B,' III=',C,' IV=',D);
-------------------------------------------------------
ale tez prawdopodobne ze chodzilo o wprowadzenie ich w samym programie
------------------------------------------
write('Podaj pierwsza liczbe:');Readln(A);
write('Podaj druga liczbe:');Readln(B);
write('Podaj trzecia liczbe:');Readln(C);
write('Podaj czwarta liczbe:');Readln(D);
------------------------------------------}
if ((A=B)and(B=C)and(C=D)) then writeln('Wszystkie liczby sa rowne!!! (',A,')')
else Begin
if A> B then
Begin
If A> C then
Begin
If A> D then AMax
else if A< D then DMax
else if A=D then ADMax;
end
else if C> A then
Begin
If C> D then CMax
else if C< D then DMax
else if C=D then CDMax;
end
else if A=C then
Begin
If A> D then ACMax
else if A< D then DMax
else if A=D then ACDMax;
end
End
else if B> A then
Begin
If B> C then
Begin
If B> D then BMax
else if B< D then DMax
else if B=D then BDMax;
end
else if C> B then
Begin
If C> D then CMax
else if C< D then DMax
else if C=D then CDMax;
end
else if B=C then
Begin
If B> D then BCMax
else if B< D then DMax
else if B=D then BCDMax;
end
End
else if A=B then
Begin
If B> C then
Begin
If B> D then ABMax
else if B< D then DMax
else if B=D then ABDMax;
end
else if C> B then
Begin
If C> D then CMax
else if C< D then DMax
else if C=D then CDMax;
end
else if B=C then
Begin
If B> D then ABCMax
else if B< D then DMax
end
End
End;
writeln('Wcisnij < Enter> ');
readln; {poczekaj na nacisniecie < Enter> }
End;

{zadanie 2}
Procedure Zad2;
var A,B,C:Real; {nie jest podane jakie to liczby..czy rzeczywiste
czy calkowite wiec bedziemy dzialac na rzeczywistych}
Begin
write('Podaj pierwsza liczbe:');Readln(A);
if A> 0 then writeln('Liczba I (',A,') jest dodatnia')
else if A< 0 then writeln('Liczba I (',A,') jest ujemna')
else if A=0 then writeln('Liczba I (',A,') jest r¢wna 0! znak jest kwestia sporna :)');
write('Podaj druga liczbe:');Readln(B);

if B> 0 then writeln('Liczba II (',B,') jest dodatnia')
else if B< 0 then writeln('Liczba II (',B,') jest ujemna')
else if B=0 then writeln('Liczba II (',B,') jest r¢wna 0! znak jest kwestia sporna :)');
write('Podaj trzecia liczbe:');Readln(C);

if C> 0 then writeln('Liczba III (',C,') jest dodatnia')
else if C< 0 then writeln('Liczba III (',C,') jest ujemna')
else if C=0 then writeln('Liczba III (',C,') jest r¢wna 0! znak jest kwestia sporna :)');
writeln('Nacisnij < Enter> ');
readln;
End;

{zadanie 3}
Procedure Zad3;
Var x1,y1,x2,y2,x3,y3,MAX,L12,L23,L13:Real;
Begin
writeln('Podaj wspolrzedne trzech punktow...');
write('dla punktu A: X=');readln(x1);
write(' Y=');readln(y1);
write('dla punktu B: X=');readln(x2);
write(' Y=');readln(y2);
L12:=sqrt(sqr(x2-x1)+sqr(y2-y1));
write('dla punktu C: X=');readln(x3);
write(' Y=');readln(y3);
L13:=sqrt(sqr(x3-x1)+sqr(y3-y1));
L23:=sqrt(sqr(x2-x3)+sqr(y2-y3));
writeln('Odleglosc Punktu A od punktu B = ',L12);
writeln('Odleglosc Punktu A od punktu C = ',L13);
writeln('Odleglosc Punktu B od punktu C = ',L23);
write('Maxymalna odleglosc dwoch (z podanych) punktow, czyli ');
if L12> L13 then Begin
if L12> L23 then write('A-B to:'+chr(13)+Chr(10),L12)
else if L12< L23 then write('B-C to:'+chr(13)+Chr(10),L23)
else if L12=L23 then write('A-B i B-C to:'+chr(13)+Chr(10),L12)
End else if L12< L13 then Begin
if L13> L23 then write('A-C to:'+chr(13)+Chr(10),L13)
else if L13< L23 then write('B-C to:'+chr(13)+Chr(10),L23)
else if L13=L23 then write('A-C i B-C to:'+chr(13)+Chr(10),L13)
End else if L12=L13 then Begin
if L12> L23 then write('A-B i A-C to:'+chr(13)+Chr(10),L12)
else if L12< L23 then write('B-C to:'+chr(13)+Chr(10),L23)
else if L12=L23 then write('A-B i B-C i A-C to:'+chr(13)+Chr(10),L12)
End;

writeln;writeln('Nacisnij < Enter> ');
readln;
End;

{Zadanie4}
Procedure Zad4;
Var A,B,C,D,Wl,Ml:Integer; {Liczby caˆkowite}
Begin
write('Podaj pierwsza liczbe:');Readln(A);
write('Podaj druga liczbe:');Readln(B);
write('Podaj trzecia liczbe:');Readln(C);
write('Podaj czwarta liczbe:');Readln(D);
Wl:=0;Ml:=0;
If A> 100 then Inc(Wl) else if A< 0 then Inc(Ml);
If B> 100 then Inc(Wl) else if B< 0 then Inc(Ml);
If C> 100 then Inc(Wl) else if C< 0 then Inc(Ml);
If D> 100 then Inc(Wl) else if D< 0 then Inc(Ml);
if Wl> 0 then writeln('Jest ',Wl,' liczb kt¢re s¡ wi©ksze ni¾ 100')
else writeln('Nie ma liczb kt¢re s¡ wi©ksze ni¾ 100');
if Ml> 0 then writeln('Jest ',Ml,' liczb kt¢re s¡ mniejsze ni¾ 0')
else writeln('Nie ma liczb kt¢re s¡ miejsze ni¾ 0');
writeln('Naci˜nij < Enter> ');
readln;
End;



{Ka¿da z procedur powyzszych mozesz spokojnie umiescic jako osobny program
ja dalem ci gratis super-proste menu (dla twojej wiadomosci mozna by nawet
zrobic menu wykorzystujace myszke :) ale po co? o jakies 20 min zabawy wiecej ;) }

Var Start:Boolean;
C:Char;

Begin
TextBackground(Blue);
TextColor(Yellow);
Start:=True;
Repeat
If Start Then
Begin
clrscr;
writeln;
writeln('Wybierz Zadanie:');
writeln('1- Maxymalna wartosc sposrod 4-liczb');
writeln('2- Okreslenie znaku (-/+) 3-liczb');
writeln('3- Okreslenie odleglosci 3 punktow wzgledem siebie i max odleglosc');
writeln('4- Okreslenie ile z 4 podanych liczb jest > 100 lub < 0');
writeln('Esc- Koniec programu');
Start:=False;
End;
C:=Readkey;

if C='1' then
Begin
clrscr;
Zad1;
Start:=True;
end;
if C='2' then
Begin
clrscr;
Zad2;
Start:=True;
end;
if C='3' then
Begin
clrscr;
Zad3;
Start:=True;
end;
if C='4' then
Begin
clrscr;
Zad4;
Start:=True;
end;
Until C=#27;
NormVideo;
Clrscr;
End.