Ciągi różne

Program ciong(input,output);
uses crt;
var a,b,g,h,i,j,k,l,n,nm,o,p,s,t,u,z,st,su,sz,tu,w:longint;
ax,ay,axv,ayv,a1,a1b,r,ah,je,dw,tr,zm:real;
c,d,e,f:char;

procedure wczyt1;
begin
write('Podaj a1 :');
readln(a1);
write('Podaj r :');
readln(r);
write('Podaj dowolny element tego ciagu :');
readln(ah);
end;

procedure wczyt23;
begin
write('Podaj nr pierwszego elementu ciĄgu:');
readln(ax);
write('Podaj jego wartosc :');
readln(axv);
write('Podaj nr innego elementu ciĄgu:');
readln(ay);
write('Podaj jego wartosc :');
readln(ayv);
end;

procedure jeden;
begin
je:=a1+(ah-1)*r;
writeln('Wartosc tego elementu wynosi ',je:2:2);
end;

procedure dwa;
begin
r:=(ayv-axv)/(ay-ax);
a1:=ayv-r*(ay-1);
writeln('A1 wynosi ',a1:2:2);
writeln('R wynosi ',r:2:2);
end;
procedure podary;
begin
write('Podaj warto† pierwszego elementu ciĄgu arytmetycznego: ');
readln(a1);
write('Podaj liczb© elementw ciĄgu arytmetycznego: ');
readln(n);
write('Podaj rnice r ciĄgu arytmetycznego: ');
readln(zm);
end;


procedure liczary;
var s,an:real;

begin
an:=a1+zm*(n-1);
s:=(a1+an)*n/2;
Writeln('Suma ciĄgu arytmetycznego wynosi: ',s:2:2);
Writeln('Ostatni, n-ty element ciĄgu wynosi: ',an:2:2);

end;
procedure wczytajgeo;
begin
clrscr;
write('Podaj warto† pierwszego elementu ciĄgu geometrycznego: ');
readln(a1b);
write('Podaj liczb© elementw ciĄgu geometrycznego: ');
readln(nm);
write('Podaj iloraz q ciĄgu geometrycznego: ');
readln(zm);
end;

function dopotegi( a:real;en:integer):real;
var i:real;
j:integer;

begin
if en=0 then dopotegi:=1
else begin
i:=1;
for j:=1 to en do i:=i*a;
dopotegi:=i;
end;

end;



procedure geometr;
var s,an:real;

begin
if zm=0 then begin
an:=0;
s:=0;
end;
if zm=1
then begin
an:=a1b;
s:=a1b*nm;
end;
if (zm<>0) and (zm<>1) then begin
an:=a1b*(dopotegi(zm,nm-1));
s:=((1-(dopotegi(zm,nm)))/(1-zm))*a1b;
end;

Writeln('Suma ciĄgu geometrycznego wynosi: ',s:2:2);
Writeln('N-ty element ciĄgu wynosi: ',an:2:2);
end;
procedure sprawdz;
var a2,a3:real;

begin
write('Podaj a1: ');
readln(a1);
write('Podaj a2: ');
readln(a2);
write('Podaj a3: ');
readln(a3);

if a2-a1=a3-a2 then Writeln('To jest ciĄg arytmetyczny');
if (a2<>0) and (a3<>0) then
if a2/a1=a3/a2 then Writeln('To jest ciĄg geometryczny');
if (not (a2-a1=a3-a2)) and (a2<>0) and (a1<>0) and (not (a2/a1=a3/a2))
then Writeln('To nie jest ciĄg geometryczny ani arytmetyczny');

