Developing.ru

Код: Выделить всё

uses crt;

const
   maxelements=100;

type
   str45=string[45];

var
   slovo:array[0..maxelements] of str80;
   stroka,strokaTEMP:string;
   i,k,y,x,m:byte;



function FirstIsMax(a:array of str80;y:integer):boolean;
      var i:integer;
      begin
           FirstIsMax:=true;
              For i:=1 to y do
                   begin
                     If a[i]>a[0] then FirstIsMax:=false;break;
                   end;
             end;


begin
writeln('Enter words(not more than ',maxelements, '):  ');
 readln(stroka);strokaTEMP:=stroka;

 For i:=0 to length(stroka) do
   begin
     if (stroka[i]=' ') and (stroka[i]<>stroka[i+1]) then inc(m);
   end;

 For k:=0 to m do
   begin
     For i:=1 to length(stroka) do
       If (stroka[i]<>' ')   then
         begin
           insert(stroka[i], slovo[k], i);inc(y);
         end

       else  if (stroka[i]=' ') and (stroka[i-1]<>' ') and (stroka[i-1]<>stroka[length(stroka)+1])  then
         begin
           delete(stroka, 1, i);
           break;
         end

       else if (stroka[i]=' ') and (stroka[i+1]=' ') then delete(stroka, 1, 1);
   end;


If FirstIsMax(slovo,y)=true then
   begin
     For i:=1 to m do
       begin
          x:=length(slovo[0]);
          If slovo[i][length(slovo[i])]=slovo[0][x] then
            begin
              slovo[m+i]:=slovo[i];
              slovo[i]:='0';
            end;
       end;

  writeln;
  Write('Ishodniy text: ');writeln(StrokaTemp, '.');
  writeln;
  writeln('Pervoe slovo: ',slovo[0]);
  writeln;
  writeln('Otredaktirovanniy text');
  For  i:=0 to 2*m do if slovo[i]<>'0' then write(slovo[i], ' ');
 end

else writeln('Pervoe slovo ne maximalnoe');
writeln;
writeln('Press enter to exit');
readln;
end.