Aktualizováno: 24. 4. 2020, datum vydání: 29. 11. 2012
Zde je příklad na otevření souboru a zápis do jiného souboru. Jedná se o naprostou jednoduchou kopii obsahu souboru.
Čtení ze souboru a zápis do souboru
Program předpokládá existenci souboru vstup.txt v adresáři C:\Users\Jitka\Desktop\pascal\. Pokud by soubor neexistoval, program je ukončen běhovou chybou.
Čtení a zápis probíhá po znacích
program ZapisDoSouboru;
uses
crt;
var
tVstup,tVystup: text;
znak: char;
begin
clrScr;
assign(tVstup, 'C:\Users\Jitka\Desktop\pascal\vstup.txt');
reset(tVstup);
assign(tVystup, 'C:\Users\Jitka\Desktop\pascal\vystup.txt');
rewrite(tVystup);
while not eof(tVstup) do
begin
read(tVstup, znak);
// write(znak); // kontrolni vypis znaku na obrazovku
write(tVystup, znak);
end;
close(tVstup);
close(tVystup);
repeat
until keyPressed;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 24. 11. 2012
Uvedu příklad, jak se může pole předávat jako parametr funkce či procedury, případně být jeho návratovou hodnotou funkce.
Pro tyto účely jsem vytvořila funkci pro načtení pole, proceduru pro výpis pole a dvě procedury či funkce pro kopii pole do pole. Procedury pro kopii pole nejsou nutné, protože Pascal sám umí zkopírovat celé pole do jiného pole pomocí prostého přiřazení. Podmínkou je, že pole musí být shodného typu (viz Pavel Satrapa1). Kopírování přiřazením do proměnné probíhá kopírováním hodnotou. Mně zde funkce či procedury pro kopírování pole poslouží jako jednoduchá ukázka možné manipulace s polem. Všechna předávaná pole musí být shodného typu. Nejlépe je, si pro tento účel založit extra typ pole, a to klíčovým slovem type.
Aktualizováno: 24. 4. 2020, datum vydání: 30. 10. 2012
Zadání příkladu
Program vyzve uživatele k zadání celého čísla. Úkolem programu je sečíst cifry čísla a vypsat tento součet. Např. když uživatel zadá „4652“ program vypíše „17“, protože 4 + 6 + 5 + 2 = 17. Zpracování ciferného součtu má být úkolem funkce, které se předá zadané načtené číslo jako parametr.
Řešení ve Free Pascalu
program CifernySoucet;
uses crt;
var n: integer;
function cifernySoucet(cislo: integer): integer;
var cifra, torzo, soucet: integer;
begin
soucet := 0;
torzo := cislo;
repeat
cifra := torzo mod 10; // dostanu posledni cifru cisla
soucet := soucet + cifra;
torzo := torzo div 10; // uriznu posledni cifru cisla
until torzo = 0;
cifernySoucet := soucet;
end;
begin
clrScr;
write('Zadejte cislo: ');
read(n);
writeln('Ciferny soucet cisla ', n, ' je ', cifernySoucet(n), '.');
repeat
until keyPressed;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 28. 10. 2012
Zadání příkladu
Program vyzve uživatele k zadání celých kladných čísel. Čísla budou oddělena mezerou (případně enterem). Čísel může být libovolný počet. Čísla budou ukončena nulou. Program zjistí nejdelší shodný úsek posloupnosti čísel a vypíše délku tohoto nejdelšího úseku. Např. pro zadaná čísla „5 7 7 1 1 1 3 3 4 8 7 7 7 7 9 0“ vypíše „4“, protože nejdelší stejný úsek čísel je „7 7 7 7“ a jeho délka je čtyři.
Řešení ve Free Pascalu
program souvislyUsek;
uses crt;
var delkaAkt, delkaNej, cislo, prevCislo: integer;
begin
clrScr;
delkaAkt := 0;
delkaNej := 0;
prevCislo := 0;
write('Zadejte kladna cela cisla oddelena mezerou ukoncena nulou: ');
read(cislo);
while cislo <> 0 do
begin
if cislo = prevCislo then
begin
delkaAkt := delkaAkt + 1;
end
else // mame novy usek
begin
if delkaAkt > delkaNej then
delkaNej := delkaAkt;
delkaAkt := 1;
end;
prevCislo := cislo;
read(cislo);
end;
// pro pripad, ze by nejdelsi usek byl na konci
if delkaAkt > delkaNej then
delkaNej := delkaAkt;
writeln('Delka nejdelsiho useku je: ', delkaNej);
repeat until keyPressed;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 24. 10. 2012
Zadání příkladu
Program vyzve uživatele k zadání celých kladných čísel. Čísla budou oddělena mezerou (případně enterem). Čísel může být libovolný počet. Čísla budou ukončena nulou. Program zjistí nejdelší rostoucí úsek posloupnosti čísel a vypíše délku tohoto nejdelšího úseku. Např. pro zadaná čísla „5 7 1 3 4 8 7 7 9 0“ vypíše „4“, protože nejdelší rostoucí úsek čísel je „1 3 4 8“ a jeho délka je čtyři.
Řešení ve Free Pascalu
program rostouciUsek;
uses crt;
var delkaAkt, delkaNej, cislo, prevCislo: integer;
begin
clrScr;
delkaAkt := 0;
delkaNej := 0;
prevCislo := 0;
write('Zadejte kladna cela cisla oddelena mezerou ukoncena nulou: ');
read(cislo);
while cislo <> 0 do
begin
if cislo > prevCislo then
begin
delkaAkt := delkaAkt + 1;
end
else // mame novy usek
begin
if delkaAkt > delkaNej then
delkaNej := delkaAkt;
delkaAkt := 1;
end;
prevCislo := cislo;
read(cislo);
end;
// pro pripad, ze by nejdelsi usek byl na konci
if delkaAkt > delkaNej then
delkaNej := delkaAkt;
writeln('Delka nejdelsiho rostouciho useku je: ', delkaNej);
repeat until keyPressed;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 17. 10. 2012
Zadání příkladu
Program vyzve uživatele k zadání počtu čísel. Následně si vyžádá čísla oddělená mezerou (případně enterem). Čísla sečte a vypíše součet na obrazovku.
Řešení ve Free Pascalu
program soucet;
uses crt;
var suma, n, i, cislo: integer;
begin
clrscr;
write('Zadej pocet cislic: ');
readln(n);
if n > 0 then
begin
suma := 0;
write('Zadej cislice oddelene mezerou: ');
for i := 1 to n do
begin
read(cislo);
suma := suma + cislo;
end;
writeln('Soucet vsech cisel je: ', suma);
repeat until keypressed;
end;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 17. 10. 2012
Zadání příkladu
Program vyzve uživatele k zadání počtu čísel. Následně si vyžádá čísla a zjistí z nich maximální hodnotu a četnost výskytu této maximální hodnoty. Zjištěné údaje vypíše na obrazovku.
Řešení ve Free Pascalu
program maximum;
uses crt;
var max, n, i, cislo, cetnost: integer;
begin
clrscr;
write('Zadej pocet cifer: ');
readln(n);
if n > 0 then
begin
max := -MAXINT;
cetnost := 0;
for i := 1 to n do
begin
write('Zadej ', i, '. cislo: ');
readln(cislo);
if cislo > max then
begin
max := cislo;
cetnost := 0;
end;
if cislo = max then
cetnost := cetnost + 1;
end;
writeln('Maximum ze zadanych cisel je: ', max);
writeln('Pocet vyskytu maxima (cetnost) je: ', cetnost);
repeat until keypressed;
end;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 10. 10. 2012
Program podle věku určí, zda je člověk starý či mladý. Berte program s rezervou :).
Jde o jednoduchý příklad pro začátečníky pro procvičení podmínky if a čtení vstupů a výstupů.
Zdrojový kód Free Pascal
program Stari;
var vek: integer;
begin
write('Zadej vek: ');
readln(vek);
if vek < 20 then
write('Jsi jeste mlady, to se mas.')
else
write('Tak to jsi uz pekne stary :-).');
readln;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 17. 11. 2011
Program vypíše v pořadí druhé maximum ze zadaných čísel. Skonční zadáním čísla -999. Pokud jsou některá čísla shodná (např. 5 5 9 9 1 2), vypíše jako druhé maximum číslo 5.
Zdrojový kód Free Pascal
program DruheMaximum;
uses crt;
var cislo, max, max2: Integer;
begin
clrScr;
writeln('Program vypise druhe nejvetsi cislo ze zadanych celych cisel. Konec = -999.');
max := -MAXINT; //-32768
max2 := max;
repeat
write('Zadejte cislo: ');
readln(cislo);
if (cislo <> -999) then
begin
if (cislo > max) then
begin
max2 := max;
max := cislo;
end
else
if ((cislo < max) and (cislo > max2)) then // cislo je mezi dosavadnim maximem a druhym maximem a neni rovno maximu
max2 := cislo;
end;
until (cislo = -999);
writeln('Druhe nejvetsi cislo ze zadanych cisel je: ', max2);
repeat
until keyPressed;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 17. 11. 2011
Program vytiskne maximum ze zadaných čísel. Po zadání čísla -999 program skončí.
Zdrojový kód Free Pascal
While cyklus
program Maximum;
uses crt;
var cislo, max: integer;
begin
clrScr;
writeln('Program vypise maximum ze zadanych celych cisel. Konec = -999.');
max := -MAXINT; //-32768
write('Zadejte cislo: ');
readln(cislo);
while (cislo <> -999) do
begin
if (cislo > max) then
max := cislo;
write('Zadejte cislo: ');
readln(cislo);
end;
writeln('Maximum ze zadanych cisel je: ', max);
repeat
until keyPressed;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 14. 11. 2011
Program spočítá podíl dvou celých čísel. Vrátí celočíselný výsledek a k němu zbytek. Dále vrátí reálný výsledek.
Zdrojový kód Free Pascal
program PodilDvouCisel;
uses crt;
var
a, b, c, zbytek: integer;
cReal: real;
begin
clrScr;
// nacteni vstupu
writeln('Program pocita celociselny a realny podil dvou celych cisel A a B.');
write('Zadejte cislo A (delence): ');
readln(a);
write('Zadejte cislo B (delitele): ');
readln(b);
// vypocet a zobrazeni vystupu
if (b = 0) then
begin
writeln('Nulou nelze delit!');
end
else
begin
// celociselne deleni
c := a div b;
zbytek := a mod b; // zbytek po celociselnem deleni
writeln('Celociselny podil A div B = ', c);
writeln('Zbytek po celociselnem deleni A mod B = ', zbytek);
// realne deleni
cReal := a / b;
writeln('Realny podil A/B = ', cReal:7:5); // zobrazeni na 5 desetinnych mist
end;
repeat
until keyPressed;
end.
Aktualizováno: 24. 4. 2020, datum vydání: 14. 11. 2011
Program najde maximum ze tří zadaných čísel a vypíše ho.
Zdrojový kód Free Pascal
program MaximumZeTriCisel;
uses Crt;
var a, b, c, max: integer;
begin
clrScr;
writeln('Program pocita maximum ze tri celych cisel.');
write('Zadejte tri po sobe jdouci cisla oddelena mezerami: ');
read(a, b, c);
if a > b then
max := a
else
max := b;
if c > max then
max := c;
write('Maximum ze zadanych cisel je: ', max);
repeat
until keyPressed;
end.
Aktualizováno: 12. 11. 2019, datum vydání: 14. 11. 2011
Download
Free Pascal 2.4.4. si můžete zdarma stáhnout. Vyberete si správnou verzi podle OS a procesoru. Já mám například MS Windows s procesorem Intel, takže jsem vybrala možnost Intel/i386 a Win32, Win64 and WinCE.
Aktualizováno: 24. 4. 2020, datum vydání: 23. 4. 2011
Program vytiskne prvočísla do zadané hodnoty N. Použije se při tom algoritmu tzv. Eratosthenova síta.
Zdrojový kód Free Pascal
program Prvocisla;
uses Crt;
const MAX_N = 10000;
var
n, i, nasobek: integer;
sito: array[2..MAX_N] of boolean; // true = je prvocislo, false = neni prvocislo
begin
clrScr;
writeln('Program vypise prvocisla do zadane hodnoty N <= ', MAX_N);
write('Zadejte kladne cele cislo N: ');
readln(n);
if (n > 0) and (n <= MAX_N) then
begin
for i := 2 to n do
sito[i] := true; // nastavime vsechna cisla na prvocisla
for i := 2 to n do
begin
if sito[i] then // pokud je prvocislo
begin
nasobek := 2 * i;
while nasobek <= n do
begin
sito[nasobek] := false; // nasobky nejsou prvocisla
nasobek := nasobek + i;
end;
end
end;
// vytiskneme prvocisla
write('Prvocisla jsou: ');
for i := 2 to n do
begin
if (sito[i]) then
write(i, ' ');
end;
end;
repeat
until keyPressed;
end.