type
TWordDsc=record
Pos:integer;
Len:integer;
Last:char;
end;
var
si,so:string;
i:integer;
Words:array[1..128] of TWordDsc;
const
MaxLen:integer=0;
WCount:integer=0;
procedure SkipSpace(s:string; var p:integer);
begin
while (s[p]=' ') and (p<length(s)) do inc(p);
end;
function GetWord(s:string; var p:integer; var WDsc:TWordDsc):boolean;
begin
SkipSpace(s,p);
WDsc.Pos:=p;
while (s[p]<>' ') and (p<=length(s)) do inc(p);
WDsc.Len:=p-WDsc.Pos;
WDsc.Last:=s[p-1];
if WDsc.Len>MaxLen then MaxLen:=WDsc.Len;
GetWord:=WDsc.Len>0;
end;
begin
so:='';
write('Input some text:'); readln(si);
i:=1;
while GetWord(si,i,Words[WCount+1]) do begin
inc(WCount);
{writeln(Words[WCount].Pos,' ',Words[WCount].Len,' ',Words[WCount].Last);}
end;
if WCount > 0 then begin
writeln('Source text:');
writeln(si);
if Words[1].Len=MaxLen then begin
writeln('The first word of the text: ',copy(si,Words[1].Pos,Words[1].Len));
for i:=1 to WCount do
if Words.Last<>Words[1].Last then
so:=so + copy(si,Words.Pos,Words.Len) + ' ';
for i:=1 to WCount do
if Words.Last=Words[1].Last then
so:=so + copy(si,Words.Pos,Words.Len) + ' ';
writeln('Result text:');
writeln(so);
end else begin
writeln('The first word is not longest word in the text.');
end;
end else Writeln('Wrong input! No words was found.');
readln;
end.
вот условие задания..
Лабораторная работа № 6
Тема: «Разработка программ с использованием меню»
Дан текст, слова которого отделяются друг от друга пробелами. Разработать програм-му, включающую подпрограммы, реализующие следующие действия над текстом:
1 стандартные алгоритмы вставки, замены, удаления;
2 сортировку слов текста по длине и в алфавитном порядке;
3 задачу (используя задание лабораторной работы № 4).-это код её
Программу оформить с помощью меню со следующей структурой:
Ввод Обработка Сортировка Задача Выход
Вставка По алфавиту
Замена По длине
Удаление Выход
Выход
Меню организовать с помощью подпрограмм..