A feladatok megoldásai

1.

BEGIN
 Writeln(sqr(sqrt(22)));
 Writeln('33*77=',33*77);
 Writeln('2+2=',2+2,', 4+4=',4+4,', 8+8=', 8+8);
 Writeln(2*(3*4+3*5+4*5));
 Writeln(sqrt(sqr(5)+sqr(11)):0:2);
 Writeln('Writeln(''Szia!'');');
 Writeln('1/50=',1/50:4:2);
 Writeln('Nyomj ENTER-t!'); Readln;
END.

2.

VAR a,b:real;
BEGIN
 Write('Egyik befogó: '); Readln(a);
 Write('Másik befogó: '); Readln(b);
 Writeln('Az átfogó: ',sqrt(sqr(a)+sqr(b)):0:2);
 Writeln('Nyomj ENTER-t!'); Readln;
END. 

3.

VAR a,b,c:real;
BEGIN Write(' Egyik oldal: '); Readln(a);
 Write(' Másik oldal: '); Readln(b);
 Write('Harmadik oldal: '); Readln(c);
 Writeln('A felszín: ',2*(a*b+a*c+b*c):0:2);
 Writeln('A térfogat: ',a*b*c:0:2);
 Writeln('Nyomj ENTER-t!'); Readln;
END.

4.

 VAR s:string;
BEGIN
 Write('Hogy hívnak? '); Readln(s);
 Writeln('Üdvözöllek, kedves '+s+'!');
 Writeln('Nyomj ENTER-t!'); Readln;
END.

5.

VAR a,b,c:integer;
BEGIN
 Write('Adj meg 3 számot!'); Readln(a,b,c);
 Writeln((b>a) and (b>c));
 Writeln('Nyomj ENTER-t!'); Readln;
END.

6.

VAR s,t:real;
BEGIN
 Write('Add meg az utat (m) és az időt (s): '); Readln(s,t);
 If (s<0) or (t<=0) then writeln('Értelmetlen adatok!')
 else writeln('Az átlagsebesség: ',s/t:0:2,' m/s');
 Writeln('Nyomj ENTER-t!'); Readln;
END.

7.

VAR a:integer;
BEGIN
 Write('Adj meg egy egész számot: '); Readln(a);
 If a mod 2 = 0 then writeln('Páros.')
 else writeln('Páratlan.');
 Writeln('Nyomj ENTER-t!'); Readln;
END.

8.

VAR a:integer;
BEGIN
 Write('Adj meg egy egész számot: '); Readln(a);
 If a > 0 then writeln('Pozitív.')
 else If a=0 then writeln('Nulla.')
      else writeln('Negatív.');
 Writeln('Nyomj ENTER-t!'); Readln;
END.

9.

VAR a,b,c:integer;
BEGIN
 Write('Adj meg három egész számot: '); Readln(a,b,c);
 If (a=b) and (b=c) then writeln('3 egyforma.')
 else if (a=b) or (a=c) or (b=c) then writeln('2 egyforma.')
      else writeln('Nincs egyforma.');
 Writeln('Nyomj ENTER-t!'); Readln;
END.

10.

VAR a:integer;
BEGIN
 a:=0;
 While a<=100 do begin
   writeln(a);
   a:=a+5;
 End;
 Writeln('Nyomj ENTER-t!'); Readln;
END.

11.

VAR a:integer;
BEGIN
 a:=0;
 Repeat
   writeln(a);
   a:=a+5;
 Until a>100;
 Writeln('Nyomj ENTER-t!'); Readln;
END.

12.

 VAR a:integer;
    s:string;
BEGIN
 Repeat
   Writeln('Írj be egy számot!'); Readln(a);
   Writeln(a+1,'! Nyertem! Még egy játék?'); Readln(s);
 Until s='nem';
 Writeln('Kösz a játékot!');
 Writeln('Nyomj ENTER-t!'); Readln;
END.

13.

VAR a,s:integer;
BEGIN
 s:=0;
 For a:=1 to 100 do
   s:=s+a;
 Writeln(s);
 Writeln('Nyomj ENTER-t!'); Readln;
END.

14.

VAR a:integer;
    s:real;
