Fejléc

A fenti oldalan adott válaszaim - SimkoL - gyüjteménye



Keressük meg a második legkisebb számot a tömbben, írjuk ki a sorszámát.

program masodik; 
const max = 100; 
var i, n : integer;
min, min1 : byte;
tomb : array[1..max] of byte; 
begin
  Randomize;
  for i := 1 to max do tomb[i] := Random(255) + 1 ; 
  for i := 1 to max do Write(tomb[i]:5);
  min := tomb[1];
  for i := 1 to max do if tomb[i] < min then min := tomb[i];
  min1 := tomb[1];
  for i := 1 to   max do
  if (tomb[i] < min1) and (tomb[i] > min) then
  begin
    min1 := tomb[i];
    n:=i;
  end;
  WriteLn;
  WriteLn('A masodik legkisebb szam : ',min1, '. Sorszama a tombben : ', n); 
end. 

Euler-féle szám sorbafejtése. e1≈ 2,71828…

program exponencialis; 
var i, kitevo, kozel : integer;
expo : real; 
function polinom(const szam, kozelites : integer ) : real;
  function faktor(const szam1 : integer) : real;
  var i: integer;
  begin
    faktor := 1;
    for i := 1 to szam1 do faktor := faktor * i;
    WriteLn('A faktorialis erteke: ', faktor);
  end;
  function hatvany(const szam2, meddig : integer) : real;
  var i : integer;
  begin
    hatvany := 1;
    for i:= 1 to meddig do hatvany := hatvany * szam2;
    WriteLn('A hatvany erteke: ', hatvany);
  end; 
begin
  polinom := hatvany(szam, kozelites) / faktor(kozelites);
  WriteLn('A polinom erteke: ', polinom); 
end; 
begin
  expo := 1;
  Write('Kerem a kitevot: ');
  ReadLn(kitevo);
  Write('Kerem a kozelitest: ');
  ReadLn(kozel);
  for i := 1 to kozel do
  begin
    WriteLn(i,'. lepes');
    expo := expo + polinom(kitevo, i);
    WriteLn('A polinomok halmozott osszege: ', expo);
    ReadLn;
  end;
  Write('Vege ! ');
  ReadLn; 
end. 

Adott egy n sorból és n oszlopból álló kétdimenziós tömb, melynek elemei legtöbb négy számjegyet tartalmazó természetes számok. Írjatok Pascal programot, amely beolvassa a billentyüzetröl az n (2≤n≤23) természetes számot és a tömb n*n elemét, majd kiírja a tömb külsö koncentrikus négyzetén lévö elemeit, szóközzel elválasztva öket egymástól. A kiírást a bal felsö sarokban lévö elemmel kezdjük és az óramutató járásával megegyezö irányba folytatjuk, mint a példában. A tömb külsö koncentrikus négyzetén lévö elemek az elsö és utolsó sor, valamint elsö és utolsó oszlop elemei. Például: n=5 és a mellékelt kétdimenziós tömb esetén

1 2 3 4 5
6 7 8 9 1
2 3 4 5 6
7 8 9 1 2
3 4 5 6 7

a kiírt értékek: 1 2 3 4 5 1 6 2 7 6 5 4 3 7 2 6

program NxN; 
uses Crt; 
type tomb2D = array of array of Word; 
var tomb : tomb2D;
x, y : Byte;
hiba : Integer;
k, n : Longint;
s : string; 
begin
  ClrScr;
  hiba := 1;
  while (hiba <> 0) or (n < 2) or (n > 23) do
  begin
    Write('Kerem a tomb elemszamat: ');
    ReadLn(s);
    Val(s, n, hiba);
  end;
  SetLength(tomb, n, n);
  for y := 0 to n - 1 do
  begin
      for x := 0 to n - 1 do
      begin
      hiba := 1;
      while (hiba <> 0) or (k < 0) or (k > 9999) do
      begin
        k := -1;
        Write('Kerem a(z) ', y + 1, ' sor ', x + 1, ' elemet: ');
        ReadLn(s);
        Val(s, k, hiba);
      end;
      tomb[y, x] := k;
    end;
  end;
  for y := 0 to n - 1 do
  begin
    for x := 0 to n - 1 do Write(tomb[y, x]:5, ' ');
    WriteLn;
  end;
  WriteLn;
  for x := 0 to n - 1 do Write(tomb[0, x], ' ');
  for x := 1 to n - 1 do Write(tomb[x, n-1], ' ');
  for x := n - 2 downto 0 do Write(tomb[n - 1, x], ' ');
  for x := n - 2 downto 1 do Write(tomb[x, 0], ' ');
  WriteLn;
  WriteLn('Befejezeshez nyomj le egy billentyut !');
  ReadKey;
  Finalize(tomb); 
