Примеры кода

// объем полого стержня (трубы)

Program P1()

const

PI = 3.1415926;

var

diam: integer; // диаметр

wal: integer; // толщина стенки

len: integer; // длина

volume: float; // объем

begin

writeln('Объем полого цилиндра');

write('Диаметр, мм >');

readln(diam);

write('Толщина стенки, мм>');

readln(wal);

write('Длина, мм >');

readln(len);

volume := PI*diam*diam/4*len - PI*(diam -2*wal)*(diam -2*wal)/4*len;

volume := volume / 1000; // объем в см. куб.

writeln('Объем полого цилиндра', volume:9:2, ' см.куб.');

writeln;

write('Press ');

readln;

end.

// Конвертер веса из фунтов в граммы/килограммы.

program p1()

const

K = 453.59237;

var

Pounds: float; // вес в фунтах

Grams: integer; // вес в граммах

Kilograms: float; // вес в килограммах

// вес в формате kg + g

KG: integer;

GR: integer;

begin

writeln('Pounds to grams/kilograms converter');

writeln;

write('Pounds>');

readln(Pounds);

Grams := Round(Pounds * K);

if grams < 1000 then

writeln(Pounds:6:2, ' lb = ', Grams, ' g');

else

Kilograms := Grams / 1000;

KG := Grams DIV 1000; // или так: Trunc(kilograms);

GR := Grams mod 1000; // или так: Trunc((Kilograms-KG)*1000);

write(Pounds:6:2, ' lb = ', Kilograms:6:3);

writeln(' kg = ',KG,' kg ', GR:3, ' g');

end;

writeln;

write('Press ');

readln;

end.

// Ток в цепи, состоящей из двух резисторов, которые могут быть соединены последовательно или параллельно

program p()

var

R1,R2: float; // величины сопротивлений, Ом

T: integer; // тип соединения: 1 - послед.; 2 - парал.

U: float; // напряжение

R: float; // сопротивление цепи

I: float; // ток в цепи

begin

writeln('Ток в цепи, состоящей из двух резисторов.');

writeln;

write('R1, Om >');

readln(R1);

write('R2, Om >');

readln(R2);

write('Способ соединения (1 - послед.; 2 - парал.) >');

readln(T);

write('U, вольт >');

readln(U);

if T = 1 OR T = 2 then

if T = 1 then

R := R1 + R2;

else

R := R1*R2/(R1+R2);

end;

writeln('Сопротивление цепи: ',R:6:2, ' Om');

I := U/R;

write('I = ');

if I < 0.1 then

I := I * 1000;

writeln(Round(I),' mA');

else

writeln(I:6:3,' A');

end;

else

writeln('Ошибка! Неверно указан способ соединения.');

end;

write('Press ');

readln;

end.

// масса полого стержня (трубы)

Program P1()

const

PI = 3.1415926;

var

diam: integer; // диаметр

wal: integer; // толщина стенки

len: integer; // длина

n: integer; // номер материала

material:string[15]; //материал

density: float; //плотность материала, гр./см.куб.

volume: float; // объем

mas: float; // масса, гр.

begin

writeln('Масса полого стержня (трубы)');

write('Диаметр, мм >');

readln(diam);

write('Толщина стенки, мм>');

readln(wal);

write('Длина, мм >');

readln(len);

writeln('Выберите материал');

writeln('1. Алюминий');

writeln('2. Медь');

writeln('3. Сталь');

writeln('4. Пластик');

write('>');

readln(n);

if ( n < 1 OR n > 4 ) then

writeln('Ошибка! Неверно указан номер материала.');

else

if n = 1 then

material :='Алюминий';

density := 2.7;

else

if n = 2 then

material :='Медь';

density := 8.9;

else

if n = 3 then

material :='Сталь';

density := 7.856;

else

material :='Пластик';

density := 1.9;

end;

end;

end;

writeln('');

volume := PI*diam*diam/4*len - PI*(diam -2*wal)*(diam -2*wal)/4*len; // объем в мм. куб.

volume := volume / 1000; // объем в см. куб.

mas := volume * density;

writeln('Материал: ', material, '(',density:6:3,'гр./см.куб.)');

