side:=n;
for i:=1 to n do
begin
  temp:= mass[i,i];
  mass[i,i]:=mass[i,side];
  mass[i,side]:=temp; 
  side:=side-1;
end; 

Const Base= 10; {основание системы счисления}
      K   =0123456789;
Var z,sum:longint;


BEGIN
  z  :=K;
  Sum:=0;
  repeat
    Sum:=Sum+(z mod Base);
    z  := z div Base;
  until z=0;
  writeln(K,' -> ',Sum);
END.

uses crt;
const ArrayLength = 1000;
var
 n, i: integer;
 res: real;
 x: array [1..ArrayLength] of real;
begin
 clrscr;
 write('n = ');
 readln(n);
 res:=1;
 for i:=1 to n do
 begin
   write('x[',i,'] = ');
   readln(x[i]);
   if i>1 then
     res:=res*(1/x[i-1]+x[i]);
 end;

 write('result = ',res:15:5);
 readln;

end.

A: array[0..9, 1..3] of string =
  (('', '', ''),
    ('сто ', '', 'один '),
    ('двести ', 'двадцать ', 'два '),
    ('триста ', 'тридцать ', 'три '),
    ('четыреста ', 'сорок ', 'четыре '),
    ('пятьсот ', 'пятьдесят ', 'пять '),
    ('шестьсот ', 'шестьдесят ', 'шесть '),
    ('семьсот ', 'семдесят ', 'семь '),
    ('восемьсот ', 'восемдесят ', 'восемь '),
    ('девятьсот ', 'девяносто ', 'девять '));

program Num2Str;
uses crt;

const
  A: array[0..9, 1..3] of string =
  (('', '', ''),
    ('сто ', '', 'один '),
    ('двести ', 'двадцать ', 'два '),
    ('триста ', 'тридцать ', 'три '),
    ('четыреста ', 'сорок ', 'четыре '),
    ('пятьсот ', 'пятьдесят ', 'пять '),
    ('шестьсот ', 'шестьдесят ', 'шесть '),
    ('семьсот ', 'семдесят ', 'семь '),
    ('восемьсот ', 'восемдесят ', 'восемь '),
    ('девятьсот ', 'девяносто ', 'девять '));
  B: array[0..9] of string =
    ('десять ', 'одинадцать ', 'двенадцать ',
     'тринадцать ', 'четырнадцать ', 'пятнадцать ',
     'шестнадцать ', 'семнадцать ', 'восемнадцать ','девятнадцать ');

var
  i, InputNum: integer;
  Numbers: array [1..3] of integer;
  res: string;
begin
  clrscr;
  textcolor(2);
  write('Введите число [0..1000]: ');
  textcolor(white);
  readln(InputNum);
  textcolor(2);
  write('Введено число ');
  if (InputNum<0) or (InputNum>1000) then writeln('введенное число вне допустимого диапазона.')
  else if InputNum=0 then writeln('нуль')
  else if InputNum=1000 then writeln('тысяча')
  else
  begin
    Numbers[1]:=InputNum div 100;
    Numbers[2]:=(InputNum div 10) - Numbers[1]*10;
    Numbers[3]:=InputNum - (Numbers[1]*100 + Numbers[2]*10);

    if Numbers[2]<>1 then
      res:=A[Numbers[1],1]+A[Numbers[2],2]+A[Numbers[3],3]
    else
      res:=A[Numbers[1],1]+B[Numbers[3]];

    textcolor(white);
    write(res);

  end;


  readln;
end.

