блок-схемы

uses crt;
var Xd1,Xd2,Yd1,Yd2,by:integer; S,p:real;
begin
clrscr;
writeln('vvedite koordinati diaganaley v vvide radius vektorov:');
write('X(d1)=');
read(Xd1);
write('Y(d1)=');
read(Yd1);
write('X(d2)=');
read(Xd2);
write('Y(d2)=');
read(Yd2);
By:=abs(Yd2);
S:=by*(abs(Xd1)+abs(Xd2))/2;
P:=by+abs(xd1)+abs(xd2)+sqrt(sqr(xd2-xd1)+sqr(abs(yd1)));
if (((yd1=yd2) or (yd1=(-1*yd2)))) and (xd1<>(-1*xd2)) then  begin
writeln('S=',s:4:2);
Writeln('P=',p:4:2) ;
end
else
writeln('Vvedenie koordinati ne sootvetstvuut trapecii');
RePeAT UNTIL KeYPReSSed;
end.

uses crt;
var   a,b:array[1..100] of integer;
 c:array[1..200] of integer; i,j,n,m:integer;
begin
clrscr;
write('vvedite kol-vo elementov v massive A[1..100]:');
read(n);
 
write('vvedite kol-vo elementov v massive B[1..100]:');
read(m);
j:=1;
for i:=1 to n do begin
write('A[',i,']=');
readln(a[i]);
C[j]:=a[i];
j:=j+1;
end;
for i:=1 to m do begin
write('B[',i,']=');
readln(B[i]);
C[j]:=B[i];
j:=j+1;
end;
for i:=1 to j-1 do begin
write(C[i]:4);
if i mod 4 = 0 then writeln;
end;
repeat until keypressed;
end.

uses crt;
var s,s1,s2,s3,buf:string;
begin
clrscr;
s:='kolkatenasiya';
s1:=copy(s,8,6);
writeln(s1);
s2:=copy(s,4,3);
 
s2:=s2+s[2]+s[1];
writeln(s2);
buf:=s[6]+s[5];
s3:=copy(s,10,2)+buf+buf;
writeln(s3);
 
repeat until keypressed;
end.

uses crt;
  var  pc,pcb:array[1..100] of string; e:string;
  n,i,j:integer;  k,k1,p:real;
  begin
  clrscr;
  write('vvedite kollichestvo modeley PC:');
  read(n);
  writeln('nazvanie doljno bit vida <Nazvanie Chastota processora Mhz (okruglit do 100mhz)> ');
  e:='Pentium III 1600 Mhz';
  p:=100;
  for i:=1 to length(e) do begin
  if (e[i]='1') or (e[i]='2') or (e[i]='3') or (e[i]='4')
 or (e[i]='5') or (e[i]='6') or (e[i]='7') or (e[i]='8')
 or (e[i]='9') or (e[i]='0')  then begin
  k:=k+p*ord(e[i]);
  p:=p / 10;
  end;
  end;
  p:=100;
for i:=1 to n+1 do begin
  readln(pc[i]);
  end;
writeln;
writeln;
for i:=1 to n+1 do begin
  for j:=1 to length(pc[i]) do begin
      if (pc[i][j]='1') or (pc[i][j]='2') or (pc[i][j]='3') or (pc[i][j]='4')
 or (pc[i][j]='5') or (pc[i][j]='6') or (pc[i][j]='7') or (pc[i][j]='8')
 or (pc[i][j]='9') or (pc[i][j]='0')  then
  begin
  k1:=k1+p*ord(pc[i][j]);
  p:=p / 10;
  end;
  end;
    if k1>k then  writeln(pc[i]);
  k1:=0;
  p:=100;
  end;
  repeat until keypressed;
  end.

uses graph;
var d,m,r,i:integer;
begin
 detectGraph(D,M);
 
  initGraph(d,m,'\bgi');
setcolor(red);
setfillstyle(1,red);
rectangle(10,470,630,10);
floodfill(320,240,red);
r:=220;
for i:=1 to 10 do begin
  setfillstyle(1,i);
  setcolor(i);
  circle(320,240,r);
 floodfill(320,240,i);
  r:=r-20;
  end;
 readln;
 end.

uses graph;
var y1,x1,x2,y2,d,m,r,i:integer; x,y:real   ;
begin
 detectGraph(D,M);
 
  initGraph(d,m,'\bgi');