writeln('Объем:', volume:9:2, ' см.куб.');

writeln('Масса:', mas:6:2);

end;

writeln;

write('Press ');

readln;

end.

// Расчет массы стержня

program p()

var

p: integer; // номер выбранного материала

material: string[10]; // название материала

density: float; // плотность

diameter: integer; // диаметр

len: integer; // длина

volume: float; // объем

mas: float; // масса

begin

writeln('= Расчет массы стержня =');

repeat

writeln('\n1. Aluminum\n2. Cooper\n3. Steel\n\n0 - Выход');

write('\nВаш выбор>');

readln(p);

case p of

1: do material := 'Aluminum'; density := 2.71; end;

1: do material := 'Cooper'; density := 8.94; end;

1: do material := 'Steel'; density := 7.86; end;

//else do p := -1; end;

end;

if p >=1 and p <=3 then

write('Диаметер, мм >');

readln(diameter);

write('Длинна, мм>');

readln(len);

volume:=len*(diameter/2)*(diameter/2)*3.1415926; // объем в мм куб.

volume := volume/1000; // объем в см. куб.

mas:=volume * density;

writeln('\nМатериал: ', material,' (', density:5:2,' гр./см.куб.)');

writeln('Длинна: ', len,' мм' );

writeln('Диаметр: ', diameter,' мм');

writeln('Объем: ', volume:6:1,' см.куб.');

if (mas < 1000) then

writeln('Масса: ', mas:9:2,' гр');

else

writeln('Масса: ', mas/1000:9:3,' кг');

end;

end;

until (p = 0);

writeln;

write('\nPress ');

readln;

end.

// Таблица тригонометрических функций sin и cos.

// Демонстрирует использование функций sin и cos,

// использование процедур, форматированный вывод.

// рисует линию

procedure line(n:integer, ch: string)

var

i: integer;

begin

for i:=1 to n do

write(ch);

end;

writeln;

end;

// выводит таблицу синус-косинус

procedure tabsin(p1: float, p2: float, p3: float)

var

g: float; // угол в градусах

r: float; // угол в радианах

k: integer; // длина линии (параметр ф-и line)

begin

k:= 43;

writeln;

writeln(' Таблица синусов-косинусов');

writeln;

Line(k,'_');

writeln(' град.':7, ' рад.':12, ' синус':12, ' косинус':12);

Line(k,'-');

g := p1;

while g <= p2 do

r := 3.14/180*g;

writeln(g:7:2, r:12:6, sin(r):12:6, cos(r):12:6 );

g:= g + p3;

end;

Line(k,'=');

writeln;

end;

// главная программа

program main()

begin

tabSin(0.0,360.0,15.0);

write('Нажмите ');

readln;

end.

// Сортировка массива c использованием цикла for.

program p5()

const

ARS = 5;

var

a: array[1 .. ARS] of integer;

min, max: integer;

b: integer;

i,j: integer;

begin

a[1] := 8;

a[2] :=-8;

a[3] := -17;

a[4] := 25;

a[5] := 6;

{ вывод исходного массива }

write('Source array: ');

for i := 1 to ARS do

write(a[i]:4);

end;

writeln;

// поиск максимального элемента массива

max:=1; // пусть первый элемент минимальный

for i := 2 to ARS do

if (a[i] > a[max]) then

max:=i;

end;

end;

writeln('max=', a[max]);

{ сортировка }

for i:= 1 to ARS do

for j:=1 to ARS do

if (a[j+1] < a[j]) then

{ обмен }

b:= a[j];

a[j] := a[j+1];

a[j+1] := b;

end;

end;

end;

{ вывод отсортированного массива }

write('Sorted array: ');

for i:=1 to ARS do

write(a[i]:4);

end;

writeln;

write('Нажмите ');

readln;

end.

// Формирует значение Прописью для целого числа в диапазоне от 1 до 999

function Prop(n: integer): string

var

st: string[64];

d1: array[1..19] of string[13] =

'один ','два ','три ','четыре ','пять ','шесть ',

'семь ', 'восемь ', 'девять ', 'десять ', 'одиннадцать',

'двенадцать', 'тринадцать', 'четырнадцать', 'пятнадцать',

