Файл: Сборник-задач-на-Языке-Turbo-Pascal.doc

Программа, загадывающая число от 0 до 10. Если пользователь его угадывает, то программа поздравляет его, а если нет, то просит попытаться ещё раз, но убавляя количество призовых баллов.

Рrogram roulette;

Uses Crt;

var number, guess, bonus: byte;

Вegin

Clrscr;

bonus:=10;

Randomize;

number := Random(ll);

writeln('Задумано целое число от 0 до 10. Угадайте!');

writeln;

wr1teln('Введите целое число от 0 до 10');

readln(guess);

while guess <> number do

begin

Dec(bonus);

writeln('Bы не угадали.');

writeln;

if guess < number then writeln('Ваше число меньше задуманного')

else

writeln('Ваше число больше задуманного');

writeln('Попытайтесь еще раз!');

readln(guess);

end;

writeln('Поздравляю! Вы угадали и набрали ', bonus, ' очков');

readln;

Еnd.

Вычисление произведения пары неотрицательных вещественных чисел вводимых с клавиатуры и сумму всех чисел.

Program cycle;

Uses Crt;

var x, y, sum: real;

otv: char;

Begin

Clrscr;

sum:=0;

repeat

write('Введите числа x,y > 0 ');

readln(x,y);

writeln('Их произведение = ',x*y:8:3);

sum:=sum+x+y;

write('Завершить программу (Д/Н)? ');

readln(otv);

until (otv='Д') or (otv='д');

writeln('Общая сумма = ',sum:8:3);

readln;

End.

Программа, определяющая является ли число совершенным. Число является совершенным, если оно равно сумме всех своих делителей, включая единицу. (Например 6=1+2+3, 28=1+2+4+7+14).

Program sover;

Uses Crt;

var а, i, s : Integer;

Begin

Clrscr;

write('Введите целое число а:');

readln(a);

s := 0;

for i := 1 to a div 2 do

if a mod i = 0 then

begin

s : = s + i;

write('+', i);

end;

if s =a then writeln('Число ', a, 'совершенное')

else writeln('Число ', a, ' не совершенное');

readln;

End.

Программа печати всех делителей натурального числа A.

Programdelit;

Uses Crt;

var a,n,c,d:word;

Вegin

CIrScr;

readln( a );

n:=1;

while ( n <= sqrt(a) ) do begin

c:=a mod n;

d:=a div n;

if c = 0 then begin

writeln( n );

if n <> d then writeln( d );

end;

inc( n );

end;

readln;

Еnd.

Программа печати всех совершенных чисел до 10000.

Programstrong;

Uses Crt;

var n,i,j,s,lim,c,d : word;

Вegin

CIrScr;

for i:=1 to 1000 do

begin

s:=1; lim:=round(sqrt(i));

for j:=2 to lim do

begin

c:=i mod j;

d:=i div j;

if c = 0 then

begin

inc(s,j);

if (j<>d) then inc(s,d); {дважды не складывать корень числа}

end;

if s=i then writeln(i);

end;

readln;

Еnd.

Программу вывода на экран всех простых чисел до 500.

Programprost;

Uses Crt;

const LIMIT = 500;

var i,j,lim : word;

Вegin

CIrScr;

writeln; {перевод строки, начинаем с новой строки}

for i:=1 to LIMIT do begin

j:=2; lim:=round(sqrt(i));

while (i mod j <> 0) and (j <= lim) do inc( j );

if (j > lim) then write( i,' ' );

end;

readln;

Еnd.

Подсчет суммы цифр числа.

Programsumma;

Uses Crt;

var a,x: integer;

i,s: integer;

Вegin

CIrScr;

writeln('введите целое число');

readln( a ); x:=a;

s:=0;

while ( x<>0 ) do

begin

s := s + (x mod 10);

x := x div 10;

end;

writeln( 'Сумма цифр числа ',a,' = ', s );

readln;

Еnd.

