Сколько я над ней не парился ни чего ни выходит.


Русские неметрические еденицы длины: 1 верста=500 сажней; 1 сажень=3 аршина; 1 аршин=16 вершков; вершок=44.45 мм. Длина отрезка состовляет N вершков. На экран вывести только не нулевые значения.

PS С первого взгляда задача показалась мне не сложной, но как только я начал подбирать формулы. . .

А где задача-то? Что нужно найти? Чему равна длина отрезка в верстах, саженях и т.д.?

Помню, что топ с точно такой же задачей уже создавался... Попробуй поискать.

Лучше бы ты показал тут, как именно ты парился - тогда тебе бы намного быстрее помогли..

какие формулы? Тут нужен в мозгах порядок, больше ничего
Вот, примерно так:

type
  tRusLen= record
    Vrst,Sazn,Arsn,Vrsk: LongInt;
  end;


procedure MetrToRus(L: double; var r: tRusLen);
const
  SaznInVrst= 500;
  ArsnInSazn= 3;
  VrskInArsn= 16;
  MetrInVrsk= 0.04445;
  MetrInArsn= MetrInVrsk*VrskInArsn;
  MetrInSazn= MetrInArsn*ArsnInSazn;
  MetrInVrst= MetrInSazn*SaznInVrst;
begin
  L:=L+1e-5;
  with r do begin
    Vrst:= Trunc(L/MetrInVrst);
    L:= L-Vrst*MetrInVrst;
    Sazn:= Trunc(L/MetrInSazn);
    L:= L-Sazn*MetrInSazn;
    Arsn:= Trunc(L/MetrInArsn);
    L:= L-Arsn*MetrInArsn;
    Vrsk:= Trunc(L/MetrInVrsk)
  end
end;


function RusUnits(n: LongInt; s1,s2,s3: string): string;
var
  i: LongInt;
begin
  i:= n mod 100;
  if i div 10 = 1 then RusUnits:=s3
  else case i mod 10 of
    1: RusUnits:=s1;
    2..4: RusUnits:=s2;
    else RusUnits:=s3
  end
end;


function RusLenToStr(r: tRusLen): string;
var
  s,t,v: string;
begin
  s:='';
  t:='';
  with r do begin
    if Vrst>0 then begin
      Str(Vrst,v);
      t:=v+' верст'+RusUnits(Vrst,'а','ы','');
      s:=' '
    end;
    if Sazn>0 then begin
      Str(Sazn,v);
      t:=t+s+v+' сажен'+RusUnits(Sazn,'ь','и','ей');
      s:=' '
    end;
    if Arsn>0 then begin
      Str(Arsn,v);
      t:=t+s+v+' аршин'+RusUnits(Arsn,'','а','ов');
      s:=' '
    end;
    if Vrsk>0 then begin
      Str(Vrsk,v);
      t:=t+s+v+' верш'+RusUnits(Vrsk,'ок','ка','ков')
    end
  end;
  RusLenToStr:=t
end;


var
  l: double;
  r: tRusLen;
  s: string;

begin
  Write('Введите длину в метрах (для ввода случайной величины введите 0): ');
  ReadLn(L);
  if L=0 then l:=Random*1e5;
  MetrToRus(l,r);
  WriteLn(l:10:6,' meters = ',RusLenToStr(r));
  ReadLn
end.

P.S.
Исправил ошибку в RusLenToStr

P.P.S.
.. и еще чуток изменил - для благозвучия..

и в номинации "Программа с самым грамотным интерфейсом" побеждает...