Program z1;

 Uses Crt;

 Var j,i, b,c: integer;

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

 Begin

   ClrScr;

   Randomize;

  for j:=1 to 10 do

  begin

   For i:=1 to 10 do

   begin

    a[j,i]:=random(9)+1;

    Write (' ', a[j,i]);

   end;

   WriteLn;

  end;

 for j:=1 to 10 do

  begin

   For i:=1 to 10 do

   begin

   if i=j then a[j,i]:=0;

    if i=11-j then a[j,i]:=0;

   end;

  end;

    WriteLn;

  for j:=1 to 10 do

  begin

   For i:=1 to 10 do

   begin

   textcolor(0);

   if a[j,i]=0 then textcolor(1);

   Write (' ', a[j,i]);

   end;

   WriteLn;

  end;

Program  case1; {  множественный выбор}

uses crt;

Var    a,b: integer;

         c: char;

begin

gotoxy(30,8);

write ('Введите выражение  ');

read (a,c,b);

gotoxy(40,10);

case   c  of { выбор значений селектора c}

'+': writeln (' = ',a+b);

'-': writeln (' = ',a-b);

'*': writeln (' = ',a*b);

'/': writeln (' = ',a/b);

else

 writeln ('ввод неверен');

end; {завершение оператора case}

end .

Запись.

Program zap_1;

uses crt;

Type student = record

n : integer ;

fio : string[40] ;

bal : array [1..3] of integer

end;

Var spisok : student ;

i, j, kol, s : integer; sr : real;

Begin

kol:=0;

With spisok do

For i:=1 to 3 do

Begin

n:=i;

Write (' введите фамилию ', i ,' ');

Readln (fio);

s:=0;

For j:= 1 to 3 do

 Begin

 write ( 'введите оценку: ' );

 readln ( bal [j] );

 s := s+ bal [j];

end;

if s=15 then kol:=kol+1;

sr := s/3; writeln ( fio, ', средний бал = ', sr:4:1);

end;

writeln ( ' количество отличников ', kol );

readln;

end.

//На олимпиаде по информатике на школьников заполнялась анкета, содержащая следующую информацию: фамилия, номер школы, класс, набранный балл. Напечатайте:

//1. списки учеников, занявших первое место, и указать их класс.

//2. какие из школ не заняли призовых мест;

Program n1;

uses crt;

Const n=10;

      surname:array[0..3] of string[7]=('Ivanov','Petrov','Sidorov','Semenov');

Type school=record

     sname:string[7];

     nomer:integer;

     klas:integer;

     bal:integer;

     end;

Var ol:array[1..n] of school;

    m1,m2,m3,i:integer;

Begin

 randomize;

 writeln('SURNAME SCHOOL KLAS BAL');

 for i:=1 to n do

  begin

   ol[i].sname:=surname[random(4)];

   ol[i].nomer:=10+random(10);

   ol[i].klas:=5+random(7);

   ol[i].bal:=random(50);

   writeln(ol[i].sname:7,ol[i].nomer:7,ol[i].klas:5,ol[i].bal:4);

  end;

 m1:=1;m2:=2;m3:=3;

 for i:=1 to n do

  if ol[i].bal>ol[m1].bal then m1:=i;

 for i:=1 to n do

  if (ol[i].bal<>ol[m1].bal)and(ol[i].bal>ol[m2].bal) then m2:=i;

 for i:=1 to n do

  if (ol[i].bal<>ol[m1].bal)and(ol[i].bal<>ol[m2].bal)and(ol[i].bal>ol[m3].bal) then m3:=i;

 writeln('Pervoe mesto:');

 for i:=1 to n do

  if ol[i].bal=ol[m1].bal then

   writeln(ol[i].sname:8,ol[i].klas:3);

 writeln('Ne zanyli prizovih mest:');

 for i:=1 to n do

  if (ol[i].nomer<>ol[m1].nomer)and(ol[i].nomer<>ol[m2].nomer)and(ol[i].nomer<>ol[m3].nomer)and

     (ol[i].bal<>ol[m1].bal)and(ol[i].bal<>ol[m2].bal)and(ol[i].bal<>ol[m3].nomer) then

   write(ol[i].nomer:4);

End.

Заполнить рабочее окно квадратиками 10х10 по спирали от левого верхнего угла к центру против часовой стрелки.

Program rspo;

Uses GraphABC, crt;

VAr uu,w,a,b,i,x,y: integer;

Begin

ClrScr;

a:=1; b:=1;x:=60;y:=38;

for uu:=1 to 20 do

 begin

for i:=1 to x do

 begin rectangle (a,b,a+10,b+10); floodfill (a+5,b+5,clGreen); a:=a+10;delay(10);end;

for i:=1 to y do

 begin rectangle (a,b,a+10,b+10);b:=b+10;delay(10);end;

for i:=1 to x do

 begin rectangle (a,b,a+10,b+10);    floodfill (a+5,b+5,clGreen);a:=a-10;delay(10);end;

for i:=1 to y do

 begin rectangle (a,b,a+10,b+10);b:=b-10;delay(10);end;

delay(1000);

x:=x-2; y:=y-2;a:=a+10;b:=b+10;

end;

end.

Создать "многоразовый" калькулятор.

Program  case1; {  множественный выбор}

uses crt;

Var    a,b: integer;

         c: char;

begin

gotoxy(30,8);

write ('Введите выражение  ');

read (a,c,b);

gotoxy(40,10);

case   c  of { выбор значений селектора c}

'+': writeln (' = ',a+b);

'-': writeln (' = ',a-b);

'*': writeln (' = ',a*b);

'/': writeln (' = ',a/b);

else

 writeln ('ввод неверен');

end; {завершение оператора case}

end .

Создать одномерный массив из 100 случайных чисел. Посчитать количество пятерок

Program z1;

 Uses Crt;

 Var i,s: integer;

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

 Begin

   ClrScr;

   Randomize;

   s:=0;

  For i:=1 to 100 do

   begin

    textcolor(9);

    a[i]:=random(9)+1;

    if a[i]=5 then begin s:=s+1; textcolor(2); end;

    Write (' ', a[i]);

    Delay (50);

   end;

   WriteLn;

   writeln(s);

 end.

Program z1;

 Uses Crt;

 Var j,i, b,c: integer;

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

 Begin

   ClrScr;

   Randomize;

  for j:=1 to 10 do

  begin

   For i:=1 to 10 do

   begin

    a[j,i]:=random(9)+1;

    Write (' ', a[j,i]);

   end;

   WriteLn;

  end;

  end.

Сортировка

Program z1;

 Uses Crt;

 Var i,m,j: integer;

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

Begin

   ClrScr;

   randomize;

      for i:= 1 to 100 do

     begin

      textcolor (4);

      a[i]:=random(100)+1;

      write (' ', a[i]);

      delay(100);

     end;

  writeln;

   writeln;

  for j:=1 to 100 do

  for i:= 1 to 99 do

     begin

      textcolor (4);

      if a[i]>a[i+1] then

         begin

          m:=a[i]; a[i]:=a[i+1];a[i+1]:=m;

         end;

     end;

     for i:= 1 to 100 do

     begin

      textcolor (4);

      write (' ', a[i]);

      delay(100);

     end;

end.