old/PAS/OLD/EDITOR.PAS

Uses CRT;
{-------------------------------}
Type Errors = record
  Pos       : array [1..256] of byte;
  typeoferr : array [1..256] of byte;
End; {errors}
{-------------------------------}
Var
  s1 : string;
  k,j : byte;
  NumOfWords, NumOfConv :byte;
{-----------------------------------------------------}
Function UpCas(s : char) : char;
Begin
  if ord(s) in [128..175, 224..239] then
    begin
      if ord(s) in [160..175] then UpCas := Chr(ord(s) - 32);
      if ord(s) in [224..239] then UpCas := Chr(ord(s) - 80);
    end
  else UpCas := UpCase(s);
end; {UpCas}
{------------------------------------------------------------}
Procedure Colored(pos : byte);
Var i :byte;
Begin
 Delay(2000);
 GotoXY(1,11);
 TextColor(LightGreen);
 for i := 1 to length(s1) do begin
  Write(s1[i]);
  if i = pos then TextColor(7);
 end;
End; {Colored}
{------------------------------------------------------------}
Procedure Testing(Var s1:string);
Begin
  For k := 1 to length(s1) do
    if s1[1] = ' ' then delete(s1,1,1);
  S1[1] := UpCas(s1[1]);
  For j := 1 to 15 do
    For k := 1 to length(s1) do
      if (s1[k] = ' ') and ((s1[k+1] = ',') or (s1[k+1] = '.')
      or (s1[K+1] = '!') or (s1[k+1] = ' ')) then delete(s1,k,1);
  For k := 1 to length(s1) do
    if ((s1[k] = ',') or (s1[k] = '.') or (s1[k] = '!'))
    and (s1[k+1] <> ' ') then insert(' ',s1,k+1);
  For k := 1 to length(s1) do
    if s1[k] = '.' then s1[k+2] := upcas(s1[k+2]);
  For k := 1 to length(s1) do if s1[length(s1)] = ' '
    then delete(s1,length(s1),1);
  Insert('.',s1,length(s1)+1);
End; {Testing}
{-----------------------------------------------------------}
Procedure LOG(s1:string);
Begin
  For k := 1 to length(s1) do begin
    if s1[k] = '.' then inc(NumOfConv);
    if s1[k] = ' ' then inc(NumOfWords);
  End;
  Inc(NumOfWords);
  GotoXY(2,13);
  Write('Всего слов в тексте:        ', NumOfWords);
  GotoXY(2,14);
  Write('Всего предложений в тексте: ', NumOfConv);
End;{LOG}
{---------------------------------------------------------}
Begin
  ClrScr;
  GotoXY(10,10);
  Writeln('Введите строчку для редактирования: ');
  ReadLn(s1);
  Testing(s1);
  GotoXY(1,11);
  ClrEOL;
  Writeln(s1);
  Log(s1);
  GotoXY(80,25);
  ReadKey;
End.