'шестнадцать', 'семнадцать', 'восемнадцать', 'девятнадцать';

d2: array[1..9] of string[12] =

' ', 'двадцать ','тридцать ','сорок ','пятьдесят ',

'шестьдесят ','семьдесят ','восемьдесят ','девяносто ';

d3: array[1..9] of string[10] =

'сто ','двести ','триста ','четыреста ','пятьсот ',

'шестьсот ', 'семьсот ','восемьсот ','девятьсот ';

sot: integer; // количество сотен

dec: integer; // количество десятков, если число больше 19

ed: integer; // количество единиц

begin

st:='';

sot := n div 100;

if sot != 0 then

st := d3[sot];

n := n - sot *100;

end;

if N !=0 then

if (n<=19) then

st := st + d1[n];

else

dec := n div 10;

st:=st+ d2[dec];

ed := n - dec *10;

if (ed !=0 ) then

st := st+d1[ed];

end;

end;

end;

return st;

end;

// преобразует первую букву строки к верхнему регистру

function Capital(st: string):string

var

res: string[128];

begin

res := UpCase(substr(st,1,1)) + LowCase(substr(st,2,length(st)-1));

return res;

end;

Program p()

var

n: integer;

st: string[128];

i:integer;

begin

writeln('Type number from 1 to 999 and press ');

writeln('To stop typy 0 or press ');

repeat

writeln;

write('>');

readln(n);

if (n >= 0) AND (n <1000) then

st := Capital(Prop(n));

writeln(st);

end;

until(n = 0);

writeln;

for i:=1 to 25 do

n:= Random(999);

writeln(n:3, ' - ', Capital(Prop(n)));

end;

write('Press ');

readln;

end.

// Сортировка двумерного массива.

program TwoDimArrSorting ()

const

NR=6;

NC=16;

var

a: array[1..NR, 1..NC] of integer;

i,j: integer;

key: integer; // key column index

m: integer; // min rows element index

c: integer; // row index in

b: integer;

begin

// random array for sorting

for i:= 1 to NR do

for j:=1 to NC do

a[i,j] := Random(100);

end;

end;

writeln('Source array:');

for i:= 1 to NR do

for j:=1 to NC do

write(a[i,j]: 4);

end;

writeln;

end;

key:=1;

for i:=1 to NR do // повторить столько раз, сколько строк в массиве

// найти минимальный элемент в key столбце массива от j-ого элемента

m:=i;

for j:=i+1 to NR do

if a[j,key] < a[m,key] then

m:=j;

end;

end;

if m != i then

// обменять i-ую и m-ую строки массива

for c:=1 to NC do

b:=a[i,c];

a[i,c]:=a[m,c];

a[m,c]:=b;

end;

end;

end;

writeln;

writeln('Key column: ', key);

writeln('Sorted array:');

for i:= 1 to NR do

for j:=1 to NC do

write(a[i,j]: 4);

end;

writeln;

end;

writeln;

write('Press ');

readln;

end.

// Функция программиста Volume - объем цилиндра.

Function CylinderVolume(d: integer, len: integer):float

const

PI = 3.1415926;

begin

return PI*(d/2)*(d/2)*len;

end;

// объем полого цилиндра

Program P1()

var

diam: integer; // диаметр

wal: integer; // толщина стенки

len: integer; // длина

volume: float; // объем

begin

writeln('Объем полого цилиндра');

write('Диаметр, мм >');

readln(diam);

write('Толщина стенки, мм>');

readln(wal);

write('Длина, мм >');

readln(len);

// объем в мм куб.

volume := CylinderVolume(diam,len) - CylinderVolume(diam-2*wal,len);

volume := volume / 1000; // объем в см куб.

writeln('\nОбъем полого цилиндра', volume:9:2, ' см.куб.');

writeln;

write('\nPress ');

readln;

end.

// Процедура и функция программиста Приветствие

// процедура

// выводит приветствие на русском, итальянском, испанском или английском языке

procedure hi(lang: string)

begin

if lang = 'ru' then

writeln('Привет!');

else

if lang = 'it' then

writeln('Ciao!');

else