end. 

Sorszám kiírása betüvel

function sorsz( const i : word) : string; 
var egyes, tizes, szazas : byte;
s_Egyes, s_Tizes, s_Szazas : string; 
begin
  egyes := i mod 10;
  tizes := i mod 100 div 10;
  szazas := i div 100case szazas of   
    0: s_Szazas := '';   
    1: s_Szazas := 'száz';   
    2: s_Szazas := 'kétszáz';   
    3: s_Szazas := 'háromszáz';   
    4: s_Szazas := 'négyszáz';   
    5: s_Szazas := 'ötszáz';   
    6: s_Szazas := 'hatszáz';   
    7: s_Szazas := 'hétszáz';   
    8: s_Szazas := 'nyolcszáz';   
    9: s_Szazas := 'kilencszáz'endcase tizes of   
    0: s_Tizes := '';   
    1: s_Tizes := 'tizen';   
    2: s_Tizes := 'huszon';   
    3: s_Tizes := 'harminc';   
    4: s_Tizes := 'negyven';   
    5: s_Tizes := 'ötven';   
    6: s_Tizes := 'hatvan';   
    7: s_Tizes := 'hetven';   
    8: s_Tizes := 'nyolcvan';   
    9: s_Tizes := 'kilencven'endcase egyes of   
    0: s_Egyes := '';   
    1: s_Egyes := 'egyedik';   
    2: s_Egyes := 'kettedik';
    3: s_Egyes := 'harmadik';
    4: s_Egyes := 'negyedik';
    5: s_Egyes := 'ötödik';
    6: s_Egyes := 'hatodik';
    7: s_Egyes := 'hetedik';
    8: s_Egyes := 'nyolcadik';
    9: s_Egyes := 'kilencedik';
  end;
  if i mod 100 = 0 then s_Szazas := s_Szazas+'adik';
  if i < 10 then
  begin
    case egyes of
      1: s_Egyes := 'elsö';
      2: s_Egyes := 'második';
    end;
  end;
  if (i mod 10) = 0 then
  begin
    case tizes of
      1: s_Tizes := 'tizedik';
      2: s_Tizes := 'huszadik';
      3,6,8: s_Tizes := s_Tizes + 'adik';
      4,5,7,9: s_Tizes := s_Tizes + 'edik';
    end;
  end;
  sorsz := s_Szazas + s_Tizes + s_Egyes; 
end; 

Állapítsuk meg, hogy a bekért szám primszám-e

program primszam; 
uses Crt; 
var n, v, i : longint;
prime : boolean ; 
begin
  ClrScr;
  Write('Kerem a szamot: ');
  ReadLn(n);
  v := Trunc(Sqrt(n)) + 1;
  prime := (n mod 2) <> 0;
  i := 3;
  while(prime) and (i <= v) do
  begin
    prime := (n mod i) <> 0;
    Inc(i, 2);
  end;
  if prime then WriteLn('Prim') else WriteLn('Nem prim');
  ReadLn; 
end. 

A Török szultán születésnapján gyönyörü ajándékot kapott. Annyira megörült, hogy rögtön valami jót akart cselekedni. Leküldte hát 400 fös szolgaseregének elsö szolgáját a börtönbe. Meghagyta neki, hogy mind a 400 cella ajtaját nyissa ki. Lett is nagy riadalom. A börtönörök rettegtek. Ha szabadon engedik a rabokat, és öfelsége kedve változik, fejüket veszi. Leült hát négyszáz ör a négyszáz nyitott cella elé. Teljesítették is a szultán parancsát, de a rabokat sem engedték szabadon. Igazuk lett. A szultán megharagudott, mert a következö ajándék nem tetszett. Leküldte a második szolgát. Azt parancsolta, minden második ajtót zárjon be. Kisvártatva meggondolta magát, és leküldte a harmadik szolgát, hogy minden harmadik ajtót nyissa ki, ha zárva van, és zárja be, ha nyitva van. Majd leküldte a negyedik szolgát, hogy minden negyedik ajtón változtasson. Aztán az ötödiket, hatodikat és így tovább egészen addig, míg az utolsó, a 400. szolgának azt parancsolta: Menj le és a 400. cellát nyisd ki, ha zárva van, De ha nyitva lenne, akkor zárd be. Így is lett. Azzal a szultán nyújtózott egyet, és lefeküdt aludni. A börtönparancsnok tudta, aznap már több parancs nem jön, és a szultán soha nem vonja vissza azokat a parancsait, amit elözö nap adott. Szabadon engedte hát azokat, akiknek a cellája nyitva volt. Kiket is?

