masterstvo2012

1.uses crt;
const nmax=20;
var a:array[1..nmax] of integer;
i,n,k,k1,k2,k3:integer;
begin
clrscr;
repeat
write('n=');
readln(n);
until n in [1..nmax];
writeln('Последовательность :');
for i:=1 to n do
begin
a[i]:=-10+random(20);
write(a[i]:4);
end;
writeln;
write('k=');
readln(k);
k1:=0;k2:=0;k3:=0;
for i:=1 to n do
if a[i]>k then
inc(k1)
else
if a[i]<k then
inc(k2)
else
inc(k3);
if k1=0 then
writeln('Нету чисел больших ',k,'.')
else
writeln('Чисел больших ',k,' = ',k1,'.');
if k2=0 then
writeln('Нету чисел меньших ',k,'.')
else
writeln('Чисел меньших ',k,' = ',k2,'.');
if k3=0 then
writeln('Нету чисел равных ',k,'.')
else
writeln('Чисел равных ',k,' = ',k3,'.');
readkey;
end.

2.Var
N:LongInt;
A:Array[1..10] of byte;
i,k,min,max:byte;
Begin
Write('N (<2147482648) = ');
Readln(N);
k:=Trunc(Ln(N)/Ln(10))+1;
for i:=1 to k do
begin
A[k-i+1]:=N mod 10;
N:=N div 10;
end;
min:=10;
max:=0;
for i:=1 to k do
begin
if A[i]>max then max:=A[i];
if A[i]<min then min:=A[i];
end;
for i:=1 to k do
if (A[i]<>min) and (A[i]<>max) then write(A[i]);
Readln;
End.

3.var
mass: array [1..100] of Real;
i, j: integer;
sum: Real;
begin
Randomize;
sum := 0;
for i := 1 to 100 do
begin
mass[i] := sqrt(Random(100));
if (i > 3) then
begin
for j := 2 to i do
if (i mod j) = 0 then break;
if (j = i) then
begin
WriteLn('mass[', i, '] = ', mass[i]:2:2);
sum := sum + mass[i];
end
end
else
begin
WriteLn('mass[', i, '] = ', mass[i]);
sum := sum + mass[i];
end;
end;
WriteLn('sum = ', sum:2:2);
readln;
end.

4.Var
A:Array[1..5,1..3] of byte;
i,j,n:byte;
Ar_Mean:real;
Begin
Randomize;
Ar_Mean:=0;
n:=0;
for i:=1 to 5 do
begin
for j:=1 to 3 do
begin
A[i,j]:=Random(21);
Write(A[i,j]:4);
Ar_Mean:=Ar_Mean+A[i,j]/15;
end;
writeln;
end;
writeln;
writeln('Arithmetic Mean is ',Ar_Mean:0:3);
writeln;
for i:=1 to 5 do
for j:=1 to 3 do
if ((A[i,j] mod 2)=0) and (1.0*A[i,j]<Ar_Mean) then n:=n+1;
writeln('n = ',n);
Readln;
End.

5.uses crt;
const nmax=20;
var a:array[1..nmax,1..nmax] of integer;
n,i,j,mx:integer;
begin
clrscr;
randomize;
repeat
write('Размер матрицы до ',nmax,' n=');
readln(n);
until n in [1..nmax];
writeln('Исходная матрица:');
for i:=1 to n do
begin
for j:=1 to n do
begin
a[i,j]:=random(50);
if (j>=n-i+1)and(j>=i) then
begin
if(i=1)and(j=n) then mx:=a[i,j]
else if a[i,j]>mx then mx:=a[i,j];
textcolor(12);
end
else textcolor(15);
write(a[i,j]:3);
end;
writeln;
end;
textcolor(15);
writeln('Максимальный элемент в выделенной области=',mx);
readln
end.

6.Var
T:Array[1..30] of Integer;
i:Integer;
Begin
Randomize;
for i:=1 to 10 do T[i]:=-12+Random(11);
for i:=11 to 20 do T[i]:=-5+Random(11);
for i:=21 to 30 do T[i]:=Random(11);
for i:=1 to 30 do write(T[i]:4);
writeln;
writeln;
i:=0;
Repeat
i:=i+1;
Until T[i]>0;
Writeln('n = ',i);
Readln
End.

