Помогите решить задачу на работу с файлами., Заданное число, от 1 до 1999, напечатать римскими цифрами XLVI и т.д. Опции

[User]

Я хочу, чтобы те числа, которые написаны с ошибкой, т.е. в них присутствует символ просто также и записывались в файл. Помогите найти ошибку в программе.

uses crt;

const
   Romans: array[1..13] of string=('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
   Arabics:array[1..13]of integer=(1,4,5,9,10,40,50,90,100,400,500,900,1000);
{функция перевода чисел в римские}
function Roman(var fz2:text;var str:string; Decimal:integer):string;
var
   i,code:integer;
   scratch:string;
begin
         val(str,decimal,code);
         if code=0 then
            begin
               scratch:='';
               for i:=13 downto 1 do
                      while (Decimal>=Arabics[i]) do
                           begin
                                Decimal:=Decimal-Arabics[i];
                                scratch:=scratch+Romans[i];
                           end;
                      Roman:=scratch;
            end
         else
            write(fz2,str);
end;
var 
    str1,fo,fz:string;
    i,n,arb:integer;
    fo1,fz1:text;
    ch1:char;
begin
   clrscr; 
   writeln('Введите имя файла с исходными данными');
   readln(fo);
   assign(fo1,fo);
   {$I-}
   writeln('Введите имя файла, куда необходимо записать результат');
   readln(fz);
   assign(fz1,fz);
   reset(fo1);
   {$I+}
   rewrite(fz1); 
   n:=0;   {считаю количество строк в файле}
   while not eof(fo1) do
      begin
         readln(fo1,str1);
         n:=n+1;
     end; 
   while not eof (fo1)do 
      begin
         for i:=1 to n do
            begin
               read(fo1,str1);
              write(fz1,Roman(fz1,str1,arb),' ');
            end;
      end;
   write('Файл записан');
   close(fo1);
   close(fz1);
   readln;
end.

Сообщение отредактировано: User - 8.04.2013 21:38