program rab; 
var  cella : array[1..400] of boolean;
i, n : integer; 
begin
  for i := 1 to 400 do
  begin
    cella[i] := not cella[i];
  end;
  for i := 2 to 400 do
  begin
    n := 0;
    Inc(n, i);
    while n <= 400 do
    begin
      cella[n] := not cella[n];
      Inc(n, i);
    end;
  end;
  for i := 1 to 400 do
  if cella[i] then WriteLn(i); 
end. 

10 napon keresztül mértük a hömérsékletet, melynek értékei -5 és +10 fok közé estek. Hány fok volt leghidegebb és a legmelegebb? Melyik volt a leghidegebb nap? Rendezzük sorba a hömérsékleteket !

#include <iostream>     
using namespace std;     
int main()
{  
    int tomb[10], MIN, MAX, hideg, i;
    srand(time(NULL));
    for(i = 0; i < 10; i++)
    {  
        tomb[i] = rand()%16 - 5;
        cout <<"A(z) " << i + 1 << ". nap homerseklete: " << tomb[i] << " fok" << endl;
    }
    cout << endl;
    MIN = tomb[0];
    hideg = 0; 
    for(i = 0; i < 10; i++)
    {  
        if(tomb[i] < MIN)
        {
            MIN = tomb[i];
            hideg = i;
        }
    }
    MAX = tomb[0]; 
    for(i = 0; i < 10; i++)
    {
        if(tomb[i] > MAX)
        MAX = tomb[i];
    }
    cout << "Legmelegebb: " << MAX << " fok" << endl;
    cout << "Leghidegebb: " << MIN << " fok" << endl;
    cout << "Leghidegebb a(z) " << hideg + 1 <<". nap" << endl << endl;
    for (i = 0; i < 9; i++)
    {
        for (int j = i + 1; j < 10; j++)
        {
            if (tomb[i] > tomb[j])
            {
                int a = tomb[i];
                tomb[i] = tomb[j];
                tomb[j] = a;
            }
        }
    }
    cout << "Sorba rendezve:"  << endl << endl;
    for(i = 0; i < 10; i++)
    {
        cout << tomb[i] << " fok" << endl;
    }
    cout << endl;
    cin.ignore();
    getchar();
}     

Egy szám osztóinak száma és azok összege

#include <iostream>
using namespace std;
int main()
{    
    int szam, osztokszama = 0, osztoksum = 0;
    cout << "Kerem a szamot: ";
    cin >> szam;
    cout << "Szam: " << szam << "\n";
    cout << "Osztok: ";
    for (int i = 1; i <= szam; i++)
    {
        if (szam % i == 0)
        {
           cout << i << " ";
           osztokszama++;
           osztoksum += i;         
        }
    }
    cout << "\nOsztok szama: " << osztokszama << "\n";
    cout << "Osztok osszege: " << osztoksum << "\n";
    cin.ignore();
    getchar();
}

Primek keresése adott számig

#include <iostream>
#include <cmath>
using namespace std;
bool primteszt(int szam)
{
    bool jo = true ;
    if (szam == 2) return true;
    if ((szam % 2 == 0) || (szam == 1)) return false;
    for (int t = 3; t <= sqrt(szam) + 1; t += 2)
    {
        if (szam % t == 0)
        {
            jo = false ;
        }
    }
    return jo ;
}
int main()
{
    int db = 0 ;
    for (int t = 1; t <= 500; t++)
    {
        if (primteszt(t))
        {
            cout << t << " ";             
            ++db;
        }
    }
    cout << endl << db << " primszam van 500-ig";              
    cin.ignore();
    getchar();
}

Szám primtényezökre bontása C++