7.program massive
uses crt;
var
a: array[1..10, 1..10] of word;
i,j:word;
begin
for i:=1 to 10 do
for j:=1 to 10 do
readln(a[i,j])
j:=0;
for i:=1 to 10 do j:=j+a[1,i];
for i:=1 to 10 do j:=j+a[i,1];
for i:=1 to 10 do j:=j+a[10,i];
for i:=1 to 10 do j:=j+a[i,10];
clrscr;
write('Сумма значений составляет ');
writeln(j);
writeln('Нажмите любую кнопку для выхода');
readkey;
end.

8.Const
C=['a'..'z']+['A'..'Z']+['а'..'я']+['А'..'Я']+['0'..'9'];
Var
S:String;
L,L_min,i:byte;
Begin
Writeln('Enter the string:');
Readln(S);
L_min:=255;
i:=0;
Repeat
while not (S[i] in C) do i:=i+1;
L:=0;
repeat
L:=L+1;
i:=i+1;
until not (S[i] in C) or (i=Length(S));
if L<L_min then L_min:=L;
Until i=Length(S);
Writeln('Shortest word length is ',L_min);
Readln
End.

9.program xxx;
uses crt;
var S1, S2: string;
i,k,n: integer;
begin
clrscr;
writeln('S1');
readln(S1);
writeln('S2');
readln(S2);
n:=length(S1);
i:=0;
repeat k:= pos(S2, copy(S1, i+1, n));
if k <> 0 then
i:=k;
until k=0;
if(i<>0) then delete(S1, i, length(S2));
writeln(S1);
readln;
end.

10.uses crt;
var
s : string;
i : byte;
begin
clrscr;
readln(s);
i := 1;
while (i<=length(s)) and (s[i] <> 'a') do inc(i);
inc(i);
if i<=length(s) then begin
if not(odd(i)) then inc(i);
while(i<=length(s)) do begin
delete(s,i,1);
inc(i);
end;
end;
writeln('s=',s);
readln;
end.

11.function f(n : integer) : longint;
begin
if n <= 1 then
f := 1
else
f := n * f(n - 1);
end;
var n,m:integer;
begin
writeln('n= ');
read(n);
writeln('m= ');
read(m);
writeln((f(m)*f(m-n))/f(n));
end.

12.type point=record
x:byte;y:byte;end;
var
a:array[1..4] of point;
s:real;
i:byte;

function dlina(x1,y1,x2,y2:byte):real;
begin
dlina := SQRT(sqr(x2-x1)+sqr(y2-y1));
end;

begin
for i:=1 to 4 do
begin
writeln('Vvedite koord ',i,'to4ki');
Readln(a[i].x);Readln(a[i].y);
end;
for i:=1 to 3 do
begin
s:=s+dlina(a[i].x,a[i].y,a[i+1].x,a[i+1].y);

end;
writeln('Perimetr=',s:2:2);
readln;

end.

13.Program zap_14;

Uses Crt;

Const n=10;

Type grafik = record

Fio,dat1,dat2:string[20];

kol:integer;

end;

Var a : array[1..n] of grafik;

i :byte;

BEGIN

ClrScr;

for i:=1 to n do

with a[I] do

begin

Writeln('Введите фамилию, имя, отчество ');

Readln(fio);

Writeln(' Введите дату начала отпуска');

Readln(dat1);

Writeln(' Введите дату окончания отпуска');

Readln(dat2);

Writeln(' Введите количество');

Readln(kol);

End;

Writeln('График отпусков');

for i:=1 to n do

with a[I] do

writeln (fio,' ',dat1,' ',dat2,' ',kol);

Readln;

end.
13.Const
C=['б','в','г','д','ж','з','к','л','м','н','п','р','с ','т','ф','х','ц','ч','ш','щ']+
['Б','В','Г','Д','Ж','З','К','Л','М','Н','П','Р','С ','Т','Ф','Х','Ц','Ч','Ш','Щ'];
Var
S:String;
W:Set of Char;
i:byte;
L:Char;
Begin
W:=[];
Writeln('Enter the string:');
Readln(S);
writeln;
for i:=1 to Length(S) do
if S[i] in C then W:=W+[S[i]];
for L:='б' to 'щ' do
if L in W then write(L+' ');
for L:='Б' to 'Щ' do
if L in W then write(L+' ');
Readln
End.

