Program Godine;
uses crt;
var brojac2,brojac1,suma,godina,i:integer;
prestupna:boolean;
function zbroji(i:integer):integer;
var s,znamenka:integer;
begin
s:=0;
repeat
znamenka:=i mod 10;
s:=s+znamenka;
i:= i div 10;
until i=0;
zbroji:=s;
end;
begin { G L A V N I }
clrscr;
write('Od koje godine da poènem?: ');
readln(godina);
brojac1:=0;
brojac2:=0;
for i:=godina to 1999 do
begin
prestupna:=false;
if (i mod 4=0) and (i mod 100<>0) or (i mod 400=0) then
begin
prestupna:=true;
brojac1:=brojac1+1;
suma:=zbroji(i);
if odd(suma) then brojac2:=brojac2+1;
end;
end;
writeln('Broj prestupnih godina ',brojac1:5);
writeln('Brojac neparnih prestupnih godina',brojac2:5);
readln;
end.
program niz;
const kraj=0;
var broj1,broj2,dug,maxdug:integer;
raste:boolean;
begin
dug:=0;
maxdug:=0;
raste:=true;
broj1:=0;
write('Upisi broj: '); readln(broj2);
while (broj2<>kraj) do
begin
raste:=broj1<=broj2;
if raste then
dug:=dug+1
else
begin
raste:=false;
if dug>maxdug then maxdug:=dug;
dug:=1;
end;
broj1:=broj2;
write('Upisi broj: '); readln(broj2);
end;
if dug>maxdug then maxdug:=dug;
writeln('Najduži neopadajuæi niz je imao ',maxdug:4,' elemenata');
readln;
end.
Program memo_igra;
uses crt;
type niz=array [1..10] of integer;
var niz1,niz2:niz; st,crni, bijeli: integer;
procedure memo( var c,b:integer; n1,n2:niz );
var i,j: integer;
seNe1,seNe2:array [1..10]of boolean;
begin
c:=0; b:=0;
for i:= 1 to 6 do
begin
seNe1[i]:=true;
seNe2[i]:=true;
end;
for i:= 1 to 6 do
if n1[i]=n2[i] then begin
c:=c+1;
seNe1[i]:=false;
seNe2[i]:=false;
end;
for i:=1 to 6 do
for j:= 1 to 6 do
if seNe1[i] and seNe2[j] and (n1[i]=n2[j]) then
begin
b:=b+1;
seNe1[i]:=false;
seNe2[j]:=false;
end;
end;
begin { G L A V N I }
clrscr;
writeln('Prvi niz ');
for st:=1 to 6 do read( niz1[st]);
writeln('Drugi niz ');
for st:=1 to 6 do read( niz2[st]);
memo (crni,bijeli,niz1,niz2);
writeln('crni: ', crni:5,' bijeli: ',bijeli:5);
readkey;
end.
program zamjena;
uses crt;
type skup=set of char;
var i,b,g,z,tr,j:integer;
r1,pom,a,a1:string;
c,zadsug:char;
samoglas,suglas:skup;
mat:array[1..50] of char;
mat1:array[1..10] of string;
procedure zamjeni2(var a,a1:string);
begin
pom:=a;
a:=a1;
a1:=pom;
end;
procedure bubble; {
sortiranje reèenica}
begin
for i:=1 to z-1 do
for j:=1 to z-1 do
if mat1[j]>mat1[j+1] then begin
zamjeni2(mat1[j],mat1[j+1]);
end;
end;
begin { G L A V N I }
clrscr;
textcolor(14);
write('Upiçi reŸenicu: ');
i:=0;
samoglas:=['a','e','i','o','u'];
suglas:=['a'..'z']-samoglas;
repeat
i:=i+1;
c:=readkey;{Ÿitanje tipke}
write(c);
mat[i]:=c;
if mat[i] in suglas then zadsug:=mat[i];
until ord(c)=13;
writeln;
for b:=1 to i do {ispitivanje i zamjena samoglasnika}
begin
if mat[1] in samoglas then mat[1]:=Upcase(zadsug);
if (mat[b]=' ') then
begin
if (mat[b+1]) in samoglas then mat[b+1]:=upcase (zadsug);
end;
case mat[b] of
'a','e','i','o','u':mat[b]:=Upcase(mat[b-1]);
end;
end;
textcolor(green);
WRITELN;
writeln('ISPIS ZAMJENE SAMOGLASNIKA:');
for b:=1 to i do {ispis zamjenjenih slova}
begin
write(mat[b]);
end;
mat[i]:=' ';{oznaka kraja upisa}
mat[i+1]:=' ';
b:=0;
repeat {pronalaženje rijeæi i pretvaranje u stringove}
z:=z+1;
if mat[b]=' ' then b:=b+1;
while mat[b]<>' ' do
begin
if tr<>1 then b:=b+1;
tr:=0;
mat1[z]:=concat(mat1[z],mat[b]);
end;
writeln;
tr:=1;
until (mat[b]=' ') and (mat[b+1]=' ');
textcolor(blue);
writeln('ISPIS NESORTIRAN:');
for b:=1 to z do
begin
writeln(mat1[b]);
end;
textcolor(red);
writeln;
writeln('ISPIS SORTIRAN:');
bubble;
for b:=1 to z do
begin
writeln(mat1[b]);
end;
readln;
end.