IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> файл с массивом строк, помогите найти ошибку
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 7
Пол: Женский

Репутация: -  0  +


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

Требование:
В программе описать массив строк. Исходный текст считать из файла, созданного в любом текстовом редакторе. Результат обработки вывести на экран, а так же в итоговый текстовый файл.

Задание:
Определить количество слов, поменять местами четные и нечетные слова.

program pr6;
uses crt;

const p=3;
var o1,o2:text;
f:array[1..p] of string;
s,s1:string;
i,j,k,n,m1,m2,l1,l2:integer;
procedure invert(k,l:byte);
var i:byte;
ch:char;
b:boolean;
begin
for i:=k to ((l+k) div 2) do
begin
ch:=s[i];
s[i]:=s[l+k-i];
s[l+k-i]:=ch;
end;
end;

begin
clrscr;

assign(ff,'d:\o1.txt');

reset(ff);
j:=0;
while not eoln(ff) do
begin j:=j+1;
readln(ff,f[j]);writeln(f[j]);
end;
close(ff);

reset(ff);
j:=0;
while not eoln(ff) do
begin j:=j+1;
readln(ff,f[j]);
i:=0;n:=0;
m1:=1;m2:=1;l1:=1;l2:=1;
while i<length(f[j]) do
begin
i:=i+1;
s:=copy(f[j],i,1);
if (s[i]=' ')or(i=length(s)) then
repeat
if s[i+1]=' ' then
begin
delete(s,i,1);
k:=k-1;
b:=false;
end
else b:=true;
until b;
end;

begin
n:=n+1;
if n=1 then
begin
m2:=i-1;
l1:=i+1
end
else
begin
n:=0;
if i=length(s) then l2:=i else l2:=i-1;
invert(m1,m2);invert(l1,l2);invert(m1,l2);
m1:=i+1
end
end
end;

writeln(f[j]);
close(ff);

assign(oo,'d:\o2.txt');
rewrite(oo);
for j:=1 to 3 do
writeln(oo,f[j]);close(oo);
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Соблюдай разумный формат, иначе ни ты сама, ни кто либо еще не сможет разобраться в твоем творении. Я (с некоторым трудом) отформатировал - посмотри и постарайся делать в том же духе.
const
p=3;
var
ff,oo: text;
f: array[1..p] of string;
s,s1: string;
i,j,k,n,m1,m2,l1,l2: integer;
b: boolean;

procedure invert(k,l:byte);
var
i:byte;
ch:char;
b:boolean;
begin
for i:=k to ((l+k) div 2) do begin
ch:=s[i];
s[i]:=s[l+k-i];
s[l+k-i]:=ch;
end;
end;

begin
assign(ff,'d:\o1.txt');
reset(ff);
j:=0;
while not eoln(ff) do begin
j:=j+1;
readln(ff,f[j]);
writeln(f[j]);
end;
close(ff);
reset(ff);
j:=0;
while not eoln(ff) do begin
j:=j+1;
readln(ff,f[j]);
i:=0;
n:=0;
m1:=1;
m2:=1;
l1:=1;
l2:=1;
while i<length(f[j]) do begin
i:=i+1;
s:=copy(f[j],i,1);
if (s[i]=' ')or(i=length(s)) then repeat
if s[i+1]=' ' then begin
delete(s,i,1);
k:=k-1;
b:=false;
end
else b:=true;
until b;
end;

n:=n+1;
if n=1 then begin
m2:=i-1;
l1:=i+1
end
else begin
n:=0;
if i=length(s) then l2:=i else l2:=i-1;
invert(m1,m2);invert(l1,l2);invert(m1,l2);
m1:=i+1
end
end;

writeln(f[j]);
close(ff);

assign(oo,'d:\o2.txt');
rewrite(oo);
for j:=1 to 3 do writeln(oo,f[j]);close(oo);
end.

При описании файловой переменной, нужно описывать ее имя, а не имя файла на диске (я исправил). Программа теперь по крайней мере компилируется. Разбирайся дальше. Если будут еще вопросы - приходи.

PS
Да, еще я выкинул зло - uses CRT и ClrScr. Советую избегать использования CRT, где это не жизненно необходимо. А ClrScr - вообще непонятно, зачем. Имеет смысл сохранять прежние результаты для простоты отладки. Если программа отлажена и в эксплуатации, то стирать пользователю экран вообще может оказаться медвежьей услугой. Надо будет - сам сотрет.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 13.09.2025 12:55
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name