BEGIN
 s:=0;
 a:=7;
 While a<=1000 do begin
   s:=s+a;
   a:=a+7;
 End;
 Writeln(s:0:0);
 Writeln('Nyomj ENTER-t!'); Readln;
END.

//másik megoldás a ciklusra:
For a:=1 to 1000 do
  if a mod 7=0 then s:=s+a;

15.

VAR i:integer;
    p:real;
BEGIN
 p:=1;
 For i:=1 to 113 do
   p:=p*1.13;
 Writeln(p:0:3);
 Writeln('Nyomj ENTER-t!'); Readln;
END.

16.

VAR a:integer;
BEGIN
 for a:=1 to 1000 do
   if (a mod 7 = 0) and (a mod 2 > 0) then write(a:5);
 Writeln;
 Write('Nyomj ENTER-t!'); Readln;
END.

17.

VAR a:integer;
BEGIN
 For a:=1 to 10 do
   writeln(a,'*5=',a*5);
 Write('Nyomj ENTER-t!'); Readln;
END.

18.

VAR a,b:integer;
BEGIN
 For a:=1 to 10 do begin
   For b:=1 to 10 do write(a,'*',b,'=',a*b,' ');
   Writeln;
 End;
 Write('Nyomj ENTER-t!'); Readln;
END.

19.

VAR t:array[1..10] of integer;
    i,c:integer;
BEGIN
 for i:=1 to 10 do t[i]:=random(6)+1;
 c:=0;
 for i:=1 to 10 do if t[i] mod 2 = 0 then c:=c+1;
 writeln(c,' páros szám volt.');
 write('Nyomj entert!'); readln;
END.

20.

VAR t:array[1..10] of integer;
    i,c:integer;
BEGIN
 for i:=1 to 10 do t[i]:=random(6)+1;
 c:=0;
 for i:=1 to 10 do if t[i] mod 2 = 0 then c:=c+t[i];
 writeln('A páros számok összege: ',c);
 write('Nyomj enter!');
 readln;
END.

21.

VAR t:array[1..10] of integer;
    i:integer;
BEGIN
 for i:=1 to 10 do t[i]:=random(6)+1;
 for i:=1 to 10 do if t[i] mod 2 = 0 then writeln(t[i]);
 write('Nyomj enter!');
 readln;
END.

22.

VAR t:array[1..10] of integer;
    i,c:integer;
BEGIN
 for i:=1 to 10 do t[i]:=random(6)+1;
 c:=0;
 for i:=1 to 9 do if t[i]=t[i+1] then c:=c+1;
 writeln('Ismétlések száma: ',c);
 write('Nyomj enter!'); readln;
END.

23.

VAR nev:array[1..10] of string;
    kor:array[1..10] of integer;
    i,db:integer;
    s:string;
BEGIN
 db:=0;
 repeat
   write(db+1,'. ember neve, *=kilépés: '); readln(s);
   if s<>'*' then begin
     db:=db+1;
     nev[db]:=s;
     write(db,'. ember kora: '); readln(kor[db])
   end;
 until (s='*') or (db=10);
 writeln;
 writeln('10 évnél fiatalabbak:');
 for i:=1 to db do if kor[i]<10 then writeln(nev[i]);
 write('Nyomj enter!'); readln;
END.

24.

VAR t:array [1..5,1..10] of integer;
    i,j,p:integer;
BEGIN
 for i:=1 to 5 do
   for j:=1 to 10 do
     t[i,j]:=random(9);
 p:=0;
 for i:=1 to 5 do
   for j:=1 to 10 do
     if t[i,j] mod 2=0 then p:=p+1;
 if p>25 then writeln('Párosból volt több.')
 else if p=25 then writeln('Ugyanannyi páros és páratlan volt.')
 else writeln('Több páratlan volt.');
 write('Nyomj enter!');
 readln;
END.

25.

 VAR t:array [1..5,1..10] of integer;
    i,j,s:integer;
BEGIN
 for i:=1 to 5 do
   for j:=1 to 10 do
     t[i,j]:=random(9);
 for j:=1 to 10 do begin
   s:=0;
   for i:=1 to 5 do s:=s+t[i,j];
   writeln(j:2,'. sorösszeg=',s);
 end;
 write('Nyomj entert!'); readln;
