Форум программистов, компьютерный форум, киберфорум
Наши страницы
Mashapersik
Войти
Регистрация
Восстановить пароль
Оценить эту запись

Напечатать последовательность в определенном порядке Delphi

Запись от Mashapersik размещена 21.04.2019 в 12:38

Дана непустая последовательность слов, в каждом из которых от 1 до 8 строчных латинских букв; между словами - пробел, за последним словом - точка. Напечатать эти слова в следующем порядке: сначала по алфавиту все слова из одной буквы, затем - по алфавиту все двухбуквенные слова и т.д.

Программа не совсем моя.. Помогите, пожалуйста, разобраться, на выводе просто закрывает программу.. Делала трассировку, этот блок просто пропускает
"Writeln(' Напечатать слова по алфавиту сначало из одной буквы,затем все двухбуквенные слова');
Writeln;
Writeln('Введите предложение: ');
Readln(Str);
Find(Str,Word,N);
Sort(Word,N);
Readln;
Writetext(Word,N);"

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
program Project2;
{$APPTYPE CONSOLE}
uses
  SysUtils, windows;
const
    ch:set of char =['a'..'z','A'..'Z','а'..'я','А'..'Я']; {допустимые символы}
 
procedure Find(Stroka:string;var Slova:array of string;var N:byte);{выделение слов из предложения}
var
  I, J: integer;
  W: string;
  begin
  I:= 1;
  N:=1;
  while I <= length(Stroka) do
  if Stroka[I] in ch then
    begin
      W:= Stroka[I];
      I:= I + 1;
      while (I <= length(Stroka)) and (Stroka[I] in ch) do
      begin
        W:= W + Stroka[I];
        I:= I + 1;
      end;
      J:= 1;
      while (j <= n) and (w<>slova[j]) do
        J:= J + 1;
        if j > n then
        begin
          N:= N + 1;
          Slova[N] := W;
        end;
      end
      else
        I:= I+ 1;
end;
 
procedure Sort(var Slova:array of string; N:byte); {сортировка}
 var
 I,J,K:byte;
 Min:string;
 begin
 for J:=1 to N-2 do                   {номер слова, с кот. начинается сравн.}
   for I:=J+1 to N-1 do                        {текущий номер слова}
   begin
    K:=1;                                      {номер тек. буквы}
    while (Slova[I][K]=slova[J][K]) and (K<=length(Slova[I])) do {сравн. буквы}
      Inc(K);    {тек. слова с}
      if Slova[I][K] < Slova[J][K] then          {буквой мин. слова}
      begin                                     {обмен слов}
        Min:=Slova[I];
        Slova[I]:=Slova[J];
        Slova[J]:=Min;
      end;
    end;
  end;
procedure WriteText(slova:array of string; n:byte);{вывод слов}
 var
    K,I:byte;                                  {номер слова}
    F: boolean;                                 {флаг}
    S1,S2 : string;                             {строка-результат}
 begin
  S1:='';
  S2:='';
 for I:=1 to N do
  begin
      F:=false;
      if  length(Slova[I])>0 then
      begin
      for K:=1 to length(Slova[I])-1 do
        begin
          if Slova[I][K]=Slova[I][K+1] then
          F:=true;
        end;
        if f then
         S1:=S1+Slova[I]   {+#13#10}
         else
         s2:=s2+slova[I];  {+#13#10}
      end;
 end;
 SetConsoleCP(1251);
 SetConsoleOutPutCP(1251);
 writeLn('Слова с 2х буквами ');
 Writeln(S1);
 WriteLn('Слова с 1х буквами ');
 Writeln(S2);
 Readln;
 Readln;
 end;
 
var
    Str:string;   {введ. предложение}
    Word:array [1..20] of string;  {слова предложения}
    N:byte; {номер последнего слова}
begin
 SetConsoleCP(1251);
 SetConsoleOutPutCP(1251);
 Writeln(' Напечатать слова по алфавиту сначало из одной буквы,затем все двухбуквенные слова');
 Writeln;
 Writeln('Введите предложение: ');
 Readln(Str);
 Find(Str,Word,N);
 Sort(Word,N);
 Readln;
 Writetext(Word,N);
 Readln;
end.
Размещено в Без категории
Просмотров 164 Комментарии 1
Всего комментариев 1
Комментарии
  1. Старый комментарий
    Цитата:
    на выводе просто закрывает программу
    полагаю, это и есть вопрос?
    можно запустить консольное приложение через меню
    Пуск->Выполнить->cmd->полный путь к вашей программе
    Запись от sam063rus размещена 21.04.2019 в 12:59 sam063rus вне форума
 
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru