Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ типизированный файл

Автор: Юлия 8.01.2007 21:31

привет всем! очень нужна помощь! написала программу, а теперь ее результат нужно вписать в текстовый файл. очень прошу помочь. сама программа:

Program proced;
uses crt;
Type ar=array[1..30] of real;
var Z,T,U:ar;
i,j,k:byte;
y,yz,yt,yu,nz,nt,nu,nk:byte;
f:file of real;
f1:text;
procedure analiz(var N:byte; Z:ar);
var i,k:byte;
begin
k:=0;
for i:=1 to N do
begin
if z[i]>0 then write(' El# ',i:3,' - pol;');
if z[i]<0 then write(' El# ',i:3,' - otr;');
k:=k+1;
if k>2 then
begin
writeln;
k:=0;
end;
end;
end;
Procedure WaitSpace;
Var ch : char;
Begin
writeln('Dlia prodolgeniya nagmite SPACE');
Repeat
ch:=ReadKey;
Until ord(ch)=32;
End;
BEGIN
ClrScr;
nz:=30;
writeln('Massiv Z');
for i:=1 to nz do
begin
z[i]:=sin(1.5*i)+3*(cos(2*i));
write(Z[i]:8:3);
end;
writeln;
analiz (Nz,Z);
writeln;
WaitSpace;
Clrscr;
nt:=20;
writeln('Massiv T');
for j:=1 to nt do
begin
t[j]:=j*cos(1.5*j+2);
write(T[j]:8:3);
end;
writeln;
analiz(Nt,T);
writeln;
WaitSpace;
ClrScr;
nk:=25;
writeln('Massiv U');
for k:=1 to nk do
begin
U[k]:=sin(2*k)*cos(2.5*k);
write(U[k]:8:3);
end;
writeln;
analiz(Nk,U);
writeln;
WaitSpace;
end.


Автор: polic 8.01.2007 21:36

код в теги для начала занеси

М
 Для таких замечаний (хоть и справделивых) есть модераторы/администраторы. Или ты считаешь, что они не справляются со своими обязанностями?
В общем, ИМХО, нарушение п.7 правил.
мисс_граффити


Автор: polic 8.01.2007 22:00

для этого используется процедура outdata вот так выводятся файлы для примера


.......

Код
procedure outdata;
var g:text;
begin
assign(g,'output.txt');
rewrite(g)
close(g)
end;

.....

Автор: volvo 8.01.2007 22:03

 ! 
 polic, а тебя, кстати, теги тоже касаются... Устное замечание... Еще одно подобное нарушение - последуют более кардинальные меры...


Автор: polic 8.01.2007 22:07

я поэтому и пишу чтоб самому тож не забыть про тэги naezd.gif

и ещё хотел показать на примере как у меня теги раставлены

Автор: Гость 8.01.2007 23:41

Цитата(polic @ 8.01.2007 18:00) *

для этого используется процедура outdata вот так выводятся файлы для примера
.......
Код
procedure outdata;
var g:text;
begin
assign(g,'output.txt');
rewrite(g)
close(g)
end;

.....




т.е. я открываю новую процедуру? я правильно поняла? но тогда даже не появляется текстовый документ.

Автор: polic 8.01.2007 23:54

ты пишеш сначало куда поместить например

Код
assign (s, 'A:\var5\output.txt');

а затем вписываеш тот код которой вырабатывает результат

Автор: polic 9.01.2007 0:07

мою прогу там тож надо вывести в файл позырь ,мож поможет


Прикрепленные файлы
Прикрепленный файл  VAR5_10.PAS ( 2.05 килобайт ) Кол-во скачиваний: 237

Автор: Юлия 9.01.2007 0:26

а ты не мог бы с мою прогу поделать? просто я уже замучалась с ней. не могу понять как делать. там три массива,в каждом выводятся положительные и отрицательные элементы. и именно их мне и нужно вывести в типизированый файл. помоги,пожалуйста,а то что-то у меня свосем никак. wacko.gif

Автор: Bokul 9.01.2007 0:38

Вот:


procedure WriteResult(Const A,B,C:ar; Const path:string);//path - путь к файлу
var f:file of ar;
begin
  assign(f,path);
  {$I-}
  rewrite(f);
  {$I+}
  if IoResult<>0 then  begin
     writeln('Cannot create file');
     readln;
     exit;
  end;

  write(f,a);
  write(f,b);
  write(f,c);
  close(f);
end;



Цитата
ее результат нужно вписать в текстовый файл

не заметил 10.gif

Автор: Bokul 9.01.2007 0:52

С текстовыми:


Type
   ar=array[1..30] of real;