END.

26.

VAR t:array[1..5,1..10] of integer;
    i,j:integer;
BEGIN
 for i:=1 to 5 do
   for j:=1 to 10 do
     if (i=1) or (i=5) or (j=1) or (j=10)
     then t[i,j]:=1
     else t[i,j]:=0;
END.

27.

VAR t:array[1..15] of integer;
    i:integer;
BEGIN
 t[1]:=1;
 t[2]:=1;
 t[3]:=2;
 for i:=4 to 15 do t[i]:=t[i-1]+t[i-2]+t[i-3];
 for i:=1 to 15 do writeln(t[i]);
 write('Nyomj enter!'); readln;
END.

28.

VAR f,g:array[1..10] of integer;
    i,db:integer;
BEGIN
 for i:=1 to 10 do f[i]:=random(10);
 db:=0;
 for i:=1 to 10 do
   if f[i]>5 then begin
     db:=db+1;
     g[db]:=f[i];
   end;
END.

29.

VAR t:array[1..10] of integer;
    i,m:integer;
BEGIN
 for i:=1 to 10 do t[i]:=random(10);
 for i:=1 to 5 do begin
   m:=t[i];
   t[i]:=t[11-i];
   t[11-i]:=m;
 end;
END.

30.

Function max(a,b:integer):integer;
  Begin
    if a>b then max:=a
    else max:=b;
  End; 

31.

Procedure ism(c:char;n:integer);
  Var i:integer;
  Begin
    for i:=1 to n do write(c);
  End; 

32.

Function ism(c:char;n:integer):string;
  Var s:string;
      i:integer;
  Begin
    s:='';
    for i:=1 to n do s:=s+c;
    ism:=s;
  End;

33.

Procedure parit(var x:integer);
  Begin
    if x mod 2=1 then x:=x+1;
  End;  

34.

Var c,i:integer;
    s:string;

BEGIN
  write('Írj be valamit: '); readln(s);
  c:=0;
  for i:=1 to length(s) do
    if s[i]='e' then c:=c+1;
  writeln(c,' db. e betű volt.');
  write('nyomj entert'); readln;
END. 

35.

Var i:integer;
    A,B:string;

BEGIN
  A:='próbaszöveg';
  B:='';
  for i:=length(A) downto 1 do
    B:=B+A[i];
END.   

36.

Var i:integer;
    s:string;

BEGIN
  write('Írj be valamit: '); readln(s);
  for i:=1 to length(s) do
    if s[i]=' ' then writeln
    else write(s[i]);
  writeln;
  write('nyomj entert'); readln;
END.              

37.

Var s:string;

BEGIN
  write('Írj be valamit: '); readln(s);
  //minden dupla szóközből egyet törlünk
  while pos('  ',s)>0 do
    delete(s,pos('  ',s),1);
  writeln(s);
  write('nyomj entert'); readln;
END.

38.

Function mgh(c:char):boolean;
  var m:string;
  begin
    m:='öüóeuioőúaéáűíÖÜÓEUIOŐÚAÉÁŰÍ';
    mgh:=(pos(c,m)>0);
  end;

Var s:string;
    i:integer;

BEGIN
  write('Írj be valamit: '); readln(s);
  for i:=1 to length(s) do
    if not mgh(s[i]) then write(s[i]);
  writeln;
  write('nyomj entert'); readln;
END.

39.

Function mgh(c:char):boolean;
  var m:string;
  begin
    m:='öüóeuioőúaéáűíÖÜÓEUIOŐÚAÉÁŰÍ';
    mgh:=(pos(c,m)>0);
  end;

Var s:string;
    i:integer;

BEGIN
  write('Írj be valamit: '); readln(s);
  for i:=1 to length(s) do begin
    write(s[i]);
    if mgh(s[i]) then write('v',s[i]);
  end;
  writeln;
  write('nyomj entert'); readln;
END.  

40.

 Function jtoly(s:string):string;
  var x:string;
      i:integer;
  begin
    x:='';
    for i:=1 to length(s) do
      if s[i]='j' then x:=x+'ly'
      else x:=x+s[i];
    jtoly:=x;
  end;

