Помощь - Поиск - Пользователи - Календарь
Полная версия: чтение файла , выделение слов
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
HeX
Условие такое:
С помощью текстового редактора создать файл, содержащий текст, длина которого не превышает 700 символов (длина строки текста не должна превышать 70 символов).
Имя файла должно иметь расширение DAT. Написать программу, которая:
- выводит текст на экран дисплея;
- по нажатию произвольной клавиши поочередно выделяет в тексте заданные слова (за-данные слова вводить с клавиатуры).
Altair
вот.

uses crt;

Var
ft:text;
s:string[70];
a,b:array[1..11] of string[70];
m,n, i,j,f:integer;
ch:byte;
begin
Assign(ft,'text700.dat');
reset(ft); i:=1;
while not eof(ft) do begin
readln(ft,s);
a[i]:=s;
inc(i);
end;m:=i;
close(Ft);
write('n='); readln(n);
writeln('new word - new line');
for i:=1 to n do readln(b[i]); f:=1; j:=1;
repeat
clrscr;
for i:=1 to m do begin
if pos(b[j],a[i])<>0 then begin
for j:=1 to f do begin
insert('_',a[i],pos(b[j],a[i]));insert('_',a[i],pos(b[j],a[i])+length(b[j]))
end;
end;
writeln(a[i]);
end;
ch:=ord(readkey);
inc(f);
until (ch=27) or (f>n);;
readln;
end.


и файл на котормо тестировал
Нажмите для просмотра прикрепленного файла
HeX
Спастбо!!! пошел тестить!!!
HeX
Блин не очень что-то во первых постоянно на два пробела увеличивает все слова.Хотелось чтобы цветом выделение шло.
virt
uses crt;

Var
ft:text;
s:string[70];
a,b,c:array[1..11] of string[70];
m,n,i,j,f:integer;
ch:byte;

begin
clrscr;
Assign(ft,'text700.dat');
reset(ft); i:=1;
while not eof(ft) do begin
readln(ft,s);
a[i]:=s;
inc(i);
end;m:=i - 1;
close(Ft);
for i := 1 to m do
writeln(a[i]);
write('n='); readln(n);
writeln('new word - new line');
for i:=1 to n do readln(b[i]); f:=1; j:=1;
repeat
clrscr;
c := a;
for i:=1 to m do
begin
if pos(b[f],c[i])<>0 then
begin
insert('_',c[i],pos(b[f],c[i]));insert('_',c[i],pos(b[f],c[i])+length(b[f]))
end;
writeln(c[i]);
end;
ch:=ord(readkey);
if ch = 0 then ch := ord(readkey);
inc(f);
until (ch=27) or (f>n);;
readln;
end.


немного исправил прогу Altair'a. Единственно если например будет слово в тексте abcd ,то если искать в тексте слово bcd ,то оно найдется в этом слове.
HeX
Ребяты сделайте плиз цветом а то так чувствую у меня не примут!!!!
volvo
HeX, ну, цветом так цветом blum.gif
uses crt;

const
alpha = ['a'..'z', 'A'..'Z'];
var
ft: text;
s: string;

a, b: array[1 .. 50] of string;

line_count, n, i,j,f:integer;
ch:byte;

p, len: byte;
start: integer;
st: string;
isgray: boolean;

begin
Assign(ft,'text700.dat');
reset(ft);

clrscr;

line_count := 0;
while not eof(ft) do begin
readln(ft,s); writeln(s);
inc(line_count);
a[line_count]:=s;
end;

close(Ft);

write('n='); readln(n);
writeln('new word - new line');
for i:=1 to n do readln(b[i]);

clrscr;
for i:=1 to line_count do begin
p := 0; st := a[i];

for j := 1 to n do { !!! }
repeat
start := p;
p := start + pos(b[j], copy(st, start + 1, 255));
if
(
(p <> start)
and
((p = 1) or ( (p > 1) and not(st[p-1] in alpha)))
and
(
(p + pred(length(b[j])) = length(st)) or
((p + pred(length(b[j])) < length(st)) and
not(st[p+length(b[j])] in alpha))
)
) then

begin
delete(st, p, length(b[j]));
insert('~'+b[j]+'~', st, p);

inc(p, length(b[j]));
end;
until p = start;
a[i] := st;

isgray := true; textcolor(lightgray);
st := a[i];
for len := 1 to length(a[i]) do
if st[len] = '~' then begin
if isgray then begin
textcolor(lightred);
isgray := false;
end
else begin
textcolor(lightgray);
isgray := true;
end
end
else write(st[len]);

writeln;

end;
readln;
end.

сам просил rolleyes.gif
HeX
Да........ Наворотил.......
Спасибо!!!
HeX
Спасибо но задание звучит так : поочередно выделять заданные слова в тексте!!!!
mad.gif
volvo
HeX
Вот возьми и исправь ПО ЗАДАНИЮ. Ясно? Тебе наверное лучше знать, что значит ПООЧЕРЕДНО? Я не являюсь телепатом.

Предупреждение: еще раз воспользуешься ссылкой "сообщить модератору" - приму меры. Эта ссылка НЕ для того, чтобы на себя обращать внимание mad.gif
volvo
Вот тебе поочередно (Жми Enter для выделения следующего слова)...

P.S. Чтобы постов, подобных предыдущему, я больше никогда не видел. Ты что, кого-то нанял на работу, и тебе эту работу не сделали? Я кстати, просил объяснить, что значит "поочередно". Ты не захотел...

uses crt;

const
alpha = ['a'..'z', 'A'..'Z'];
var
ft: text;
s: string;

a, b: array[1 .. 50] of string;

line_count, n, i,j,f:integer;
ch:byte;

p, len: byte;
start: integer;
ss, st: string;
isgray: boolean;

procedure print_all;
var i: integer;
begin
clrscr;
for i := 1 to line_count do begin
isgray := true; textcolor(lightgray);
st := a[i];
for len := 1 to length(a[i]) do
if st[len] = '~' then begin
if isgray then begin
textcolor(lightred);
isgray := false;
end
else begin
textcolor(lightgray);
isgray := true;
end
end
else write(st[len]);

writeln;
end;
readln;
end;

begin
Assign(ft,'text700.dat');
reset(ft);

clrscr;

line_count := 0;
while not eof(ft) do begin
readln(ft,s); writeln(s);
inc(line_count);
a[line_count]:=s;
end;

close(Ft);

write('n='); readln(n);
writeln('new word - new line');
for i:=1 to n do readln(b[i]);

clrscr;
for i:=1 to line_count do begin
p := 0; st := a[i];

for j := 1 to n do { !!! }
repeat
start := p;
p := start + pos(b[j], copy(st, start + 1, 255));
if
(
(p <> start)
and
((p = 1) or ( (p > 1) and not(st[p-1] in alpha)))
and
(
(p + pred(length(b[j])) = length(st)) or
((p + pred(length(b[j])) < length(st)) and
not(st[p+length(b[j])] in alpha))
)
) then

begin
ss := a[i];

delete(st, p, length(b[j]));
insert('~'+b[j]+'~', st, p);

inc(p, length(b[j]));
a[i] := st;
print_all;

a[i] := ss;
st := ss;
end;
until p = start;
a[i] := st;

end;
readln;
end.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.