procedure WriteArray(Const mas:ar; Var f:text; Const n:byte);//вспомогательная процедура, записывает в файл один массив
var i:byte;
begin
  for i:=1 to n do
      writeln(f,mas[i]);
end;


procedure WriteResult(Const A,B,C:ar; Const path:string; Const n:byte);//path-путь к файлу, n-размер массива
var f:text;
begin
  assign(f,path);
  {$I-}
  rewrite(f);// пробуем создать файл
  {$I+}
  if IoResult<>0 then  begin //если возникла ошибка
     writeln('Cannot create file');
     readln;
     exit;//то выходим
  end;

  WriteArray(A,f,n);//записываем сначала массив A
  WriteArray(B,f,n);//потом B
  WriteArray(C,f,n);// и наконец C
  close(f);// закрываем файл
end;



P.S. в названии темы написано с типизированным файлом, в задании - с текстовым, ты уж как-то определись.. wink.gif

Автор: Гость 9.01.2007 1:45

там где записываем в файл массивы 


WriteArray(A,f,n);//записываем сначала массив A
  WriteArray(B,f,n);//потом B
  WriteArray(C,f,n);// и наконец C
  close(f);// закрываем файл
end;



выдает ошибку типов после f.

Автор: Bokul 9.01.2007 1:54

blink.gif
У меня работает отлично, вот полный пример


Type
   ar=array[1..30] of real;

procedure WriteArray(Const mas:ar; Var f:text; Const n:byte);
var i:byte;
begin
  for i:=1 to n do
      writeln(f,mas[i]);
end;


procedure WriteResult(Const A,B,C:ar; Const path:string; Const n:byte);
var f:text; i:byte;
begin
  assign(f,path);
  {$I-}
  rewrite(f);
  {$I+}
  if IoResult<>0 then  begin
     writeln('Cannot create file');
     readln;
     exit;
  end;

  WriteArray(A,f,n);
  WriteArray(B,f,n);
  WriteArray(C,f,n);
  close(f);
end;


var A,B,C:ar;
begin
  WriteResult(A,B,C,'c:\res.txt',30);
end.



Создаваемый файл: Прикрепленный файл  res.txt ( 1.67 килобайт ) Кол-во скачиваний: 456

Автор: Гость 9.01.2007 2:27

работает! но выводит сам массив. а как вывести номера положительных и отрицательных элементов?
blink.gif

Автор: polic 9.01.2007 2:29

Код
if IoResult<>0 then  begin
не известен компилятору IoResult

Автор: klem4 9.01.2007 2:40

Чтоже за компилятор то у тебя такой ... попробуй первой строчкой поставить uses crt;

Автор: Bokul 9.01.2007 2:45

Цитата
работает! но выводит сам массив. а как вывести номера положительных и отрицательных элементов?

А как ты хочешь их выводить? Отдельно положительные и отрицательные? В разных файлах?

tongue.gif

Автор: Юлька@ 9.01.2007 2:59

я прикрепила свою программу. как в ней выводятся, так и в текстовом должны yes2.gif


Прикрепленные файлы
Прикрепленный файл  PROCEDUR.PAS ( 1.1 килобайт ) Кол-во скачиваний: 238

Автор: Bokul 9.01.2007 3:11


Type
   ar=array[1..30] of real;

procedure WriteArray(Const mas:ar; Var f:text; Const n:byte);
var i:byte;
begin
  for i:=1 to n do
      writeln(f,mas[i]:0:3);
end;

procedure AnalyzeArray(Const mas:ar; Var f:text; Const n:byte);
var i:byte;
begin
  for i:=1 to n do  begin
      if mas[i]>0 then
         writeln(f,'Elelemnt # ',i:3,' - positive');
      if mas[i]<0  then
         writeln(f,'Element # ',i:3,' - negative');
  end;
end;

procedure WriteResult(Const A,B,C:ar; Const path:string; Const n:byte);
var f:text; i:byte;
begin
  assign(f,path);
  {$I-}
  rewrite(f);
  {$I+}
  if IoResult<>0 then  begin
     writeln('Cannot create file');
     readln;
     exit;
  end;

  writeln(f,' Array A :');
  WriteArray(A,f,n);
  AnalyzeArray(A,f,n);

  writeln(f,' Array B :');
  WriteArray(B,f,n);
  AnalyzeArray(B,f,n);

  writeln(f,' Array C :');
  WriteArray(C,f,n);
  AnalyzeArray(C,f,n);

  close(f);
end;


var A,B,C:ar;
begin
  WriteResult(A,B,C,'c:\res.txt',30);
end.


Автор: Юлька@ 9.01.2007 4:33

Bokul,огромное спасибо! у меня все работает!!! еще раз спасибооо!!!!!! lol.gif