BEGIN
  writeln(jtoly('jó jégpálya'));
  write('nyomj entert'); readln;
END. 

41.

VAR f:text;
    c:integer;
BEGIN
  c:=0;
  assignfile(f,'feladat1.txt');
  reset(f);
  while not eof(f) do begin
    readln(f); //megspóroltunk egy változót, de lehetett volna readln(f,s) is
    c:=c+1;
  end;
  closefile(f);
  writeln(c);
  write('enter:'); readln;
END.

42.

VAR f:text;
    c,i:integer;
    s:string;
BEGIN
  c:=0;
  assignfile(f,'feladat1.txt');
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    for i:=1 to length(s) do
      if (s[i]='e') or (s[i]='E') then c:=c+1;
  end;
  closefile(f);
  writeln(c);
  write('enter:'); readln;
END.

43.

VAR f,g:text;
    s:string;
    c:integer;
BEGIN
  assignfile(f,'feladat1.txt');
  assignfile(g,'megoldas.txt');
  reset(f);
  rewrite(g);
  c:=0;
  while not eof(f) do begin
    readln(f,s);
    c:=c+1;
    writeln(g,c,': ',length(s));
  end;
  closefile(g);
  closefile(f);
END.

44.

VAR f:text;
    i,db:integer;
    t:array[1..100] of integer;
BEGIN
  assignfile(f,'feladat2.txt');
  reset(f);
  db:=0;
  while not eof(f) do begin
    db:=db+1;
    readln(f,t[db]);
  end;
  closefile(f);
  for i:=db downto 1 do
    writeln(t[i]);
  write('enter:'); readln;
END.

45.

VAR f:text;
    db,i,a,b,s:integer;
BEGIN
  assignfile(f,'feladat3.txt');
  reset(f);
  readln(f,db);
  s:=0;
  for i:=1 to db do begin
    readln(f,a,b);
    s:=s+a*b;
  end;
  closefile(f);
  writeln(s);
  write('enter:'); readln;
END. 

46.

USES Strutils;
VAR s:string;
    f:text;
BEGIN
  assignfile(f,'feladat4.txt');
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    writeln(extractword(2,s,[' ']),', ',extractword(1,s,[' ']));
  end;
  closefile(f);
  readln;
END.

47.

USES Strutils,Sysutils;
VAR s:string;
    f:text;
BEGIN
  decimalseparator:='.';
  assignfile(f,'feladat5.txt');
  reset(f);
  while not eof(f) do begin
    readln(f,s);
    write(extractword(1,s,[' ',':']),': ');
    writeln(strtofloat(extractword(2,s,[' ',':']))*3.6:0:2);
  end;
  closefile(f);
  readln;
END.

48.

USES Sysutils,Strutils;
VAR f:text;
    i,db,min:integer;
    s:string;
    szin:array[1..100] of string;
    vidam:array[1..100] of integer;
BEGIN
  assign(f,'feladat6.txt');
  reset(f);
  db:=0;
  while not eof(f) do begin
    readln(f,s);
    db:=db+1;
    szin[db]:=extractword(1,s,[' ']);
    vidam[db]:=strtoint(extractword(2,s,[' ']));
  end;
  close(f);
  min:=1;
  for i:=2 to db do if vidam[i]<vidam[min] then min:=i;
  for i:=1 to db do if vidam[i]=vidam[min] then writeln(szin[i]);
  readln;
END. 

49.

USES Sysutils,Strutils;
VAR f:text;
    i,db:integer;
    s:string;
    szin:array[1..100] of string;
    vidam:array[1..100] of integer;
BEGIN
  assign(f,'feladat6.txt');
  reset(f);
  db:=0;
  while not eof(f) do begin
    readln(f,s);
    db:=db+1;
    szin[db]:=extractword(1,s,[' ']);
    vidam[db]:=strtoint(extractword(2,s,[' ']));
  end;
  close(f);
  i:=1;
  while (i<=db) and (vidam[i]<>3) do i:=i+1;
  if i<=db then writeln(szin[i])
  else writeln('nincs ilyen');
  readln;