#include <iostream>
using namespace std;
int Prim(int);
int KovPrim(int);
int main()
{
    int n,d=2;
    cout << "Vizsgalando szam: ";
    cin >> n;
    cout << "Prim felbontas: ";
    while(!Prim(n))
    {
        while(1)
        {
            if(n%d==0)
            {
                cout << d << "*";
                n/=d;
                break;
            }
            d=KovPrim(d);
        }
    }
    cout << n << "\n";
    cin.ignore();
    cin.get();
}
int Prim(int n)
{
    int i;
    for(i=2;i<=n/2;i++)
    {
        if(n%i==0)
        return 0;
    }
    return 1;
}
int KovPrim(int n)
{
    do
    {
        if(n==2)
        n++;
        else
        n+=2;
    }
    while(!Prim(n));
    return n;
}

Szám primtényezökre bontása Pascal

program primfelbontas;

uses crt, sysutils;

var szam: int64;

procedure beker;
var s : string;
    hiba : integer;
begin
  hiba := 1;
  while hiba <> 0 do
  begin
    Write('Kerem a felbontando szamot: ');
    ReadLn(s);
    Val(s, szam, hiba);
  end;
end;

function prim_e(n : int64) : boolean;
var v, j: int64;
    prime: boolean;
begin
  v := Trunc(Sqrt(n)) + 1;
  prime := (n mod 2) <> 0;
  j := 3;
  while(prime) and (j <= v) do
  begin
    prime := (n mod j) <> 0;
    Inc(j, 2);
  end;
  prim_e := prime;
end;

procedure felbont;
var i : int64;
    s : string;
begin
  if prim_e(szam) then WriteLn('A szam primszam. ',szam,' = 1 * ',szam);
  if not prim_e(szam) then
  begin
  Write('A szam nem primszam. ',szam,' = ');
    i:=2;
    while (szam <> 1) do
    begin
      while (szam mod i = 0) do
      begin
        s := s + IntToStr(i) + ' * ';
        szam := szam div i;
      end;
      Inc(i);
      while(not prim_e(i)) do Inc(i);
    end;
  end;
  Delete(s, Length(s) - 1, 2);
  Write(s);
end;

begin
  Clrscr;
  WriteLn('Primtenyezos felbontas');
  beker;
  felbont;
  ReadKey;
end.

Kockajáték: A gép játsza a bank szerepét, a játékos közli a tét összegét, majd dob a két kockával. Ezt a dobást a program szimulálja (véletlen) számmal, majd kiírja a képernyöre a két kockán dobott értéket vagy kirajzolja a dobókocka megfelelö lapjának képét.
Szabályai: ha a dobások összege:
2, 7, 12: a játékos a tétjének megfelelö pénzt nyeri,
3, 5, 9, 11: nem nyer, nem veszít, pénze változatlan;
4, 6, 8, 10: a tétnek megfelelö összeget veszít
A játéknak akkor van vége, ha elfogy a játékos pénze vagy 0-t írt be a tét értékének.

 program kocka;

uses crt;

var a, b : byte;
    nyeremeny, tet : integer;

procedure dobas;
begin
  a := Random( 6) +  1;
  b := Random( 6) +  1;
end;

procedure keret;
begin
  GotoXY( 1, 1);
  Write( '┌─────┐ ┌─────┐');
  GotoXY( 1, 2);
  Write('│     │ │     │');
  GotoXY(1,3);
  Write('│     │ │     │');
  GotoXY(1,4);
  Write('│     │ │     │');
  GotoXY(1,5);
  Write('└─────┘ └─────┘');
end;

procedure rajzol( a1, b1 : byte);
const ketto = '*   *';
      egy ='  *';
      bal = '*   ';
      jobb = '    *';
