• Добро пожаловать на компьютерный форум Tehnari.ru. Здесь разбираемся с проблемами ПК и ноутбуков: Windows, драйверы, «железо», сборка и апгрейд, софт и безопасность. Форум работает много лет, сейчас он переехал на новый движок, но старые темы и аккаунты мы постарались сохранить максимально аккуратно.

    Форум не связан с магазинами и сервисами – мы ничего не продаём и не даём «рекламу под видом совета». Отвечают обычные участники и модераторы, которые следят за порядком и качеством подсказок.

    Если вы у нас впервые, загляните на страницу о форуме и правила – там коротко описано, как задать вопрос так, чтобы быстро получить ответ. Чтобы создавать темы и писать сообщения, сначала зарегистрируйтесь, а затем войдите под своим логином.

    Не знаете, с чего начать? Создайте тему с описанием проблемы – подскажем и при необходимости перенесём её в подходящий раздел.
    Задать вопрос Новые сообщения Как правильно спросить
    Если пришли по старой ссылке со старого Tehnari.ru – вы на нужном месте, просто продолжайте обсуждение.

Задача на Pascal

Anya1234

Ученик
Регистрация
24 Дек 2015
Сообщения
1
Реакции
0
Баллы
0
Задача на Pascal

Дана последовательность слов. Напечатать все слова, предварительно выпол*нив преобразования их по правилу: в словах наибольшей длины удалить среднюю (средние) буквы
 
Дана последовательность слов. Напечатать все слова, предварительно выпол*нив преобразования их по правилу: в словах наибольшей длины удалить среднюю (средние) буквы
Код:
Var
 W:Array[1..100] of String;
 Lw:Array[1..100] of Byte;
 S:String;
 i,j,N,L,Lmax:integer;

Begin
 Writeln('Enter the string:');
 Readln(S);
 L:=Length(S);
 Writeln;
 j:=1;
 i:=0;
 Repeat
  W[j]:='';
  repeat
   Inc(i);
  until S[i]<>' ';
  if i<L then
   begin
    while (S[i]<>' ') and (i<=L) do
     begin
      W[j]:=W[j]+S[i];
      Inc(i);
     end;
   end;
  if i<L then Inc(j);
 Until i>=L;
 N:=j;

 for i:=1 to N do Lw[i]:=Length(W[i]);

 Lmax:=0;
 for i:=1 to N do
  if Lw[i]>Lmax then Lmax:=Lw[i];

 for i:=1 to N do
  if Lw[i]=Lmax then
   begin
    if (Lw[i] mod 2)=1 then
     Delete(W[i],(Lw[i] div 2),1)
    else
     Delete(W[i],((Lw[i] div 2)-1),2);
   end;

 for i:=1 to N do Write(W[i]+' ');
 Readln
End.
 
Назад
Сверху