Сделать большими все буквы в тех словах, длина которых меньше половины длины самого длинного слова строки

const
  delims=[' ','.',',','!','?',':',';'];
  maxStringLength=80;
type
  Tstring=string[maxStringLength];
function findWord(const s:Tstring; start:integer; var wordStart,wordLen:integer):boolean;
var
  i:integer;
begin
  i:=start;
  while (i<=length(s)) and (s[i] in delims) do
    inc(i);
  wordStart:=i;
  while (i<=length(s)) and not(s[i] in delims) do
    inc(i);
  wordLen:=i-wordStart;
  findWord:=wordLen>0;
end;
function getLenLongestWord(const s:Tstring):integer;
var
  beg,len,i,maxLen:integer;
begin
  maxLen:=0;
  i:=1;
  while findWord(s,i,beg,len) do
    begin
      if len>maxLen then
        maxLen:=len;
      i:=beg+len;
    end;
  getLenLongestWord:=maxLen;
end;
function makeBigChar(ch:char):char;
var
  resChar:char;
begin
  case ch of
    'a'..'z': resChar:=upCase(ch);
    'а'..'п': resChar:=chr(ord(ch)-32);
    'р'..'я': resChar:=chr(ord(ch)-80);
    'ё': resChar:='Ё';
  else
    resChar:=ch;
  end;
  makeBigChar:=resChar;
end;
procedure handleString(var s:Tstring);
var
  i,j,beg,len,maxLen:integer;
begin
  maxLen:=getLenLongestWord(s);
  i:=1;
  while findWord(s,i,beg,len) do
    begin
      if len<maxLen div 2 then
        for j:=1 to len do
          s[beg+j-1]:=makeBigChar(s[beg+j-1]);
      i:=beg+len;
    end;
end;
var
  str:Tstring;
begin
  writeln('Введите строку:');
  readln(str);
  handleString(str);
  writeln('Преобразованная строка:');
  writeln(str);
end.