begin
  case a1 of
    1: begin
         GotoXY(2, 3);
         Write(egy);
       end;
    2: begin
         GotoXY(2, 2);
         Write(jobb);
         GotoXY(2, 4);
         Write(bal);
       end;
    3: begin
         GotoXY(2, 2);
         Write(jobb);
         GotoXY(2, 3);
         Write(egy);
         GotoXY(2, 4);
         Write(bal);
       end;
    4: begin
         GotoXY(2, 2);
         Write(ketto);
         GotoXY(2, 4);
         Write(ketto);
       end;
    5: begin
         GotoXY(2, 2);
         Write(ketto);
         GotoXY(2, 3);
         Write(egy);
         GotoXY(2, 4);
         Write(ketto);
       end;
    6: begin
         GotoXY(2, 2);
         Write(ketto);
         GotoXY(2, 3);
         Write(ketto);
         GotoXY(2, 4);
         Write(ketto);
       end;
  end;

  case b1 of
    1: begin
         GotoXY(12, 3);
         Write(egy);
       end;
    2: begin
         GotoXY(12, 2);
         Write(jobb);
         GotoXY(12, 4);
         Write(bal);
       end;
    3: begin
         GotoXY(12, 2);
         Write(jobb);
         GotoXY(12, 3);
         Write(egy);
         GotoXY(12, 4);
         Write(bal);
       end;
    4: begin
         GotoXY(12, 2);
         Write(ketto);
         GotoXY(12, 4);
         Write(ketto);
       end;
    5: begin
         GotoXY(12, 2);
         Write(ketto);
         GotoXY(12, 3);
         Write(egy);
         GotoXY(12, 4);
         Write(ketto);
       end;
    6: begin
         GotoXY(12, 2);
         Write(ketto);
         GotoXY(12, 3);
         Write(ketto);
         GotoXY(12, 4);
         Write(ketto);
      end;
  end;
end;

procedure ertekel;
begin
  case a + b of
    2, 7, 12: begin
                GotoXY(6, 6);
                Write('Nyert !');
                Inc(nyeremeny, tet);
              end;
    3, 5, 9, 11: begin
                   GotoXY(6, 6);
                   Write('Marad !');
                 end;

    4, 6, 8, 10: begin
                   GotoXY(6, 6);
                   Write('Veszt !');
                   Dec(nyeremeny, tet);
                 end;
  end;
  GotoXY(20, 2);
  Write('A rendelkezesre allo osszeg: ', nyeremeny:4, ' $');
end;

procedure tesz;
var s : string;
    hiba : integer;
begin
  GotoXY(10, 9);
  Write('2, 7, 12 Nyer - 4, 6, 8, 10 Veszit - 3, 5, 9, 11 Marad');
  hiba := 1;
  GotoXY(20, 2);
  Write('A rendelkezesre allo osszeg: ', nyeremeny:4, ' $');
  while hiba <> 0 do
  begin
    GotoXY(20, 4);
    Write('                                                  ');
    GotoXY(20, 4);
    Write('Tedd meg a tetedet - 0 kilep : ');
    ReadLn(s);
    Val(s, tet, hiba);
    if tet > nyeremeny then hiba := 1;
  end;
end;

begin
  ClrScr;
  Randomize;
  nyeremeny := 1000;
  keret;
  ertekel;
  repeat
    tesz;
    dobas;
    keret;
    rajzol(a, b);
    ertekel;
  until (tet < 1) or (nyeremeny = 0);
  if tet < 1 then
  begin
    GotoXY(17, 13);
    TextColor(12);
    Write('Felhasznalo keresere veget ert a jatek !');
  end;
  if nyeremeny = 0 then
  begin
    GotoXY(18, 13);
    TextColor(12);
    Write('Elfogyott a felhasználhato keret !  :)');
  end;
  WriteLn;
  ReadLn;
end.

10 x 10 -es mátrix feltöltése véletlen számokkal, kííratása a párosak zöld, a páratlanok lila és primek piros szinnel. Minimum és maximum érték keresése. A mátrix, a fö és mellékátló összege valamint az átlók összegének legnagyobb közös osztója.

 program matrix_;

uses crt;

var matrix : array [1..10, 1..10] of byte;
    max, min : byte;
    osszeg, foatlo, melatlo : int64;

procedure feltolt;
var i, n : byte;
begin
  for i := 1 to 10 do
    for n := 1 to 10 do matrix[i, n] := Random(255) + 1;
end;

function prim(k: integer) : boolean;
var v, j: integer;
begin
  v := Trunc(Sqrt(k)) + 1;
  prim := (k mod 2) <> 0;
  j := 3;
  while(prim) and (j <= v) do
  begin
    prim := (k mod j) <> 0;
    Inc(j, 2);
  end;
end;

function lnko(a, b : integer) : integer;
var i: integer;
begin
  if (a > b) then i := a else i := b;
  while (a mod i > 0) or (b mod i > 0) do Dec(i);
  lnko := i;
end;