if lang = 'es' then

writeln('Ola!');

else

writeln('Hi!');

end;

end;

end;

end;

// функция

// возвращает приветствие на русском, итальянском. испанском или английском языке

function GoodDay(lang: string): string

var

msg: string[15];

begin

if lowcase(lang) = 'ru' then

msg:='Добрый день!';

else

if lowcase(lang) = 'it' then

msg:='Buongiorno!';

else

if lowcase(lang) = 'es' then

msg:='Buones dias!';

else

msg:='Good day!';

end;

end;

end;

return msg;

end;

program p()

var

LangID: string[10]; // идентификатор языка:

// ru - русский

// en - английский

// it - итальянский

// es - испанский

begin

repeat

write('Language ID (ru, en, it, es)>');

readln(LangID);

if length(LangID) !=0 then

hi(lowcase(LangID));

writeln(GoodDay(LangID));

else

hi(lowcase('ru'));

writeln(GoodDay('ru'));

end;

until length(LangID) = 0;

write('Press ');

readln;

end.

// Рекурсивная функция Факториал и таблица факториалов от 1 до 12

// Функция Факториал

function fac(n: integer): integer

var

f: integer;

begin

if n = 1 then

f:=1;

else

f:= n*fac(n-1);

end;

return f;

end;

// Таблица факториалов от 1 до 12

program p28()

var

i: integer;

begin

for i:=1 to 12 do

writeln(i:2, ' - ', fac(i));

end;

write('Press ');

readln;

end.

// Рекурсия. Поиск всех маршрутов между двумя точками графа

program findRoad()

var

n: integer; //кол-во вершин графа

map:array[1..7,1..7] of integer; // карта (граф): map[i,j] не 0, если точки i и j соединены

road:array[1..7] of integer; // маршрут - номера точек карты

incl:array[1..7] of integer; // incl[i]=1, если точка с номером i включена в road

start: integer; // начальная точка (откуда)

finish:integer; // конечная точка (куда)

i: integer;

j:integer;

r: integer;

function step(s: integer,f: integer,p:integer): integer

// s - точка, из которой делается шаг

// f - точка, куда надо попасть (конечная)

// p - номер искомой точки маршрута

var

c:integer;// Номер точки, в которую делается очередной шаг

r: integer;

begin

if s=f then // Точки s и f совпали!

write('Маршрут: ');

for i:=1 to p-1 do

write(road[i],' ');

end;

writeln;

else

// Выбираем очередную точку

for c:=1 to N do

// Проверяем все вершины

if(map[s,c] !=0) and (incl[c]=0)

// Точка соединена с текущей и не включена

// в маршрут

then

road[p]:=c; // Добавим точку в маршрут

incl[c]:=1; // и пометим ее

// как включенную

r:=step(c,f,p+1);

incl[c]:=0;

road[p]:=0;

end;

end;

end;

end; // функция step

// Основная программа

begin

N:=7;

for i:=1 to N do

for j:=1 to N do

map[i,j]:=0;

end;

end;

// ввод карты

map[1,2]:=1;

map[1,3]:=1;

map[1,4]:=1;

map[2,1]:=1;

map[3,1]:=1;

map[3,4]:=1;

map[3,7]:=1;

map[4,1]:=1;

map[4,3]:=1;

map[4,6]:=1;

map[5,6]:=1;

map[5,7]:=1;

map[6,4]:=1;

map[6,5]:=1;

map[6,7]:=1;

map[7,3]:=1;

map[7,5]:=1;

map[7,6]:=1;

// показать "карту"

for i:=1 to N do

for j:=1 to N do

write(map[i,j]:3);

end;

writeln;

end;

repeat

// новый маршрут

for i:=1 to N do

road[i]:=0; // нет маршрута

incl[i]:=0; // нет включенных точек

end;

writeln('Поиск маршрута');

write('Начальная точка ->');

readln(start);

if start != 0 then

write('Конечная точка ->');

readln(finish);

writeln;

road[1]:=start; // внесем точку в маршрут

incl[start]:=1; // и пометим ее как включенную

r:=step(start,finish,2); // ищем вторую точку маршрута

end;

until start = 0;

writeln;