Программа перевода чисел из десятичной системы счисления в римскую (от 1 до 3999 включительно).

Programdectoroman;

Uses Crt;

const rom: array[1..13] of string[2] = ('I’, ‘IV’, ‘V’, ‘IX’, 'X', 'XL', 'L', 'XC', 'С', 'CD', 'D', 'CM', 'M');

dec: array[1..13] of word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);

var n: word;

s: string;

i: byte;

Begin

Clrscr;

write('Введите число в десятичной системе счисления: ');

readin(n) ;

s := ‘ ‘;

i := 13;

while n <> 0 do

begin

while n >= dec[i] do

begin

n : = n - dec[ i ];

s := s + rom[i];

end;

i := i – 1;

end;

writeln('Число в римской системе счисления: ', s);

readln;

End.

Кодировка: Пример простой кодировки (сдвиг по ключу)

-----------------------------------------------------------------------------------------------------

Алгоритм: каждый код символа увеличивается на некоторое число - "ключ"

-----------------------------------------------------------------------------------------------------

Programkod;

Uses Crt;

var s: string;

i, key: integer;

Вegin

CIrScr;

writeln('Введите текст');

readln(s);

writeln('Введите ключ (число от 1 до 255)');

readln(key);

for i:=1 to length(s) do s[i]:=char( ord(s[i]) + key );

writeln('Зашифрованный текст: ',s);

readln;

Еnd.

Обработка текста: Разрешение ввода только цифр

----------------------------------------------------------------------------------

На входе - текст с цифрами (но будут вводиться только цифры)

----------------------------------------------------------------------------------

Programnumber;

Uses Crt;

const ENTER #13;

var c:char;

Вegin

CIrScr;

writeln('Вводите буквы и цифры');

c:=readkey;

while (c<>ENTER) do

begin

if c in ['0'..'9'] then write(c);

c:=readkey;

end;

writeln;

readln;

Еnd.

Массивы

Одномерный массив

Var Имя массива : array[начальный индекс .. конечный индекс] of тип данных;

Двумерный массив

Var Имя массива : array[номер первой строки .. номер последней строки , номер первого столбца номер последнего столбца] of тип элементов массива;

Вычисление значения многочлена степени N, коэффициенты которого находятся в массиве A в точке X по схеме Горнера.

Pn(x) = A[0]*X^n + A[1]*X^(n-1) + ... + A[n-1]*X + A[n] =

= (...((A[0]*X + A[1])*X + A[2])*X + ... + A[n-1])*X + A[n].

Program Scheme Gorner;

type Mas = array[0..100] of integer;

var A: Mas;

i, j, n: integer;

x, p: real;

Begin

write('степень многочлена = ');

readln(n);

writeln('введите целые коэффициенты : ');

for i:=0 to n do read(A[i]);

write('значение X = ');

readln(x);

p:=0;

for i:=0 to n do p:=p*x+A[i];

writeln('Pn(X) = ',p);

readln;

End.

Вычисление суммы элементов заданного одномерного числового массива А=(а₁, а₂, …, а_n).

Program Summa;

UsesCrt;

TypeMas = Array [1..20] of Real;

varA : Mas;

i, N : Integer;

S : Real;

Begin

CIrScr;

write('Введите N =');

readln(N);

For i := 1 to N do

begin

write('A [', i ,']=');

readln(A[i]);

end;

S := 0;

For i := 1 to N do S := S+A[i];

writeln;

writeln('Cyммa равна', S : 5 :1);

readln;

End.

Программа выводящая на экран таблицу сложения натуральных чисел от 1 до 9.

Рrogram addition table;

UsesCrt;

constn = 9;

var

a : array [1..9, 1..9] of Integer;

i, j : Integer;

Вegin

CIrScr;

for i : = 1 to n do

for j := 1 to n do a[i ,j] := i + j;

for i := 1 to n do

begin

for j := 1 to n do write(a[i, j], ‘ | ‘);

writeln;

