| ← Декабрь 2019 → | ||||||
|
3
|
4
|
5
|
||||
|
9
|
10
|
11
|
12
|
15
|
||
|
16
|
19
|
20
|
21
|
22
|
||
|
23
|
26
|
28
|
29
|
|||
|
30
|
31
|
|||||
За последние 60 дней ни разу не выходила
Сайт рассылки:
http://rusfaq.ru/
Открыта:
14-03-2002
Статистика
0 за неделю
RFpro.ru: Программирование на Delphi и Lazarus
| РАССЫЛКИ ПОРТАЛА RFPRO.RU
Лучшие эксперты в разделе
∙ Pascal / Delphi / Lazarus
Здравствуйте, уважаемые эксперты! Прошу вас ответить на следующий вопрос:
Дата отправки: 07.12.2019, 13:13 Консультирует Зенченко Константин Николаевич (Старший модератор): Здравствуйте, rail! Код (Pascal) :: выделить код const
{на все случаи жизни}
type_a:string='аоиеёэыуюя';{гласные}
type_b:string='бвгджзйлмнр';{согласные звонкие}
type_c:string='кпстфхцчшщ';{согласные глухие}
type_d:string='ьъ';{отдельные буквы}
type_e:string='!@#$%^&*()_-+={}[]:">? ';{возможные разделители}
var
a,b:string;
c,d:set of char;
e:char;
begin
{формирование контрольного множества}
b:=type_a;
c:=[];
while length(b)>0 do
begin
c:=c+[b[1]];
delete(b,1,1);
end;
{ввод строки - так для проформы}
repeat
write('enter string:=');
readln(a);
until length(a)>0;
{контрольная строка с возможными ошибками юзера}
a:='абитура, абитуриент - абитуриетка = абитуриентский';
writeln('before >',a,'<');
{защита от юзера - использование различных разделителей слов}
b:=type_e;
while length(b)>0 do
begin
while pos(b[1],a)>0 do a[pos(b[1],a)]:=',';
delete(b,1,1);
end;
{защита от юзера - удаляем повторы разделителей}
while pos(',,',a)>0 do delete(a,pos(',,',a),1);
{защита от юзера - забыл поставить точку в конце строки}
if a[length(a)]<>','then a:=a+',';
writeln('after >',a,'<');
{главный цикл}
while length(a)>0 do
begin
{выделение очередного слова}
b:=copy(a,1,pos(',',a)-1);
{формирвание текущего множества подконтрольных букв}
d:=[];
while length(b)>0 do
begin
if pos(b[1],type_a)>0 then d:=d+[b[1]];
delete(b,1,1);
end;
c:=c*d;
{удаление провереного слова}
delete(a,1,pos(',',a));
end;
{вывод результата}
write('result:=');for e:='а' to 'я' do if (e in c) then write(e:2);writeln;
writeln('press enter');
readln;
end.Удачи!
Оценить выпуск | Задать вопрос экспертам
главная страница
|
стать участником
|
получить консультацию
|
| В избранное | ||
