Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 10.03.2013, 18:38   #1 (permalink)
virginia
Member
 
Регистрация: 29.10.2011
Сообщений: 42
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: -42
По умолчанию Работа с файлами

Код:
program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  Windows, SysUtils;
 
type
  TMas = array[0..999] of Real;
 
var
  file_name : String;
  n,mn,k : Integer;
  x, y: TMas;
  Xx:Real;
//------------------------------------
  procedure zastavka;  //заставка
  begin
    Writeln('Задание №0');
    Writeln(' ');
    Writeln('');
    writeln('__________________________________________________________');
    Writeln;
    Writeln;
    writeln
  end;
 //-------------------------------------------------
 procedure Read_file(var file_name : String); //считывание исходных данных
 var
   i,j: Integer;
   f: Text;
 begin
   AssignFile(f, file_name);
   Reset(f);
   Read(f, n);
   WriteLn('Размерность таблицы:   ', n);
   WriteLn('Данные');
   for i := 0 to n do
    begin
      Read(f, x[i]);
      WriteLn(x[i]:3:2);
    end;
   WriteLn('Значения функции:');
   for j := 0 to n do
    begin
      Read(f, y[j]);
      WriteLn(y[j]:3:2)
    end;
  Read(f, Xx);
  WriteLn('Проверяемое значение аргумента:    ', Xx:3:2);
  CloseFile(f);
 end;
//-----------------------------------------------------
 function checkincrease(x:TMas):Boolean;  //проверка на строгое возрастание
 var
  i:Integer;
  t:Boolean;
 begin
  i:=0;
  t:=True;
  while (i<n) and t do
   begin
     t := x[i]<x[i + 1];
     inc(i);
   end;
  Result:=t;
 end;
 //-----------------------------------------------
 function checkmembership(x:tmas; Xx:Real):Boolean;  //проверка на принадлежность
 var
   t:Boolean;
  begin
   t := ((Xx >= X[0]) and (Xx <= X[n]));
   Result := t;
 end;
 //-------------------------------------------------
  function spotting(x:tmas; Xx:Real):integer;     //  проверка на местоположение
  var
   i,k:integer;
  begin
   for I:=0 to n do
   if ((Xx>=x[i]) and (Xx<=x[i+1])) then k:=i;
   Result := k;
 end;
//----------------------------------------------------
  function checkerror(x:TMas;Xx:real):Integer;    //определение кода ошибки
  var IER:integer;
  begin
    if checkincrease(x) and checkmembership(x,Xx)then IER:=0
            else
    if (not checkincrease(x) and checkmembership(x,Xx)) then IER:=1
            else
    if (checkincrease(x) and not checkmembership(x,Xx)) then IER:=2;
  checkerror:=IER;
 end;
 //-----------------------------------------------------
 Procedure output(x:TMas;Xx:real); //вывод данных в файл
 var i,k:Integer;
     f:Text;
 begin
   Assignfile(f,'Результат.txt');
   Rewrite(f);
   k:=checkerror(x,Xx);
   if k=0 then
          begin
           Writeln(f,'Размерность матрицы: ',n);
           writeln (f,'x          y');
           writeln (f,'____________');
           for i:=0 to n do
           writeln(f,x[i]:3:2,'     ',y[i]:3:2);
           Writeln(f,'Проверяемое значение: ',Xx:3:2);
           Writeln(f,'IER=',k,' ошибок нет!');
           Writeln(f,'xx расположен после: ',spotting(x,xx),' элемента')
         end;
  Close(f)
 end;
 //----------------------------------------------------
  Procedure outputerror(x:TMas;Xx:real); //определение кода ошибки
  var i,k:Integer;
     f:Text;
  begin
    Assignfile(f,'Результат.txt');
    Rewrite(f);
    k:=checkerror(x,Xx);
    if k=1 then Writeln(f,'IER=',k,' нарушен порядок возрастания!');
    if k=2 then Writeln(f,'IER=',k,' xx не принадлежит заданному промежутку');
    Close(f)
  end;
 //---------------------------------------------
  procedure write_file;
  var s:string;
      f1:text;
  begin
    AssignFile(f1, 'Результат.txt');
    reset(f1);
    while not eof(f1) do
    begin
     readln(f1,s);
     writeln(s);
    end;
  end;
//---------------------------------------
begin
  SetConsoleOutputCP(1251);
  SetConsoleCP(1251);
  zastavka;
  WriteLn('Введите имя файла');
  ReadLn(file_name);
  file_name := file_name + '.txt';
  if FileExists(file_name) then
                           begin
                             writeln('Исходные данные:');
                             writeln;
                             Read_file(file_name);
                             k:=checkerror(x,xx);
                             writeln('____________________');
 
                             if k=0 then output(x,Xx) else
                                           begin
                                             Writeln('Ошибка в исходных данных!Аварийный выход!');
                                             outputerror(x,xx);
                                           end;
                                           writeln('Результат:');
                                           writeln('____________');
                                           write_file
                                           end
                           else Writeln('Такой файл не найден!');
  ReadLn;
end.
с файлом задание и задание2 работает все ,а с файлом задание1 нет(((в чем может быть проблема?
Вложения
Тип файла: txt Задание.txt (35 байт, 506 просмотров)
Тип файла: txt Задание1.txt (34 байт, 503 просмотров)
Тип файла: txt Задание2.txt (38 байт, 481 просмотров)
virginia вне форума   Ответить с цитированием

Старый 10.03.2013, 18:38
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Рекомендую потратить минутку на прочтение аналогичных топиков

Работа с файлами
Язык Delphi: работа с файлами
Работа с файлами записи

Старый 10.03.2013, 19:05   #2 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Так, уважаемая Virginia, Gabriela, Gabriela007, Nastia.Top и прочая, прочая, прочая! Как модератор, в первый и последний раз требую: хватит плодить аккаунты! У нас есть Правила, в которых четко и ясно сказано:
Цитата:
3.6. Каждый участник имеет один аккаунт на форуме. Регистрация дополнительных аккаунтов запрещена.
Не вынуждайте нас применять к Вам жесткие меры. Правила обязательны для всех!

Теперь по сути. Запускал старую программу отсюда Ошибка в коде с "проблемным" входным файлом - работает безупречно. Так что сверяйте коды, отслеживайте изменения.
Миниатюры
gabr_2.jpg  
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 17:42.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.