procedure kiir;
var i, n : byte;
begin
  max := matrix[1, 1];
  min := matrix[1, 1];
  for i := 1 to 10 do
  begin
    foatlo := foatlo + matrix[i, i];
    for n := 1 to 10 do
    begin
      TextColor(LightGreen);
      if Odd(matrix[i, n]) then TextColor(LightMagenta);
      if prim(matrix[i, n]) then TextColor(LightRed);
      if matrix[i, n] > max then max := matrix[i, n];
      if matrix[i, n] < min then min := matrix[i, n];
      Write(matrix[i, n]:4);
      if n mod 10 = 0 then WriteLn;
      osszeg := osszeg + matrix[i, n]
    end;
  end;
  for i := 10 downto 1 do melatlo := melatlo + matrix[11-i, i];
end;

begin
  ClrScr;
  Randomize;
  feltolt;
  kiir;
  TextColor(15);
  WriteLn;
  WriteLn('Legkisebb elem: ', min, ' Legnagyobb elem: ', max, ' Matrix osszeg: ', osszeg);
  WriteLn('Foatlo osszege: ', foatlo, ' Mellekatlo osszege: ', melatlo, ' Legnagyobb kozos oszto: ', lnko(foatlo, melatlo));
  ReadLn;
end.

Lottó sorsoló program 5, 6 és 7-es lottóhoz

 program lotto;

uses Crt;

var szamok : array of byte;
    tippek : array of byte;
    talal : array of byte;
    HANYAS : byte;

procedure kezd;
var hiba : integer;
    tipus : char;
begin
  ClrScr;
  WriteLn( 'Valassz lotto tipust !');
  WriteLn( '----------------------');
  WriteLn( '    5 - Otos lotto');
  WriteLn( '    6 - Hatos lotto');
  WriteLn( '    7 - Skandinav lotto');
  repeat
    tipus := ReadKey;
  until (tipus >=  '5') and (tipus <=  '7');
  Val(tipus, HANYAS, hiba);
  SetLength(szamok, HANYAS +  1);
  SetLength(tippek, HANYAS +  1);
  SetLength(talal, HANYAS +  1);
  ClrScr;
  case HANYAS of
    5:  WriteLn('Otos lotto !');
    6:  WriteLn('Hatos lotto !');
    7:  WriteLn('Skandinav lotto !');
  end;
  WriteLn('-----------------------');
end;

function van(uj : byte) : boolean;
var i : byte;
begin
  van := false;
  for i := 1 to HANYAS do
  if szamok[i] = uj then van := true;
end;

function vantipp(uj : integer) : boolean;
var i : byte;
begin
  vantipp := false;
  for i := 1 to HANYAS do
  if tippek[i] = uj then vantipp := true;
end;

procedure rendez;
var temp, i, j : byte;
begin
  for i := HANYAS downto 1 do
  begin
    for j := 1 to i - 1 do
    begin
      if szamok[j] > szamok[j+1] then
      begin
        temp := szamok[j];
        szamok[j] := szamok[j+1];
        szamok[j+1] := temp;
      end;
    end;
  end;
end;

procedure rendeztipp;
var temp, i, j : byte;
begin
  for i := HANYAS downto 1 do
  begin
    for j := 1 to i - 1 do
    begin
      if tippek[j] > tippek[j+1] then
      begin
        temp := tippek[j];
        tippek[j] := tippek[j+1];
        tippek[j+1] := temp;
      end;
    end;
  end;
end;

procedure beker;
var hiba, szam, n, j  : integer;
    s: string;
begin
  case HANYAS of
    5: j := 90;
    6: j := 45;
    7: j := 35;
  end;
  hiba := 1;
  for n := 1 to HANYAS do
  begin
    while hiba <> 0 do
    begin
      Write(n, '. szam: ');
      ReadLn(s);
      Val(s, szam, hiba);
      if vantipp(szam) then
      begin
        WriteLn('Mar van ilyen szam !');
        hiba := 1;
      end;
      if szam > j then
      begin
        WriteLn('Tul nagy szam ! ', '1 es ', j, ' kozott lehet !');
        hiba := 1;
      end;
    end;
    tippek[n] := szam;
    hiba := 1;
  end;
end;

procedure kiir;
var i : byte;
begin
  Write('Nyero szamok:    ');
  for i:= 1 to HANYAS do Write(szamok[i]:3);
  WriteLn;
end;

procedure kiirtipp;
var i : byte;
begin
  Write('Tippelt szamok:  ');
  for i:= 1 to HANYAS do Write(tippek[i]:3);
  WriteLn;