setcolor(white);
line(20,380,590,380);
 
line(60,50,60,430);
OUTtextXY(10,10,'y=(cos(7*x)+1)/sqr(x+1)');
 
for x1:=1 to 300 do begin
x:=x1/100;
y:=(cos(7*x)+1)/sqr(x+1);
y1:=round(y*100);
if x<=2*pi then  putpixel(60+x1,380-y1,white);
 
end;
 
 
outtextXY(350,390,'2pi');
 
outtextXY(50,180,'1');
 
outtextXY(50,370,'O');
outtextXY(50,50,'Y');
outtextXY(590,390,'X');
 
 
 readln;
 end.

uses graph;
var y1,x1,x2,y2,d,m,r,i:integer; x,y:real   ;
begin
 detectGraph(D,M);
 
  initGraph(d,m,'\bgi');
setcolor(white);
line(50,240,590,240);
 
line(320,50,320,430);
OUTtextXY(10,10,'y=x^3');
x:=0;
y1:=0;
for x1:=1 to 51 do begin
 
y:=x*x*x;
y1:=round(y) div 5;
putpixel(x1+320,240-y1,white);
putpixel(320-x1,240+y1,white);
 
 
x:=x+0.2;
 
end;
outtextXY(310,230,'O');
outtextXY(310,50,'Y');
outtextXY(590,250,'X');
 
 
 readln;
 end.

program odnomernui_massuv;
uses crt;
var A:array[1..100] of integer;
    n,i,j,imax: byte;
    buf:integer;
begin
write('Размер массива от 1 до 100 n=');
readln(n);
//ручной ввод массива
writeLn('Вводим элементы массива A:');
for I:=1 TO N do
 begin
  write('A[',i,']=');
  readLn (A[i]);
 end;
//Вывод массива до изменения
writeLn('исходный массив  A:');
for i:=1 to N do
write (A[i]:5);
writeLn;
//поиск максимума в серии
imax:=1;
for i:=1 to N do
if A[i]>A[imax] then
imax:=i;
writeln('максимальный элемент под номером = ',imax);
if imax>n-2 then write('Элементов для сортировки нет!')
else
 begin
  for i:=imax+1 to n-1 do
  for j:=i+1 to n do
  if A[i]>A[j] then
   begin
    buf:=A[i];
    A[i]:=A[j];
    A[j]:=buf;
   end;
 end;
  writeln('Элементы после максимального отсортированы по возрастанию:');
  for i:=1 to n do
  write(A[i],' ');
end.

program odnomernui_massuv;
uses crt;
var A:array[1..100] of integer;
    n,i,j,imin: byte;
    buf:integer;
begin
write('Размер массива от 1 до 100 n=');
readln(n);
//ручной ввод массива
writeLn('Вводим элементы массива A:');
for I:=1 TO N do
 begin
  write('A[',i,']=');
  readLn (A[i]);
 end;
//Вывод массива до изменения
writeLn('исходный массив  A:');
for i:=1 to N do
write (A[i]:5);
writeLn;
//поиск минимума в серии
imin:=1;
for i:=1 to N do
if A[i]<A[imin] then
imin:=i;
writeln('минимальный элемент под номером =',imin);
if imin>n-2 then write('Элементов для сортировки нет!')
else
 begin
  for i:=imin+1 to n-1 do
  for j:=i+1 to n do
  if A[i]<A[j] then
   begin
    buf:=A[i];
    A[i]:=A[j];
    A[j]:=buf;
   end;
  writeln('Элементы после минимального отсортированы по убыванию:');
  for i:=1 to n do
  write(A[i],' ');
 end;
end.

uses
    crt;
var
   a:array[1..100,1..100] of integer;
   i,j,k,sum,n:integer;
begin
     writeln('wvedite razmernost matrci ');
     readln(n);
     writeln('wvedite matricu razmerom ',n,' x ',n);
     for i:= 1 to n do
         for j:= 1 to n do
             read(a[i,j]);
     k:=0;
     sum:=1;
     for i:= 1 to n do
         for j:= 1 to n do
             if i<j then
                begin
                     k:=k+1;
                     sum:=sum*a[i,j];
                end;
writeln('kol-vo elementov nad glavnoy diaganaliy ravno ',k);
writeln('proizvedenie ih ravno ',sum);
readkey
end.