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 100;
case 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';
end;
case 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';
end;
case 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