end;

procedure huzas;
var n, k, j, ii: byte;
begin
  ii := 1;
  case HANYAS of
    5: n := 90;
    6: n := 45;
    7: n := 35;
  end;
  Randomize;
  for j := 1 to HANYAS do
  begin
    k := Random(n) + 1;
    while van(k) do k := Random(n) + 1;
    szamok[ii] := k;
    Inc(ii);
  end;
end;

procedure kiertekel;
var talalat, n, j : byte ;
begin
  talalat := 0;
  for n := 1 to HANYAS do
  for j := 1 to HANYAS do
  if tippek[n] = szamok[j] then
  begin
    Inc(talalat);
    talal[talalat] := tippek[n];
  end;
  WriteLn('Talalatok szam:    ', talalat);
  if talalat > 0 then
  begin
    Write('Eltalalt szamok: ');
    for n := 1 to talalat do Write(talal[n]:3);
  end;
  WriteLn;
  SetLength(szamok, 0);
  SetLength(tippek, 0);
  SetLength(talal, 0);
end;

begin
  TextBackground(Cyan);
  TextColor(Black);
  kezd;
  beker;
  huzas;
  rendez;
  rendeztipp;
  kiirtipp;
  kiir;
  kiertekel;
  ReadLn;
end.

Mp3 lejátszása konzolból (Delphi)

 program Console_Mp3;

{$APPTYPE CONSOLE}

 uses SysUtils, MMSystem;

 var FDeviceID :  cardinal;
    music :  string;

 procedure OpenDevice;
 var
  OpenParm: TMCI_Open_Parms;
  Error:  cardinal;
 begin
  FillChar(OpenParm, SizeOf(TMCI_Open_Parms),  0);
  OpenParm.dwCallback :=  0;
  OpenParm.lpstrDeviceType :=  '';
  OpenParm.lpstrElementName :=  PChar(music);
  OpenParm.dwCallback :=  0;
  Error := mciSendCommand( 0, mci_Open, MCI_OPEN_ELEMENT,  Longint(@OpenParm));
   if Error <>  0  then
   begin
    WriteLn( 'Az eszközt nem sikerült megnyitni!');
    ReadLn;
    Halt( 1);
   end
   else
    FDeviceID := OpenParm.wDeviceID;
 end;

 procedure CloseDevice;
 var
  GenParm: TMCI_Generic_Parms;
  Error:  cardinal;
 begin
   if FDeviceID <>  0  then
   begin
    GenParm.dwCallback :=  0;
    Error := mciSendCommand(FDeviceID, mci_Close,  0,  Longint(@GenParm));
     if Error =  0  then FDeviceID :=  0;
   end;
 end;

 procedure PlayMP3;
 var
  PlayParm: TMCI_Play_Parms;
 begin
  WriteLn( 'Lejátszás alatt:  ', music,  '  Enter-re leáll');
  mciSendCommand(FDeviceID, mci_Play,  0,  Longint(@PlayParm));
 end;

 procedure StopMP3;
 var
  GenParm: TMCI_Generic_Parms;
 begin
  mciSendCommand(FDeviceID, mci_Stop,  0,  Longint(@GenParm));
 end;

 begin
  music := ParamStr( 1);
  OpenDevice;
  PlayMp3;
  ReadLn;
  StopMp3;
  CloseDevice;
 end.

Eratoszthenész szitája (Delphi - Pascal)
A Wikipédián megjelent Pascal kód javítása ugyanis abból kimaradt a p változó növelése
ebböl kifolyólag soha nem lép ki a ciklusból valamint a tömb is dinamikus lett

program Eratoszthenesz_szitaja; 

{$APPTYPE CONSOLE}

uses SysUtils;

var n, i, j, p:longint;
  a: array of boolean;
begin
  Write('Kérem N értékét: ');
  ReadLn(n);
  SetLength(a, n + 1);
  a[1] := False;
  for i := 2 to n do a[i] := True;
  p := 2;
  while p * p <= n do
  begin
    if a[p] then
    begin
      j := p * p;
      while j <= n do
      begin
        a[j] := False;
        Inc(j, p);
      end;
    end;
    Inc(p);
  end;
  for i := 1 to n do if a[i] then Write(i, ' ');
  SetLength(a, 0);
  ReadLn;
end.

Copyright © 2013 Simkó Lajos - Minden jog fenntartva. Módosítva: 2015. május