Найти в тексте все слова, которые содержат хотя бы один фрагмент заданного вида - Turbo Pascal

Формулировка задачи:

Сама задача: Найти в тексте все слова, которые содержат хотя бы один фрагмент заданного вида. Подсчитать их количество и выделить в исходном тексте другим цветом как слова, так содержащиеся в них фрагменты.
uses crt;
 
function find(t,f:string):integer;
var i,n,k:integer;
begin 
 for i:=1 to length(t) do 
  for n:=1 to length(f) do
  begin
   if t[i] = f[n] then k:=k+1;
  end;
 find:=k div length(f);
end;
 
var s,d:string;
begin
readln(s);
readln(d);
writeln(find(s,d));
end.
Эта программа находит кол-во фрагментов. Как ее дополнить, чтобы она выводила текст с покрашенными фрагментами? Заранее, спасибо.

Код к задаче: «Найти в тексте все слова, которые содержат хотя бы один фрагмент заданного вида - Turbo Pascal»

textual
uses crt;
const rz=[' ','.',',','-','?','!'];{символы, разделители слов, можно добавить}
var s,f,s1:string;
    a:array[byte] of byte;{массив цветов букв}
    n,i,j,k,p,q:byte;
begin
clrscr;
writeln('Введите текст');
readln(s);
writeln('Введите фрагмент');
readln(f);
n:=length(s);
for i:=1 to n do
a[i]:=7; {установим цвет символов строки}
i:=1;{начнем со 2 символа}
while i<=n do {пока не конец}
if not(s[i] in rz)and ((i=1)or(s[i-1] in rz)) then{если не разделитель
                                и это первый символ или перед ним разделитель,
                                то начало слова}
 begin
  k:=i;
  s1:='';{составим очередное слово}
  while (k<=n) and not(s[k] in rz) do {пока не разделитель и не конец строки}
   begin
    s1:=s1+s[k];
    k:=k+1;
   end;
  if pos(f,s1)>0 then {если в слове есть фрагмент}
   begin
    q:=q+1;{считаем его}
    j:=i; {начинаем менять цвет букв}
    repeat
    if copy(s,j,length(f))=f then {во фрагментах}
     begin
      for p:=j to j+length(f)-1 do a[p]:=13;
      j:=j+length(f);
     end
    else  {в остальных буквах}
     begin
      a[j]:=12;
      j:=j+1;
     end;
    until j>i+length(s1);
   end;
  i:=i+length(s1);
 end
else i:=i+1;{пропускаем разделители}
if q=0 then write('Нет слов содержащих фрагменты ',f)
else {выведем раскрашеную строку}
for i:=1 to length(s) do
 begin
  textcolor(a[i]);
  write(s[i]);
 end;
readln
end.

9   голосов, оценка 4.222 из 5


СОХРАНИТЬ ССЫЛКУ
Похожие ответы