Перечислить все натуральные числа, не превосходящие заданного N

 var
 
 n,i,rd,dc:integer;
  a:longint;
 
begin
write('Vvedite naturalnoe chislo ');
readln(n);
for i:=1 to n do begin
rd:=i;
a:=1;
dc:=0;
while rd>0 do begin
dc:=dc+((rd mod 2)*a);
rd:=rd div 2;
a:=a*10;
end;
writeln(i,'=',dc);
end;
readln;
end.

for i:=1 to n do begin
if разряды в числе i образуют арифм.прогрессию then
   writeln(i);
end;

for i:=1 to n do begin
if arifm(i) then
   writeln(i);
end;

function arifm(a:longint):boolean;
begin
каким-то образом выяснить образуют ли разряды числа a
арифметическую прогрессию.
если образуют, то  arifm:=true; иначе arifm:=false;
end;

function arifm(a:longint):boolean;
var k,p,d:integer;
begin
 k:=0; {номер очередного разряда}
 p:=0; {номер предыдущего разряда}
 d:=0; {разность арифм.прогрессии}
 arifm:=true;
 while a<>0 do begin
  if odd(a) then begin
  {очередной разряд единичный}
   If (d>0)and (p+d <>k) then begin
   {нарушение - единичный разряд не через d }
           a:=0;
           arifm:=false;
   end else begin
         if (d=0) and (k<>p) then d:=k-p;
         p:=k;
   end
  end
  else {очередной разряд нулевой}
      if (d>0) and (p+d=k) then begin
      {нарушение - нулевой разряд через d }
          a:=0;
          arifm:=false;
      end;
  a:=a div 2;
  inc(k);
 end;
{единственный единичный разряд тоже считаем арифм.прогрессией}
{если это неверно, то следующую строчку раскомментировать}
{if d=0 then arifm:=false;}
end;