write('Для завершения нажмите ');

readln;

end.

// Обработка строк. Пользовательские функции Trim и Capital

// преобразует первую букву строки к верхнему регистру

function Capital(st: string):string

var

res: string[128];

begin

res := UpCase(substr(st,1,1)) + LowCase(substr(st,2,length(st)-1));

return res;

end;

// удаляет начальные и завершающие пробелы

function Trim(st: string):string

var

trs: string[64]; // строка без начальных и завершающих пробелов

p: integer; // указатель на робел в начае строки

lch: string[1]; // последний символ строки

begin

trs:=st;

// убрать начальные пробелы

p:= pos(' ',trs);

while p = 1 do

trs:=substr(trs,2,length(trs)-1);

p:= pos(' ',trs);

end;

// убрать завершающие пробелы

lch := substr(trs,length(trs),1);

while lch = ' ' do

trs:=substr(trs,1,length(trs)-1);

lch := substr(trs,length(trs),1);

end;

return trs;

end;

program p1()

var

name: string[25];

lastName: string[15];

firstName: string[15];

p: integer; //позиция пробела между first и last name

begin

repeat

writeln;

write('name>');

readln(name);

if (Length(name) != 0) then

name := Trim(name); // убрать начальные и завершающие пробелы

p:= Pos(' ', name);

if p !=0 then

firstName := Capital(LowCase(Substr(name, 1, p-1)));

lastName:= Capital(LowCase(Trim(Substr(name, p+1, length(name)-p))));

else

firstName := Capital(LowCase(name));

lastName:='';

end;

writeln('Name:', name);

writeln('First Name:', firstName, ': Last name:', lastName, ':');

name := firstname + ' ' + lastname;

writeln('Name:', name, ':');

end;

until (length(name) = 0);

write('Press ');

readln;

end.

// Криптограф. Шифрует/дешифрует текст. Демонстрирует работу со строками

program crypto()

var

alf: string[64]; // алфавит

src: string[128]; // исходный текст

dst: string[128]; // зашифрованный текст

rst: string[128]; // декодированный текст

key: string[32]; // ключ

n: integer; // номер буквы ключа, используемой для

// кодирования/декодирования текущего символа сообщения

// "код символа" это - порядковый номер символа в алфавите alf

pk: integer; // код символа ключа

ps: integer; // код символа исходного сообщения

pd: integer; // код символа, которым заменяется символ сообщения

i: integer;

begin

alf:= 'abcdefghijklnmopqrstuwvxyz0123456789 .,!?$';

key := 'bartsimpson'; // кодовое слово должно состоять из символов алфавита

src := 'Hello, James Bond! Die Another Day... $100.00';

src := LowCase(src);

// шифруем

n:=1;

for i:=1 to length(src) do

ps:= pos(substr(src,i,1),alf);

if ( ps !=0) then // символ есть в алфавите?

// да, кодируем

pk:= pos(substr(key,n,1),alf);

ps:= ps+pk;

if ps > length(alf) then

ps:= ps-length(alf);

end;

dst:=dst+substr(alf,ps,1);

else

// оставляем "как есть"

dst:=dst+ substr(src,i,1);

end;

n := n + 1;

if n > length(key) then

n := 1;

end;

end;

// дешифруем

n:=1;

for i:=1 to length(dst) do

ps:= pos(substr(dst,i,1),alf);

if ( ps !=0) then

pk:= pos(substr(key,n,1),alf);

ps:= ps-pk;

if ps < 1 then

ps:= ps+length(alf);

end;

rst:=rst+substr(alf,ps,1);

else

rst:= rst+ substr(dst,i,1);

end;

n := n + 1;

if n > length(key) then

n := 1;

end;

end;

writeln(' Source message:', src);

writeln(' Coded message:', dst);

writeln;

writeln('Decoded message:', rst);

write('Press ');

readln;

end.

// Генератор паролей

program PWGen()

const

PWLEN = 10; // длина пароля

N = 7 ; // количество вариантов пароля

var

pw: string[PWLEN]; // пароль

alp: string[128]; // алфавит

r: integer; // случайное число - номер символа алфавита

i: integer; // номер генерируемого символа пароля