END.  

50.

USES Sysutils,Strutils;
VAR f:text;
    i,j,db,min:integer;
    s:string;
    szin:array[1..100] of string;
    vidam:array[1..100] of integer;
    mv:integer;
    ms:string;
BEGIN
  assign(f,'feladat6.txt');
  reset(f);
  db:=0;
  while not eof(f) do begin
    readln(f,s);
    db:=db+1;
    szin[db]:=extractword(1,s,[' ']);
    vidam[db]:=strtoint(extractword(2,s,[' ']));
  end;
  close(f);
  for i:=1 to db-1 do begin
    min:=i;
    for j:=i+1 to db do if szin[j]<szin[min] then min:=j;
    mv:=vidam[i]; vidam[i]:=vidam[min]; vidam[min]:=mv;
    ms:=szin[i]; szin[i]:=szin[min]; szin[min]:=ms;
  end;
  for i:=1 to db do writeln(szin[i],' ',vidam[i]);
  readln;
END.   

51.

USES Sysutils,Strutils;
VAR f:text;
    i,j,db,min,max,x:integer;
    nap,fuvar,hossz:array[1..280] of integer;
    napifuvar,napihossz:array[1..7] of integer;

Function utdij(hossz:integer):integer;
 begin
  if hossz<3 then utdij:=500
  else if hossz<6 then utdij:=700
  else if hossz<11 then utdij:=900
  else if hossz<21 then utdij:=1400
  else utdij:=2000;
 end;

BEGIN
  // beolvasás
  assignfile(f,'tavok.txt');
  reset(f);
  db:=0;
  while not eof(f) do begin
    db:=db+1;
    readln(f,nap[db],fuvar[db],hossz[db]);
  end;
  closefile(f);
  
  // rendezés
  for i:=1 to db-1 do begin
    min:=i;
    for j:=i+1 to db do
      if (nap[j]<nap[min]) or ((nap[j]=nap[min]) and (fuvar[j]<fuvar[min]))
      then min:=j;
    x:=nap[min]; nap[min]:=nap[i]; nap[i]:=x;
    x:=fuvar[min]; fuvar[min]:=fuvar[i]; fuvar[i]:=x;
    x:=hossz[min]; hossz[min]:=hossz[i]; hossz[i]:=x;
  end;
  
  // fuvarszámlálás
  for i:=1 to 7 do napifuvar[i]:=0;
  for i:=1 to db do napifuvar[nap[i]]:=napifuvar[nap[i]]+1;
  for i:=1 to 7 do napihossz[i]:=0;
  for i:=1 to db do napihossz[nap[i]]:=napihossz[nap[i]]+hossz[i];
  
  //megoldás
  writeln('2. feladat: ',hossz[1],' km');
  
  writeln('3. feladat: ',hossz[db],' km');
  
  write('4. feladat:');
  for i:=1 to 7 do if napifuvar[i]=0 then write(i:2);
  writeln;
  max:=1;
  for i:=2 to 7 do if napifuvar[i]>napifuvar[max] then max:=i;
  
  writeln('5. feladat: ',i);
  
  write('6. feladat: adjon meg egy távot! ');
  readln(x);
  writeln(' Ehhez tartozó útdíj: ',utdij(x),' Ft');
  
  writeln('7. feladat:');
  for i:=1 to 7 do writeln(' ',i,'. nap: ',napihossz[i],' km');
  assignfile(f,'dijazas.txt');
  rewrite(f);
  for i:=1 to db do
    writeln(f,nap[i],'. nap ',fuvar[i],'. út: ',utdij(hossz[i]),' Ft');
  closefile(f);
  
  x:=0;
  for i:=1 to db do x:=x+utdij(hossz[i]);
  writeln('9. feladat: ',x,' Ft');
  write('enter: ');
  readln;
END.

52.

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Caption:=inttostr(strtoint(Button1.Caption)+1);
end;

53.

procedure TForm1.Button1Click(Sender: TObject);
begin
  Button1.Left:=random(Form1.Width-Button1.Width);
  Button1.Top:=random(Form1.Height-Button1.Height);
end;