end;
begin
clrscr;
repeat
repeat
writeln;writeln;
writeln('Moliwe tryby pracy:');
writeln('1 - zabawa z ciĄgiem arytmetycznym');
writeln('2 - zabawa z ciĄgiem geometrycznym');
writeln('3 - zabawa z innymi ciĄgami');
writeln('4 - rozpoznawanie ciĄgu');
writeln('5 - wyjcie z programu');
writeln;
write('Podaj wybrany tryb pracy : ');
d:=readkey;writeln;writeln;
case d of
'1':begin
clrscr;
for s:=1 to 300 do begin
sound(s);
delay(1);
end;
nosound;
repeat
repeat
writeln;writeln;
writeln('Oto twoje moliwoci:');
writeln('1 - obliczanie wartosci dowolnego elementu ciagu na podstawie a1 i r');
writeln('2 - obliczanie a1 i r na podstawie dwch elementow');
writeln('3 - obliczanie sumy ciĄgu i n-tego elementu ciĄgu');
writeln('4 - cofnij');
writeln;
write('Czym chcesz si© zajmowa†? : ');
c:=readkey;writeln;writeln;
case c of
'1':begin
for t:=1 to 300 do begin
sound(t);
delay(1);
end;
nosound;
clrscr;
wczyt1;
jeden;
end;
'2':begin
for u:=1 to 300 do begin
sound(u);
delay(1);
end;
nosound;
clrscr;
wczyt23;
dwa;
end;
'3':begin
for z:=1 to 300 do begin
sound(z);
delay(1);
end;
nosound;
clrscr;
podary;
liczary;
end;
end;

until (c='1') or (c='2') or (c='3') or (c='4');
for p:=500 downto 1 do begin
sound(p);
delay(1);
end;
nosound;
until c='4';
end;
'2':begin
for st:=1 to 300 do begin
sound(st);
delay(1);
end;
nosound;
clrscr;
repeat
repeat
writeln;writeln;
writeln('Oto twoje moliwoci;');
writeln('1 - obliczanie sumy ciĄgu i n-tego elementu ciĄgu');
writeln('2 - cofnij');
writeln;
writeln('Czym chcesz si© zajĄ†?');
e:=readkey;
writeln;writeln;
case e of
'1':begin
for su:=1 to 300 do begin
sound(su);
delay(1);
end;
nosound;
clrscr;
wczytajgeo;
geometr;
end;
end;
until (e='1') or (e='2');
for w:=500 downto 1 do begin
sound(w);
delay(1);
end;
nosound;
until e='2';
end;
'3':begin
clrscr;
for a:=1 to 1000 do begin
sound(a);
delay(1);
end;
nosound;
writeln('Przepraszam!');
writeln('Dzia w przygotowaniu...');
writeln(' _ Z okazji —wiĄt Wielkanocnych');
writeln(' /:::\ yczenia zdrowia,');
writeln(' |^***^| wypenienia pragnie');
writeln(' |}XXX{| i wszystkiego co najlepsze');
writeln(' \:::/ przesya Wszystkim');
writeln(' - autor programu.');
writeln('Zapraszam innym razem.');
writeln('Miego dnia!');
delay(1000);
for b:=1000 downto 1 do begin
sound(b);
delay(1);
end;
nosound;
end;
'4':begin
for sz:=1 to 300 do begin
sound(sz);
delay(1);
end;
nosound;
clrscr;
repeat
repeat
writeln;writeln;
writeln('Oto twoje moliwoci;');
writeln('1 - rozpoznanie ciĄgu na podstawie trzech elementw');
writeln('2 - cofnij');
writeln;
writeln('Czym chcesz si© zajĄ†?');
f:=readkey;
writeln;writeln;
case f of
'1':begin
for tu:=1 to 300 do begin
sound(tu);
delay(1);
end;
nosound;
clrscr;
sprawdz;
end;
end;
until (f='1') or (f='2');
for o:=500 downto 1 do begin
sound(o);
delay(1);
end;
nosound;
until f='2';
end;
end;


until (d='1') or (d='2') or (d='3') or (d='4') or (d='5');
until d='5';
clrscr;
for g:=700 downto 1 do begin
sound(g);
delay(1);
end;
nosound;
for h:=700 downto 1 do begin
sound(h);
delay(1);
end;
nosound;
for k:=1 to 700 do begin
sound(k);
delay(1);
end;
nosound;
for l:=3000 downto 1 do begin
sound(l);
delay(1);
end;
nosound;
writeln('Dzi©kuj© za sp©dzenie tak cennego czasu razem z tym programem.');
writeln;writeln;writeln;writeln;writeln;writeln;writeln;writeln;
writeln(' J W ');
writeln(' O A ');
writeln(' H L ');
writeln(' N K ');
writeln(' Y E ');
writeln(' R ');
writeln;writeln;writeln;writeln;writeln;writeln;writeln;writeln;
writeln('Do zobaczenia innym razem.');
delay(3000);
end.