up: integer; // 1 - преобразовать букву в строчную; 2 - оставить как есть

j: integer;

begin

// набор символов

alp := 'abcdefghijklmnopqrstuwvxyz0123456789!$?#_';

for j:=1 to N do

// сгенерировать пароль

pw := '';

for i:= 1 to PWLEN do

r := Random(length(alp));

up := Random(2);

if ( up = 1) then

pw:=pw + Upcase(substr(alp,r,1));

else

pw:=pw + substr(alp,r,1);

end;

end;

writeln(j:3, '. ', pw);

end;

writeln;

write('Press ');

readln;

end.

// Запись целых чисел (строк) в файл. Чтение целых чисел из файла (чтение строк и преобразование в целое)

program p23()

var

st: string[15];

k: integer; // число

f: text; // файл

fn: string[64]; // имя файла

sum: integer; // сумма чисел

n: integer; // кол-во чисел

med: float; // среднее арифметическое

begin

//fn:='numbers.txt';

fn:= 'c:\users\Nikita\Desktop\data.dat';

writeln('Файл данных: ',fn);

// записать числа в файл

f:=rewrite(fn);

for k:=1 to 10 do

//writestring(f, IntToStr(k));

writestring(f, IntToStr( random(10)) );

end;

close(f);

// читать числа из файла

f:= reset(fn);

if (f != -1) then

n:=0;

sum:=0;

while (eof(f) != 1) do

n:=n+1;

k:= StrToInt(readstring(f));

sum:= sum + k;

writeln(k:4);

end;

close(f);

if sum != 0 then

med:= sum/n;

end;

writeln('Чисел в файле:',n:5);

writeln('Сумма чисел:',sum:5);

writeln('Среднее арифметическое:',med:6:2);

end;

write('Press ');

readln;

end.

// Чтение и вывод на экран текстового файла.

// Рисует линию

procedure Line(ch: string, n: integer)

var

i: integer;

begin

for i := 1 to n do

write(ch);

end;

writeln;

end;

program p20()

var

f: text; // текстовый файл

fn:string[64]; // имя файла

st: string[128]; // строка, прочитанная из файла

n: integer; // количество строк

begin

// файл находится в папке Документы/pas

fn:= 'C:\Users\nikita\documents\pas\p20.pas';

f:=reset(fn); // открыть файл для чтения

// функция возвращает -1, если по каой-либо причине

// доступ к файлу не получен

if f != -1 then

writeln(fn);

Line('-',length(fn));

n:=0;

while (eof(f) != 1) do // пока не достигнут конец файла

n:=n+1;

st := readstring(f); // читать строку из файла

writeln(n:3, ' ', st);

end;

Line('-',length(fn));

else

writeln('Ошибка доступа к файлу ', fn);

writeln('Неверное имя/путь или файл используется другим приложением');

end;

writeln;

write('Press ');

readln;

end.

// Демонстрирует использование функций GetTime, GetDay,

// GetMonth, GetYear, DayOfWeek

// Возвращает время в формате hh:mm:ss

function TimeToStr(time: integer):string

var

st: string[8];

hour: integer;

min: integer;

sec: integer;

begin

hour:= Trunc(time/60/60);

min:= Trunc((time - hour*3600)/60);

sec:= time- hour*3600 -min*60;

st:='';

if hour < 9 then

st:= '0';

end;

st:= st + IntToStr(hour) +':';

if min < 9 then

st:= st + '0';

end;

st:= st + IntToStr(min) + ':';

if sec < 9 then

st:= st+ '0';

end;

st:= st + IntToStr(sec);

return st;

end;

// возвращет дату в формате dd/mm/yyyy

function ShortDate(day: integer, month: integer, year: integer): string

var

st: string[10];

begin

st:='';

day := getDay();

if day < 10 then

st:='0';

end;

st:= st + IntToStr(day)+'/';

month := getMonth();

if month < 10 then

st:=st+'0';

end;

st:= st+IntToStr(month)+'/';

year := getYear();

st:=st+ IntToStr(year);

return st;

end;

program p1()

var

day: integer;

month: integer;

year: integer;

dayOfweek: integer;

