| virginia |
10.03.2013 18:38 |
Работа с файлами
Вложений: 3
Код:
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 нет(((в чем может быть проблема? |
