Unit WordsUnit;
Interface
Const
MAX = 10;
Type
TarrWords = array[1..MAX] of String;
TWords = object;
FstrWords =String;
FarrWords =TarrWords;
FcntWords =Byte;
procedure setStrWords;
procedure getStrWords;
procedure DelChars;
procedure ClearTheArray;
procedure CopyToArray;
procedure getArrWords;
procedure distinctArr;
procedure sortArr;
procedure Run;
forward;
//--------------------------------------------------------------
Implementation
//--------------------------------------------------------------
procedure TWords.setStrWords;
var FstrWords:string;
begin
write('Введите предложение: '); ReadLn(FstrWords);
end;
//--------------------------------------------------------------
procedure TWords.getStrWords;
var FstrWords:string;
begin
write('Предложение: '); WriteLn(FstrWords);
end;
//-----------------------------------------------------------------
procedure TWords.DelChars;
var
string1,FstrWords:string;
i:integer;
simbol:char;
begin
string1:=FstrWords;
FstrWords:= '';
for i:=1 to Length(string1) do
begin
simbol:=string1[i];
if not (simbol in ['.',',',';',':','"','(',')','[',']','-','_'])
then
begin
if simbol in ['A'..'Z']
then
simbol := Char(Ord(simbol) - Ord('A') + Ord('a'));
FstrWords := FstrWords + simbol;
end;
end;
end;
//-----------------------------------------------------------------------------
{procedure TWords.ClearTheArray;
var i:byte;
MAX:=10;
type
ArrayOfWords = array [1..10] of string;
begin
for i:=1 to MAX do ArrayOfWords[i] :='';
end;}
//------------------------------------------------------------------------------
procedure CopyToArray;
var
i: Byte;
chA, chB: Char;
bFlag : Boolean;
begin
chB := ' ';
//FcntWords := 0;
bFlag := false;
for i := 1 to Length(FstrWords) do
begin
chA := FstrWords[i];
if (chA <> ' ') and (chB = ' ')
then
begin
bFlag := true;
FcntWords := FcntWords + 1;
end;
if (chA = ' ') and (chB <> ' ')
then
bFlag := false;
if bFlag
then
FarrWords[FcntWords] := FarrWords[FcntWords] + chA;
chB := chA;
end;
end;
//------------------------------------------------------------------------------
procedure TWords.getArrWords;
var
i: Byte;
begin
for iCount := 1 to FcntWords do WriteLn(FarrWords[i]);
end;
//------------------------------------------------------------------------------
procedure TWords.getArrWords;
var
i: Byte;
begin
for i := 1 to FcntWords do WriteLn(FarrWords[iCount]);
end;
//--------------------------------------------------------------
procedure TWords.DistinctArr;
var
n,i : Byte;
begin
for n := 1 to FcntWords - 1 do
begin
if FarrWords[nCount] = '' then continue;
for iCount := nCount + 1 to FcntWords do
if FarrWords[nCount] = FarrWords[iCount]
then
FarrWords[iCount] := '';
end;
FstrWords := '';
for i := 1 to FcntWords do
FstrWords := FstrWords + FarrWords[iCount] + ' ';
ClearTheArray;
copyToArray;
end;
//------------------------------------------------------------------------------
procedure TWords.SortArr;
var
n : Byte;
i : Byte;
strTemp: String;
begin
for n := 1 to FcntWords - 1 do
for i := n + 1 to FcntWords do
if FarrWords[n] > FarrWords[i]
then
begin
strTemp := FarrWords[n];
FarrWords[n] := FarrWords[i];
FarrWords[i] := strTemp;
end;
end;
//------------------------------------------------------------------------------
procedure TWords.Run;
begin
setStrWords;
clearWords;
getStrWords;
ClearTheArray;
CopyToArray;
distinctArr;
SortArr;
getArrWords;
end;
END.