14.var c: char;
begin
write(' Введите символ: '); readln(c);
writeln(' Символьный код: ', byte(c));
writeln(' Предыдущий символ: ', pred(c));
writeln(Следующий символ ', succ(c));
readln

15.
var x, y: real;
begin
write('x = '); readln(x);
write('y = '); readln(y);
writeln((y >= 2) and (x * x + y * y >= 16) and (x * x + y * y <= 36));
readln
end.

16.Var
a,b,h: real;
Begin
Write('Введите значение a = '); Readln(a);
Write('Введите значение b = '); Readln(b);
Write('Введите значение шага h = '); Readln(h);
While a<=b do
Begin
Writeln(a:0:2,' ',2/3*(sin(1/3*a)):0:4);
a:=a+h;
end;
Readln;
end.

17.const m = 20;
var i, max: integer;
y: array [1..m] of integer;
begin
randomize;
max := -12;
writeln('Исходный массив');
for i := 1 to m do
begin
y[i] := random(21) - 10;
write(y[i]:4);
if not(odd(y[i])) and (y[i] > max) then max := y[i]
end;
writeln;
writeln(‘Максимум = ', max);
readln
end.

18.var h: string;
d: longint;
i, z: integer;
f: boolean;
begin
write(' шестнадцатеричное число= ');
readln(h);
if (length(h) = 0) or ((length(h) = 1) and (h[1] = '-'))
then writeln(‘Число не было введено')
else begin
if h[1] <> '-'
then z := 1
else begin
z := -1;
delete(h, 1, 1)
end;
if (length(h) > 8) or ((length(h) = 8) and (h[1] > 'E'))
then writeln('Количество слишком большое')
else begin
for i := 1 to length(h) do
begin
if h[i] in ['a'..'f'] then h[i] := char(byte(h[i]) - byte('a') + byte('A'));
f := not(h[i] in ['0'..'9', 'A'..'F']);
if f then break
end;
if f
then writeln('Это не шестнадцатеричное число')
else begin
d := 0;
for i := 1 to length(h) do
if h[i] in ['0'..'9']
then d := d * 16 - byte('0') + byte(h[i])
else d := d * 16 - byte('A') + byte(h[i]) + 10;
writeln(Десятичное число = ', z * d)
end;
end
end;
readln
end.

19. uses graph;
var x,y,n,gd,gm,i,c: integer;
begin
write('звезд=');
readln(N);
gd:=detect; {инициализация графики}
initgraph(gd,gm,'');
randomize;
for i:=1 to n do
begin {создаются n точек}
x:=random(640); {случайно распределенные}
y:=random(480); {на экране 640*480 точек}
c:=random(16); { выбор цвета}
setcolor(c);
circle(x,y,1) { оператор рисования окружности}
end;
readln
end.

20.program kot;
uses crt, graph;
var gd,gm:integer;

begin
gd:=detect;
initgraph(gd,gm, 'c:\tp7\bgi');
cleardevice;
SetFillStyle(HatchFill,6);
SetColor(6);
FillEllipse(320,360,80,80);
SetFillStyle(EmptyFill,0);
FillEllipse(320,350,40,60);
SetFillStyle(HatchFill,6);
FillEllipse(320,245,40,40);
FillEllipse(170,400,80,10);
SetFillStyle(SolidFill,white);
FillEllipse(305,245,10,15);
FillEllipse(335,245,10,15);
SetFillStyle(EmptyFill,0);
FillEllipse(305,245,6,10);
FillEllipse(335,245,6,10);
SetColor(white);
SetLineStyle(SolidLn, 0, ThickWidth);
MoveTo(320,255);
LineTo(312,265);
LineTo(328,265);
LineTo(320,255);
LineTo(320,265);
Line(315,265,270,265);
Line(315,265,270,255);
Line(315,265,270,275);
Line(325,265,380,265);
Line(325,265,380,255);
Line(325,265,380,275);
SetColor(6);
MoveTo(280,230);
LineTo(290,180);
LineTo(300,210);
LineTo(280,230);
MoveTo(360,230);
LineTo(350,180);
LineTo(340,210);
LineTo(360,230);
Repeat Until KeyPressed;
ReadKey;
closegraph;
end.

lalka

Тебя что вся группа заставила за них блок схемы делать?
P.S. Блок схема онлайн тебе в помощь.

masterstvo2012

не работает