weekDay: array[1..7] of string[11] =

'воскресенье', 'понедельник', 'вторник', 'среда',

'четверг', 'пятница', 'суббота';

monthName: array[1..12] of string[10] =

'январь', 'февраль', 'март', 'апрель', 'май', 'июнь',

'июль', 'август', 'сентябрь', 'октябрь','ноябрь','декабрь';

hour: integer;

min: integer;

sec: integer;

time: integer;

time2: integer;

dtime: integer;

i: integer;

begin

writeln('Сегодня ', getDay(), ' ', monthName[getMonth()],

getYear():5, ', ' , weekDay[getDayOfWeek()+1]);

day := getDay();

dayOfweek:= getDayOfWeek();

month := getMonth();

year := getYear();

writeln('Сегодня ', day, ' ', monthName[month],

year:5, ', ' , weekDay[dayOfweek+1]);

writeln('Сегодня ', day, ' ', monthName[month] , year:5);

writeln('Сегодня ', day, '-', month, '-', year);

time := getTime();

hour:= time div 60 div 60;

min:= (time - hour*3600) div 60;

sec:= time- hour*3600 - min*60;

writeln('Сейчас ', hour, ':', min, ':', sec);

writeln;

writeln;

for i:=1 to 7 do

writeln(i-1:2,' - ', weekDay[i]);

end;

writeln;

day := getDay();

month := getMonth();

year := getYear();

dayOfweek := getDayOfWeek();

time := getTime();

writeln('Today ', ShortDate(day, month, year), ' ',

weekDay[dayOfWeek+1], ' (',dayOfWeek, ')');

writeln;

writeln('Now ', TimeToStr(time));

write('Wait 15 sec and press ');

readln;

time2:=getTime();

writeln('Now ', TimeToStr(time2));

dtime:= time2- time;

writeln('You where waiting ', TimeToStr(dtime));

write('Press ');

readln;

end.

// Hangman game

Program HangmanGame()

const

NW = 8; // количество слов

LW = 15; // максимальное количество букв в слове

TRUE = 1;

FALSE = 0;

var

words: array[1..NW] of string[15] = 'hangman', 'apple', 'pascal',

'russia', 'italia', 'book','notebook','pencil';

secretWord:string[LW];

userWord:string[LW];

ch: string[1]; // буква, введенная пользователем

k: integer; // количество букв, которое ввел игрок

misses:string[15]; // буквы, которых нет в слове (8 букв + 7 запятых)

st: string[LW];

right:integer;

i: integer;

debug: integer; // 1 - режим отладки, показать секретное слово

begin

debug := 1;

writeln;

writeln('Welcome to the Hangman game!');

writeln;

secretWord := words[Random(NW)];

userWord := '';

for i := 1 to Length(secretWord) do

userWord := userWord + '-';

end;

if debug = 1 then

WriteLn('Secret word:',secretWord);

WriteLn('User word:',userWord);

end;

k := 0;

repeat

writeln;

WriteLn('\nСлово:', UpCase(userWord));

WriteLn('Нет букв:', UpCase(misses));

Write('\nБуква>');

ReadLn(ch); // the first character of the entered line

st := '';

right := FALSE;

for i := 1 to Length(secretWord) do

if substr(secretWord,i,1) = ch then

st := st + substr(secretWord,i,1);

if NOT right then

right := TRUE;

end;

else

st := st + substr(userWord,i,1);

end;

end;

userWord := st;

if NOT right then

if Length(misses) = 0 then

misses := misses + ch;

else

misses := misses +',' + ch;

end;

end;

k := k + 1;

until (k = 8) OR (userWord = secretWord);

writeln;

if (userWord = secretWord) then

WriteLn('You are win!');

else

WriteLn('You are lost!');

end;

WriteLn('The seecret word is ', UpCase(secretWord));

Write('\nPress ');

Readln;

end.

// Пользовательский тип: запись

program p1()

const

N = 3;

PI=3.14;

type

TMaterial = record

title: string[15]; // Название англ.

density: float; // плотность

end;

TTabMat = array[1..N] of TMaterial;

function Menu(var materials: TTabMat): integer

var

p: integer; // номер выбранного материала