end;

readln;

Еnd.

Формирование нового одномерного массива из элементов заданного массива. (Дан массив X(N). Получим новый массивY(N), такой, что в нём сначала идут положительные числа, затем нулевые и затем отрицательные из Х).

ProgramNewOrder;

UsesCrt;

varN, i, k : Integer;

X,Y : Array [1..20] of Real;

Begin

CIrScr;

Write(‘ Введите N =');

readln(N);

For i := 1 to N do

begin

Write('X[', i,' ] = ');

readln(X[i]);

end;

k:=0;

For i := 1 to N do

If X[i]>0 then

begin

k:=k+l;

Y[k]:=X[i];

end;

For i := 1 to N do

If X[i]=0 then

begin

k:=k+l;

Y[k]:=X[i];

end;

For i:= 1 to N do

If X[i]<0 then

begin

k:=k+l;

Y[k]:=X[i];

end;

write('O т в е т: полученный массив');

For i := 1 to N do write(Y[i]: 5 : 1);

writeln;

readln;

End.

Формирование списка кандидатов в школьную баскетбольную команду. (В баскетбольную команду могут быть приняты ученики, рост которых превышает 170 см).

Program BascetBall;

Uses Crt;

var

SurName : Array [1..30] of String; { фамилии учеников}

Height : Array [ 1.. 30]ofReal; { рост учеников }

Cand : Array [ 1.. 30] of String; { фамилии кандидатов }

NPupil, i, К : Integer { NPupil - число учеников, К — количество зачисленных}

Begin

CIrScr;

write('B КОМАНДУ ЗАЧИСЛЯЮТСЯ УЧЕНИКИ,');

writeln('POCT КОТОРЫХ ПРЕВЫШАЕТ 170CM.');

writeln;

write('Cколько всего учеников ?');

readln(NPupil);

writeln(‘ Введите фамилии и рост учеников:');

For i := 1 to NPupil do

begin

write(i,'. Фамилия -');

readln(SurName[i]);

write(' Рост-');

readln(Height[i]);

end;

writeln;

K:=0; { Составление списка команды}

For i := 1 to NPupil do

If Height[i]>170 then

begin

K:=K+1;

Cand[K] := SurName[i];

end;

If K=0 then writeln('B КЛАССЕ НЕТ КАНДИДАТОВ В КОМАНДУ.')

else

begin

writeln(‘KAHДИДATbI В БАСКЕТБОЛЬНУЮ КОМАНДУ:');

For i := 1 to К do writeln( i, '. ', Cand[i]);

end;

readln;

End.

Подсчет суммы элементов двухмерного массива.

ProgramNewOrder;

UsesCrt;

var a:array[1..10,1..2] of integer;

s:longint;

i,j:integer;

Вegin

CIrScr;

writeln('введете 20 элементов массива');

s:=0;

for i:=1 to 10 do

begin

for j:=1 to 2 do

begin

readln( a[i,j] );

s:=s+a[i,j];

end;

writeln( 'Сумма элементов массива = ', s );

readln;

Еnd.

Поиск максимального элемента в массиве.

Programmax;

UsesCrt;

var a: array[1..10] of integer;

max: integer;

i: integer;

Вegin

writeln('введите 10 элементов массива');

max:=-(MAXINT+1);

for i:=1 to 10 do

begin

readln( a[i] );

if max<a[i] then max:=a[i];

end;

writeln( 'Максимальный элемент массива = ', max );

readln;

Еnd.

Поиск среднего арифметического в массиве.

Programsred;

UsesCrt;

var a: array[1..10] of integer;

s: longint;

i, n: integer;

Вegin

Смотрите также файлы

Самоучитель.doc

Самопрезентация.doc

с-р гс11.doc

Русский конспект.doc

Русская литература (Надиктованные).docx

Файл: Сборник-задач-на-Языке-Turbo-Pascal.doc

Смотрите также файлы

Информация

Списки файлов

Дополнительно