uses crt;
var
  x,y,z:array[1..64]of integer;
  xi,yi,i,j,stepMix:integer;
begin
  {вводим координаты точки с контролем}
  repeat
    write('Enter x:');
    readln(xi);
  until (xi>0)and(xi<9);
  {вводим координаты точки с контролем}
  repeat
    write('Enter y:');
    readln(yi);
  until (yi>0)and(yi<9);
  {начальные значения первой точки}
  i:=1;
  x[i]:=1;{по горизонтали}
  y[i]:=1;{по вертикали}
  z[i]:=8;{возможное число ходов}
  stepMix:=65;{максимальное возможное количество ходов}
  repeat
    case z[i]of
      { все возможные варианты ходов}
      8:begin x[i+1]:=x[i]+1; y[i+1]:=y[i]+2;end;
      7:begin x[i+1]:=x[i]+2; y[i+1]:=y[i]+1;end;
      6:begin x[i+1]:=x[i]+2; y[i+1]:=y[i]-1;end;
      5:begin x[i+1]:=x[i]+1; y[i+1]:=y[i]-2;end;
      4:begin x[i+1]:=x[i]-1; y[i+1]:=y[i]-2;end;
      3:begin x[i+1]:=x[i]-2; y[i+1]:=y[i]-1;end;
      2:begin x[i+1]:=x[i]-2; y[i+1]:=y[i]+1;end;
      1:begin x[i+1]:=x[i]-1; y[i+1]:=y[i]+2;end;
      {эти строчки можно исключить, но безних я не пробывал}
      -3,
      -2,
      -1,
      0:begin dec(i);end;
      end;
    {проверяем совпадение с нужной точкой }
    if(x[i+1]=xi)and(y[i+1]=yi)then
      begin
        if stepMix>=i then
          begin
            {контрольный вывод всех ходов}
            stepMix:=i;
            for j:=1 to i+1 do write(x[j]:3);writeln('=':3,i:5);
            for j:=1 to i+1 do write(y[j]:3);writeln('=':3,i:5,z[i]:5);
            ReadKey;
          end;
        z[i]:=0;
      end;
    {провеяем попадание в доску 8х8}
    if(x[i+1]>0)and(x[i+1]<9)and(y[i+1]>0)and(y[i+1]<9)and(z[i]>0)then
      begin
        {проверяем повторную точку}
        j:=1;
        while(x[j]<>x[i+1])and(y[j]<>y[i+1])do
          inc(j);
        {уменьшаем количестово ходов для текущей точки}
        dec(z[i]);
        if z[i]<0 then z[i]:=0;
        {если равно, то нет совпадающих координат теперь новая текущая точка}
        if j=(i+1) then
          begin
            inc(i);
            z[i]:=8;
          end;
      end
      else
      begin
        {точка вышла за пределы доски}
        dec(z[i]);
        if z[i]<0 then z[i]:=0;
      end;
    {контрольный вывод
    writeln(i:5,z[i]:5,stepMix:5);
    {цикл коррективки возможных ходов}
    while (z[i]<=0)and(i>0) do dec(i);
  until i=0;
end. 

 program treugolnik;
var n,i,j:integer;
begin
write('n=');readln(n);
for i:=1 to n do
   begin
     for j:=1 to 2*n-1 do
       begin
         if (j=n-i+1)or(j=n+i-1) then
            begin
              write('*')
            end
         else if (i=n)and(j mod 2=1) then
             begin
               write('*');
            end
      else write(' ')
     end;
   writeln;
 end;
readln;
end.
 

  Case (зарезервированное слово)
Оператор Case состоит из выражения (селектора) и списка операторов, каждый из которых выполнится в определенном случае.
 Синтаксис:
 Case выражение Of
  вариант : оператор;
  ...
  вариант : оператор;
 End
или
 Case выражение Of
  вариант : оператор;
  ...
  вариант : оператор;
 Else оператор
 End
 Замечания:
"вариант" состоит из одной или большего количества констант или диапазонов, разделенных запятыми.
Часть "Else" является необязательной.

if <вариант> 
  then <оператор>
  else if <вариант> 
    then <оператор> 
    else if <вариант>
      then <оператор>
      else <оператор>;

uses crt;
const s:array[1..12] of byte=(3,4,7,3,2,8,9,3,5,1,5,0);
var i,k,j:integer;
    a:array[1..20]of integer;
begin
clrscr;
for i:=1 to 12 do
write(s[i],' ');
writeln;
i:=1;k:=0;
while s[i]<>0 do
  begin
    k:=k+1;
    for j:=i+1 to i+s[i] do
    a[k]:=a[k]*10+s[j];
    i:=i+s[i]+1;
  end;
writeln;
writeln('k=',k);
for i:=1 to k do
write(a[i],' ');
readln
end.
  

 const s:array[1..12] of byte=(3,4,7,3,2,8,9,3,5,1,5,0); 

 проверяем совпадение с нужной точкой }
    if(x[i+1]=xi)and(y[i+1]=yi)then
      begin
        if stepMix>=i then
          begin
            {контрольный вывод всех ходов}
            stepMix:=i;
            for j:=1 to i+1 do write(x[j]:3);writeln('=':3,i:5);
            for j:=1 to i+1 do write(y[j]:3);writeln('=':3,i:5,z[i]:5);
            ReadKey;
          end;
        z[i]:=0;
      end; 

 Var
   i, j, s, n: Integer;
   t, x: Array[1..100] Of Integer;