Type
    PChar =  ^Char;
  Const
    A : array[0..9, 1..3] of pchar =
      (('', '', ''),
      ('sto ', '', 'odin '),
      ('dvesti ', 'dvadcat ', 'dva '),
      ('trista ', 'tridcat ', 'tri '),
  ....................

uses crt, graph;
const
  ArLen = 100;
type
  TProba = record
    X, Y  : longint;
    Param : real;
  end;
  TNumb = array [1..2] of integer;

var
  A: array [1..ArLen] of TProba;
  i, n, index: integer;
  s: string;

procedure InputData;
begin
  write('n = ');
  readln(n);
{  randomize; }
  for i:=1 to n do
  begin
{    A[i].X := random(640);
    A[i].Y := random(480);}
    writeln('Номер точки ',i);
    write('X = ');
    readln(A[i].X);
    write('Y = ');
    readln(A[i].Y);
    write('Param = ');
    readln(A[i].Param);
  end;
end;

procedure SaveData(Path: string);
var
  F : file of TProba;
  fname: string;
  i: integer;
begin
  if Path = '' then fname := 'data.dat'
  else fname := Path;
  Assign(F,fname);
  Rewrite(F);
  for i:=1 to n do
    write(F,A[i]);
  close(F);
end;

procedure LoadData(Path: string);
var
  F : file of TProba;
  fname: string;
  i: integer;
begin
  if Path = '' then fname := 'data.dat'
  else fname := Path;
  Assign(F,fname);
  Reset(F);
  i:=0;
  while not EOF(F) do
  begin
    inc(i);
    read(F,A[i]);
  end;
  n:=i;
end;

procedure Solve(var Slv: TNumb);
var
  i, j, ind1, ind2 : integer;
  Len, NewLen, NewLen2: extended;
begin
  ind1:=1;
  ind2:=2;
  Len:=sqrt(sqr(A[ind1].X-A[ind2].X)+sqr(A[ind1].Y-A[ind2].Y));
  for i:=1 to n-1 do
    for j:=i+1 to n do
    begin
      NewLen:=sqrt(sqr(A[j].X-A[i].X)+sqr(A[j].Y-A[i].Y));
      if NewLen>Len then
      begin
        Len:=NewLen;
        ind1:=i;
        ind2:=j;
      end;
    end;
  Slv[1]:=ind1;
  Slv[2]:=ind2;
end;

procedure OutPutData;
var
  i: integer;
  Slv: TNumb;
begin
  writeln('ЙНННННЛНННННЛННННННННН»');
  writeln('є  X  є  Y  є  Param  є');
  writeln('МНННННОНННННОННННННННН№');
  for i:=1 to n do
     writeln('є',A[i].X:5,'є',A[i].Y:5,'є',A[i].Param:9:2,'є');
  writeln('ИНННННКНННННКНННННННННј');
  writeln;
  Solve(Slv);
  writeln('MaxLen mejdu ',Slv[1],' and ',Slv[2]);
  readln;
end;

procedure DrawPoints;
var
  grDriver: Integer;
  grMode: Integer;
  ErrCode: Integer;
  i: integer;
  Slv: TNumb;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode,'');
  ErrCode := GraphResult;
  if ErrCode = grOk then
  begin
    Solve(Slv);
    SetColor(1);
    line(A[Slv[1]].X,A[Slv[1]].Y,A[Slv[2]].X,A[Slv[2]].Y);
    for i:=1 to n do
      PutPixel(A[i].X,A[i].Y,12);
    Readln;
    CloseGraph;
  end
  else
    Writeln('Graphics error:', GraphErrorMsg(ErrCode));
end;

begin
  repeat
    clrscr;
    writeln('1. Ввод данных');
    writeln('2. Загрузить из файла');
    writeln('3. Сохранить в файл');
    writeln('4. Вывод данных');
    writeln('5. Отрисовка точек');
    writeln('0. Выход');
    writeln;
    write('Ваш выбор: ');
    readln(index);
    if (index>5) or (index<0) then continue;

    clrscr;
    case index of
      1: InputData;
      2: begin
           write('Введите путь к файлу: ');
           readln(s);
           LoadData(s);
         end;
      3: begin
           write('Введите путь к файлу: ');
           readln(s);
           SaveData(s);
         end;
      4: OutPutData;
      5: DrawPoints;
    end;

  until index=0;
end.

i:=1;
while n>0 do
begin
  A[i]:=n mod 10;
  n:=n div 10;   
  inc(i);
end;