i: integer;

begin

writeln('\n Материал');

for i:=1 to N do

writeln(i:2, '. ',materials[i].title);

end;

writeln('\n 0 - выход');

write('\n Ваш выбор>');

readln(p);

return p;

end;

var

// таблица материалов - одномерный массив записей

tabmat: TTabMat;

diameter, len: integer; // диаметр и длина стержня

volume, weight: float; // объем и вес стержня

k: integer; // номер материала

begin

tabmat[1].title:='Aluminium';

tabmat[1].density := 2.7;

tabmat[2].title := 'Cooper';

tabmat[2].density := 8.94;

tabmat[3].title := 'Steel';

tabmat[3].density := 7.86;

k := Menu(tabmat);

if (k > 0) and (k <= N)

then

diameter := 21;

len:=350;

volume := PI * (diameter /2) * (diameter /2) * len/1000;

writeln('\n\nДлина:', len, ' мм\nДиаметер:', diameter,' мм');

writeln('Объем:', volume:4:2, 'см.куб.');

writeln('Материал: ', tabmat[k].title, ' (', tabmat[k].density:6:2, ' г/см куб.)');

weight := volume * tabmat[k].density;

write('Масса: ');

if weight < 1000 then

writeln(weight:8:2, ' гр.');

else

writeln(weight/1000:8:2, ' кг.');

end;

end;

write('\n\nPress ');

readln;

end.

// Определенный пользователем одномерный тип-массив (вектор)

// Массив, как параметр функции и процедуры

program p1()

const

N = 5;

type

vector = array[1..N] of integer;

// сумма элементов массива

function SumItems(var v: vector, k: integer): integer

var

s: integer;

i: integer;

begin

s := 0;

for i:=1 to k do

s := s + v[i];

end;

return s;

end;

// возвращает номер максимального элемента

function MaxItem(var v: vector): integer

var

m: integer; // номер максимального элемента

i: integer;

begin

m := 1;

for i := 2 to N do

if v[i] > v[m] then

m := i;

end;

end;

return m;

end;

// вывод вектора

procedure Print(var v: vector)

var

i: integer;

begin

for i:=1 to N-1 do

write(v[i]:4,',');

end;

writeln(v[i]:4);

end;

var

v1: vector; // вектор

sum: integer; // сумма элементов массива (вектора)

m: integer; // номер максимального элемента

i: integer;

begin

for i:=1 to N do

v1[i] := Random(100);

end;

Print(v1); // вывод вектора

sum := SumItems(v1,n);

writeln('\nItems sum: ', sum);

m := maxItem(v1);

writeln('\nMax item:');

writeln(' - index: ',m);

writeln(' - value: ', v1[m]);

write('\nPress ');

readln;

end.

// Тип, определенный пользователем - матрица (двумерный массив)

program p1()

const

N = 5;

type

matrix = array[1..N, 1..N] of integer;

// инициализация матрицы

procedure MatrixInit(var m: matrix, r: integer)

var

i,j: integer;

begin

for i:=1 to N do

for j:=1 to N do

m[i,j] := Random(r);

end;

end;

end;

// сумма матриц

procedure MatrixSum(var m1: matrix, var m2: matrix, var m3: matrix)

var

i,j: integer;

begin

for i:=1 to N do

for j:=1 to N do

m3[i,j] := m1[i,j] + m2[i,j];

end;

end;

end;

// печать матрицы

procedure MatrixPrint(var m: matrix)

var

i,j: integer;

begin

for i:=1 to N do

for j:=1 to N do

write(m[i,j]:5);

end;

writeln;

end;

end;

procedure Line(st:string, len: integer)

var

i: integer;

begin

for i:=1 to len do

write(st);

end;

writeln;

end;

var

m1,m2,m3: matrix; // матрицы

begin

// инициализация матриц

MatrixInit(m1, 100);

MatrixInit(m2, 100);

MatrixSum(m1,m2,m3); // сумма матриц

MatrixPrint(m1);

Line('-', 5*n);

MatrixPrint(m2);

writeln('\n');

Line('-', 5*n);

MatrixPrint(m3);

write('\n\nPress ');

readln;

end.