Procedure ReadData;
Begin
     ReadLn(n);
End;

Procedure OverWrite;
Begin
     For j := 1 To s Do
         Begin
              t[j] := x[j];
         End;
End;

Procedure WriteData;
Begin
     For j := 1 To s Do
         Begin
              Write(x[j], ' ');
         End;
End;

Begin
     ReadData;
     s := 1;
     For i := 1 To n Do
         Begin
              OverWrite;
              WriteData;
              For j := 1 To s-1 Do
                  Begin
                       If (j <> 1) Then
                          Begin
                               x[j] := t[j-1] + t[j];
                          End;
                  End;
              x[s] := 1;
              WriteLn;
         End;
     ReadLn;
End. 

 var n,i,j:integer;
{рекурсивная функция}
function F(x,y:integer):integer;
  begin
    {условие выхода из рекурсии}
    if (x=1)or(y=1)then F:=1
      {получаем следующий элемент}
      else F:=F(x-1,y)+F(x,y-1);
  end;
begin
  {вводим число}
  repeat
    write('Enter N:');
    readln(n);
  until n>0;
  {цикл по строкам}
  for i:=1 to n do
    begin
      {цикл в строке}
      for j:=1 to i do write(F(j,i-j+1):3);
      writeln;
    end;
end. 

 Var
   i, j, s, n: Integer;
   t, x: Array[1..100] Of Integer;

Procedure ReadData;
Begin
     ReadLn(n);
End;

Procedure OverWrite;
Begin
     For j := 1 To s Do
         Begin
              t[j] := x[j];
         End;
End;

Procedure WriteData;
Begin
     For j := 1 To s Do
         Begin
              Write(x[j], ' ');
         End;
End;

Begin
     ReadData;
     s := 1;
     For i := 1 To n+1 Do
         Begin
              OverWrite;
              WriteData;
              For j := 1 To s Do
                  Begin
                       If (j <> 1) Then
                          Begin
                               x[j] := t[j-1] + t[j];
                          End;
                  End;
              x[s] := 1;
              WriteLn;
              Inc(s);
         End;
     ReadLn;
End. 

 Var
   a, b, i, k1, k2, ans: Integer;

Procedure ReadData;
Begin
     ReadLn(a, b);
End;

Procedure WriteData;
Begin
     WriteLn(ans);
     ReadLn;
End;

Function Check(i: Integer): Boolean;
Var
   j, k, t: Integer;
   res: Boolean;
   x: Array[1..5] Of Integer;
Begin
     j := 1;
     While (i <> 0) Do
           Begin
                x[j] := i Mod 10;
                Inc(j);
                i := i Div 10;
           End;
     For j := 1 To 4 Do
         Begin
              For k := 1 To 4 Do
                  Begin
                       If (x[j] > x[j+1]) Then
                          Begin
                               t := x[k];
                               x[k] := x[k+1];
                               x[k+1] := t;
                          End;
                  End;
         End;
     For j := 1 To 4 Do
         Begin
              If (x[j] = x[j+1]) Then
                 Begin
                      res := TRUE;
                 End;
         End;
     Check := res;
End;

Begin
     ReadData;
     For i := a To b Do
         Begin
              Inc(k1);
              If (Check(i)) Then
                 Begin
                      Inc(k2);
                 End;
         End;
     ans := k1-k2;
     WriteData;
End.

 

 uses crt;
Var   i, j, s, n: Integer;
      t, x: Array[1..100] Of Integer;
Procedure ReadData;
Begin
write('Vvedite razmer treugolnika n=');
ReadLn(n);
End;
Procedure OverWrite;
Begin
For j := 1 To s Do 
t[j] := x[j];
End;
Procedure WriteData;
Begin 
For j := 1 To s-1 Do
Write(x[j], ' ');
end;
Begin
clrscr;
ReadData;
s := 1;
For i := 0 To n+1 Do
  Begin
    OverWrite;
  	WriteData;
  	For j := 1 To s Do
    x[j] := t[j-1] + t[j];
    x[1]:=1;
    x[s]:=1;
  	WriteLn;
    Inc(s);
  End;
ReadLn;
End.
 

  Var
   i, j, s, n: Integer;
   t, x: Array[1..100] Of Integer;

Procedure ReadData;
Begin
     ReadLn(n);
End;

Procedure OverWrite;
Begin
     For j := 1 To s Do
         Begin
              t[j] := x[j];
         End;
End;

Procedure WriteData;
Begin
     For j := 1 To s-1 Do
         Begin
              Write(x[j], ' ');
         End;
End;

Begin
     ReadData;
     s := 1;
     x[1] := 1;
     For i := 1 To n+1 Do
         Begin
              OverWrite;
              WriteData;
              For j := 1 To s Do
                  Begin
                       If (j <> 1) Then
                          Begin
                               x[j] := t[j-1] + t[j];
                          End;
                  End;
              x[s] := 1;
              If (i <> 1) Then
                 Begin
                      WriteLn;
                 End;
              Inc(s);
         End;
     ReadLn;
End.