0 / 0 / 1
Регистрация: 07.11.2014
Сообщений: 76
1

Разработать программу, которая вводит с клавиатуры данные о каждом студенте

04.02.2015, 17:36. Показов 2439. Ответов 9

Author24 — интернет-сервис помощи студентам
Порядок выполнения работы
1. Составить список учебной группы, содержащей 15 студентов.
2. Указать для каждого студента фамилия и инициалы а также оценки, полученные на четырех экзаменах.
3. Разработать программу, которая вводит с клавиатуры данные о каждом студенте, заносит эти данные в список и выполняет его обработку согласно варианту.
Условие:
Средний балл 3.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
04.02.2015, 17:36
Ответы с готовыми решениями:

Разработать программу, которая осуществляет поиск в массиве записей информации о студенте, фамилия которого вводится с клавиатуры
Разработать программу, которая выполняет те же действия что и в примере, но вводит исходные данные...

Разработать программу, которая вводит слово с клавиатуры
Разработать программу, которая вводит слово с клавиатуры и переставляет первые три и последние три...

Разработать программу, которая вводит с клавиатуры строку и выводит ее без лишних пробелов
Разработать подпрограмму, которая удаляет из строки все пробелы перед и после знака тире «-»....

Напишите программу, которая вводит с клавиатуры данные об n (n<=100) сотрудниках
Условие и моё решение во вложениях.Я хотел бы обратить внимание на то , что мне делать если у 2-ух...

9
13107 / 5888 / 1707
Регистрация: 19.09.2009
Сообщений: 8,808
04.02.2015, 21:47 2
Вот тема с решением похожей задачи: Список. В элементе списка содержатся данные об успеваемости студентов
1
0 / 0 / 1
Регистрация: 07.11.2014
Сообщений: 76
04.02.2015, 22:19  [ТС] 3
Спасибо конечно,но ты разделом ошибся,я на паскаль кидал,а не на делфи.
0
5084 / 2655 / 2350
Регистрация: 10.12.2014
Сообщений: 10,045
05.02.2015, 05:32 4
kiril98402, не поверишь!
В паскале данный код работает!
Только нужно убрать следующие строки:
Pascal
1
2
3
4
{$APPTYPE CONSOLE}
 
uses
  SysUtils, Windows;
1
13107 / 5888 / 1707
Регистрация: 19.09.2009
Сообщений: 8,808
05.02.2015, 09:52 5
Да, та программа по ссылке, с небольшими поправками может быть скомпилирована в Pascal.
kiril98402, по твоему заданию в Borland/Turbo Pascal:
Pascal
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
program Project1;
 
{$N+} {Подключаем математический сопроцессор. При этом будет доступен вещественный тип Extended.}
 
type
  {Тип, описывающий оценку (TEstimate -> TEstm).}
  TEstm = 1..5;
  {Тип основных данных.}
  TData = record
    Fio,          {ФИО.}
    NGr : String; {Номер группы.}
    Arr : array [1..4] of TEstm; {Массив оценок.}
  end;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент.}
  end;
  {Тип, описывающий список.}
  TDList = record
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
    Cnt : Integer;          {Количество элементов в списке.}
  end;
 
{Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе, произойдёт утечка памяти.}
procedure Init(var aL : TDList);
begin
  aL.PFirst := nil;
  aL.PLast := nil;
  aL.Cnt := 0;
end;
 
{Освобождение памяти, занятой под список.}
procedure ListFree(var aL : TDList);
var
  PElem, PDel : TPElem;
begin
  PElem := aL.PFirst;      {Указатель на первый элемент списка.}
  while PElem <> nil do
  begin
    PDel := PElem;         {Указатель на удаляемый элемент.}
    PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
    Dispose(PDel);         {Освобождение памяти, занятой под удаляемый элемент.}
  end;
  Init(aL);
end;
 
{Добавление элемента в конец списка.}
procedure Add(var aL : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aL.PFirst = nil then {Если список пуст, то новый элемент становится первым элементом списка.}
    aL.PFirst := PElem
  else {Если список непустой, то новый элемент прикрепляем за последним элементом списка.}
    aL.PLast^.PNext := PElem;
  aL.PLast := PElem; {Новый элемент становится последним элементом списка.}
  Inc(aL.Cnt); {Отмечаем, что количество элементов в списке увеличилось на 1.}
end;
 
{Распечатка всего списка.}
procedure LWriteln(var aL : TDList);
var
  PElem : TPElem;
  i, j : Integer;
begin
  PElem := aL.PFirst; {Указатель на первый элемент списка.}
  if PElem = nil then
    Writeln('Список пуст.')
  else
  begin
    i := 0;
    while PElem <> nil do
      with PElem^.Data do
      begin
        Inc(i); {Порядковый номер элемента.}
        Write(i, ': ', Fio, ', № группы: ', NGr, ', оценки: '); {ФИО и номер группы.}
        for j := Low(Arr) to High(Arr) do {Перечень оценок.}
        begin
          if j > Low(Arr) then
            Write(', ');
          Write(Arr[j]);
        end;
        Writeln;
        PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
      end;
  end;
end;
 
{Диалог добавления элементов в список.}
procedure WorkAdd(var aL : TDList);
var
  S : String;
  Data : TData;
  Code, i, j : Integer;
begin
  Writeln('Добавление элементов в список.');
  i := 0; {Порядковый номер добавленного элемента.}
  repeat
    Write('Добавить элемент №', i + 1, '? (Да - Enter, Нет - любой символ и Enter): ');
    Readln(S);
    if S = '' then
      with Data do
      begin
        Write('ФИО: ');
        Readln(Fio);
        Write('№ группы: ');
        Readln(NGr);
        for j := Low(Arr) to High(Arr) do {Ввод оценок.}
          repeat
            Write('Оценка №', j, ': ');
            {$I-} {Отключение режима проверки ошибок ввода/вывода.}
            Readln(Arr[j]);
            {$I+} {Включение режима проверки ошибок ввода/вывода.}
            Code := IOResult; {Код результата последней операции ввода/вывода.}
            if (Code <> 0) or (Arr[j] < Low(TEstm)) or (Arr[j] > High(TEstm)) then
            begin
              Code := -1;
              Writeln('Неверный ввод! Значение должно быть целым числом из диапазона [',
                Low(TEstm), '..', High(TEstm), ']. Повторите.');
            end;
          until Code = 0;
        Add(aL, Data); {Добавление элемента в конец списка.}
        Inc(i);        {Порядковый номер добавленного элемента.}
      end;
  until S <> '';
  Writeln('Ввод элементов списка завершён.');
end;
 
{Процедура для создания списка из элементов, у которых средний бал = 3.}
procedure GetExcelList(const aL1 : TDList; var aL2 : TDList);
var
  P : TPElem;
  i, EstAvg : Integer;
  Avg : Extended;
begin
  ListFree(aL2);
  P := aL1.PFirst;
  while P <> nil do {Перебор элементов списка aL1.}
    with P^.Data do
    begin
      {Сначала вычисляем сумму оценок.}
      EstAvg := 0;
      for i := Low(Arr) to High(Arr) do
        Inc(EstAvg, Arr[i]); {Или: EstAvg := EstAvg + Arr[i];}
      {Вычисление средней оценки.}
      {Функция Round() округляет по банковскому правилу - при дробной части = 0.5,
      округление выполняется в сторону чётного числа. В данном случае нас такое
      округление не устраивает. Поэтому будем использовать математическое округление.}
      {Банковское округление.}
      {EstAvg := Round(EstAvg / Length(Arr));}
      {Математическое округление.}
      Avg := EstAvg / Length(Arr);
      if Frac(Avg) < 0.5 then
        EstAvg := Trunc(Avg) {Отсечение дробной части.}
      else
        EstAvg := Trunc(Avg) + 1;
      {Если средний бал = 3, то добавляем элемент в список aL2.}
      if EstAvg = 3 then
        Add(aL2, P^.Data);
      P := P^.PNext; {Указатель на следующий элемент списка aL1.}
    end;
end;
 
var
  L1, L2 : TDList;
  Cmd : Integer;
begin
  {Начальная инициализация списков.}
  Init(L1);
  Init(L2);
 
  repeat
    {Меню.}
    Writeln('----------');
    Writeln('Выберите действие:');
    Writeln('1: Добавление элементов в исходный список.');
    Writeln('2: Распечатка исходного списка.');
    Writeln('3: Очистка исходного списка.');
    Writeln('4: Создание производного списка из элементов, в которых средний бал равен 3.');
    Writeln('5: Распечатка производного списка.');
    Writeln('6: Очистка производного списка.');
    Writeln('7: Выход.');
    Write('Задайте команду: ');
    Readln(Cmd);
    case Cmd of
      1: WorkAdd(L1);
      2:
      begin
        Writeln('Содержимое исходного списка:');
        LWriteln(L1);
      end;
      3:
      begin
        ListFree(L1);
        Writeln('Исходный список очищен, память освобождена.');
      end;
      4:
      begin
        GetExcelList(L1, L2);
        Writeln('Составлен список из элементов, в которых только отличные оценки.');
      end;
      5:
      begin
        Writeln('Содержимое производного списка:');
        LWriteln(L2);
      end;
      6:
      begin
        ListFree(L2);
        Writeln('Производный список очищен, память освобождена.');
      end;
      7:
      begin
        ListFree(L1);
        ListFree(L2);
        Writeln('Память, выделенная для списков, освобождена.');
        Writeln('Работа программы завершена.');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
    Write('Для продолжения нажмите Enter.');
    Readln;
  until Cmd = 7;
end.
1
13107 / 5888 / 1707
Регистрация: 19.09.2009
Сообщений: 8,808
07.02.2015, 07:26 6
Подправил тексты. В процедуре, которая создаёт новый список, задействовал счётчик TDList.Cnt.
Pascal
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
program Project1;
 
{$N+} {Подключаем математический сопроцессор. При этом будет доступен вещественный тип Extended.}
 
type
  {Тип, описывающий оценку (TEstimate -> TEstm).}
  TEstm = 1..5;
  {Тип основных данных.}
  TData = record
    Fio,          {ФИО.}
    NGr : String; {Номер группы.}
    Arr : array [1..4] of TEstm; {Массив оценок.}
  end;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент.}
  end;
  {Тип, описывающий список.}
  TDList = record
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
    Cnt : Integer;          {Количество элементов в списке.}
  end;
 
{Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе, произойдёт утечка памяти.}
procedure Init(var aL : TDList);
begin
  aL.PFirst := nil;
  aL.PLast := nil;
  aL.Cnt := 0;
end;
 
{Освобождение памяти, занятой под список.}
procedure ListFree(var aL : TDList);
var
  PElem, PDel : TPElem;
begin
  PElem := aL.PFirst;      {Указатель на первый элемент списка.}
  while PElem <> nil do
  begin
    PDel := PElem;         {Указатель на удаляемый элемент.}
    PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
    Dispose(PDel);         {Освобождение памяти, занятой под удаляемый элемент.}
  end;
  Init(aL);
end;
 
{Добавление элемента в конец списка.}
procedure Add(var aL : TDList; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem);
  PElem^.Data := aData;
  PElem^.PNext := nil;
  if aL.PFirst = nil then {Если список пуст, то новый элемент становится первым элементом списка.}
    aL.PFirst := PElem
  else {Если список непустой, то новый элемент прикрепляем за последним элементом списка.}
    aL.PLast^.PNext := PElem;
  aL.PLast := PElem; {Новый элемент становится последним элементом списка.}
  Inc(aL.Cnt); {Отмечаем, что количество элементов в списке увеличилось на 1.}
end;
 
{Распечатка всего списка.}
procedure LWriteln(var aL : TDList);
var
  PElem : TPElem;
  i, j : Integer;
begin
  PElem := aL.PFirst; {Указатель на первый элемент списка.}
  if PElem = nil then
    Writeln('Список пуст.')
  else
  begin
    i := 0;
    while PElem <> nil do
      with PElem^.Data do
      begin
        Inc(i); {Порядковый номер элемента.}
        Write(i, ': ', Fio, ', № группы: ', NGr, ', оценки: '); {ФИО и номер группы.}
        for j := Low(Arr) to High(Arr) do {Перечень оценок.}
        begin
          if j > Low(Arr) then
            Write(', ');
          Write(Arr[j]);
        end;
        Writeln;
        PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
      end;
  end;
end;
 
{Диалог добавления элементов в список.}
procedure WorkAdd(var aL : TDList);
var
  S : String;
  Data : TData;
  Code, i : Integer;
begin
  Writeln('Добавление элементов в список.');
  repeat
    Write('Добавить элемент №', aL.Cnt + 1, '? (Да - Enter, Нет - любой символ и Enter): ');
    Readln(S);
    if S = '' then
      with Data do
      begin
        Write('ФИО: ');
        Readln(Fio);
        Write('№ группы: ');
        Readln(NGr);
        for i := Low(Arr) to High(Arr) do {Ввод оценок.}
          repeat
            Write('Оценка №', i, ': ');
            {$I-} {Отключение режима проверки ошибок ввода/вывода.}
            Readln(Arr[i]);
            {$I+} {Включение режима проверки ошибок ввода/вывода.}
            Code := IOResult; {Код результата последней операции ввода/вывода.}
            if (Code <> 0) or (Arr[i] < Low(TEstm)) or (Arr[i] > High(TEstm)) then
            begin
              Code := -1;
              Writeln('Неверный ввод! Значение должно быть целым числом из диапазона [',
                Low(TEstm), '..', High(TEstm), ']. Повторите.');
            end;
          until Code = 0;
        Add(aL, Data); {Добавление элемента в конец списка.}
      end;
  until S <> '';
  Writeln('Ввод элементов списка завершён.');
end;
 
{Процедура для создания списка из элементов, у которых средний бал = 3.}
procedure GetListNew(const aL1 : TDList; var aL2 : TDList);
var
  P : TPElem;
  i, EstAvg : Integer;
  Avg : Extended;
begin
  ListFree(aL2);
  P := aL1.PFirst;
  while P <> nil do {Перебор элементов списка aL1.}
    with P^.Data do
    begin
      {Сначала вычисляем сумму оценок.}
      EstAvg := 0;
      for i := Low(Arr) to High(Arr) do
        Inc(EstAvg, Arr[i]); {Или: EstAvg := EstAvg + Arr[i];}
      {Вычисление средней оценки.}
      {Функция Round() округляет по банковскому правилу - при дробной части = 0.5,
      округление выполняется в сторону чётного числа. В данном случае нас такое
      округление не устраивает. Поэтому будем использовать математическое округление.}
      {Банковское округление.}
      {EstAvg := Round(EstAvg / Length(Arr));}
      {Математическое округление.}
      Avg := EstAvg / Length(Arr);
      if Frac(Avg) < 0.5 then
        EstAvg := Trunc(Avg) {Отсечение дробной части.}
      else
        EstAvg := Trunc(Avg) + 1;
      {Если средний бал = 3, то добавляем элемент в список aL2.}
      if EstAvg = 3 then
        Add(aL2, P^.Data);
      P := P^.PNext; {Указатель на следующий элемент списка aL1.}
    end;
end;
 
var
  L1, L2 : TDList;
  Cmd : Integer;
begin
  {Начальная инициализация списков.}
  Init(L1);
  Init(L2);
 
  repeat
    {Меню.}
    Writeln('----------');
    Writeln('Выберите действие:');
    Writeln('1: Добавление элементов в исходный список.');
    Writeln('2: Распечатка исходного списка.');
    Writeln('3: Очистка исходного списка.');
    Writeln('4: Создание производного списка из элементов, в которых средний бал равен 3.');
    Writeln('5: Распечатка производного списка.');
    Writeln('6: Очистка производного списка.');
    Writeln('7: Выход.');
    Write('Задайте команду: ');
    Readln(Cmd);
    case Cmd of
      1: WorkAdd(L1);
      2:
      begin
        Writeln('Содержимое исходного списка:');
        LWriteln(L1);
      end;
      3:
      begin
        ListFree(L1);
        Writeln('Исходный список очищен, память освобождена.');
      end;
      4:
      begin
        GetListNew(L1, L2);
        Writeln('Составлен производный список.');
      end;
      5:
      begin
        Writeln('Содержимое производного списка:');
        LWriteln(L2);
      end;
      6:
      begin
        ListFree(L2);
        Writeln('Производный список очищен, память освобождена.');
      end;
      7:
      begin
        ListFree(L1);
        ListFree(L2);
        Writeln('Память, выделенная для списков, освобождена.');
        Writeln('Работа программы завершена.');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
    Write('Для продолжения нажмите Enter.');
    Readln;
  until Cmd = 7;
end.
1
0 / 0 / 1
Регистрация: 07.11.2014
Сообщений: 76
07.02.2015, 13:53  [ТС] 7
Вот есть код паскаль,только немогу подправить пункт Clear-очищение информации происходит только с экрана,а должно чистить память тоже неподскажите что нужно дописать?
Ткст:
Pascal
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
uses crt;
label metka;
type data=record
pip:string[20];
d1,d2,d3,d4:1..5;
end;
data_student=^student;
student=record
inf:data;
next:data_student;
end;
 
var pbeg:data_student;
elem:data;
ch:char;
i:byte;
flag,blag,mlag:boolean;
s:string;
 
procedure Init;
    begin
    new(pbeg);
    pbeg:=nil;
    end;
    
procedure add_beg (a:data);
    var temp:data_student;
    begin
    new(temp);
    temp^.inf:=a;
    if pbeg=nil then
        begin
        temp^.next:=nil;
        pbeg:=temp;
        end
    else
        begin
        temp^.next:=pbeg;
        pbeg:=temp;
        end;
    end;
 
function del_beg(var a:data):boolean;
        var temp: data_student;
        begin
        if pbeg=nil
            then del_beg:=false
        else
            begin
            del_beg:=true;
            new(temp);
            temp:=pbeg;
            a:=temp^.inf;
            if temp^.next=nil
            then begin
                dispose(temp);
            pbeg:=nil;
            end
        else begin
        pbeg:=temp^.next;
        dispose(temp);
        end;
        end;
                end;
    
procedure list;
    var temp:data_student;
    begin
    if pbeg=nil then
        begin
        writeln('Spusok pystuy');
        exit;
        end
    else
        begin
        new(temp);
        temp:=pbeg;
        repeat
        write(temp^.inf.pip,' ');
        write(temp^.inf.d1,' '); write(temp^.inf.d2,' ');
        write(temp^.inf.d3,' '); writeln(temp^.inf.d4);
        temp:=temp^.next;
        until temp=nil;
        end;
    dispose(temp);
        end;
        
function size:word;
    var temp:data_student;
    k:word;
    begin
    if pbeg=nil
    then k:=0
    else
        begin
        new(temp);
        temp:=pbeg;
        k:=0;
        while temp<>nil do
            begin
            temp:=temp^.next;
            inc(k);
            end;
        end;
    dispose(temp);
    size:=k;
    end;
    
procedure clear;
    var flag:boolean;
    begin
    while size<>0 do
    flag:=del_beg(elem);
    end;
    
procedure find(a:string);
    var temp:data_student;
    begin
    temp:=pbeg;
    blag:=false;
    while temp<>nil do
    begin
    if temp^.inf.pip=a then
    begin
    write(temp^.inf.pip,' ');
    write(temp^.inf.d1,' '); write(temp^.inf.d2,' ');
    write(temp^.inf.d3,' '); writeln(temp^.inf.d4);
    blag:=true;
    end;
    temp:=temp^.next;
    end;
    end;
    
    
procedure find_v;
    var temp:data_student;
    bal:real;
    begin
    mlag:=false;
    temp:=pbeg;
    while temp<>nil do
    begin
    bal:=(temp^.inf.d1+temp^.inf.d2+temp^.inf.d3+temp^.inf.d4)/4;
    if bal=3 then
    begin
    mlag:=true;
    write(temp^.inf.pip,' ');
    write(temp^.inf.d1,' '); write(temp^.inf.d2,' ');
    write(temp^.inf.d3,' '); writeln(temp^.inf.d4);
    end;
    temp:=temp^.next;
    end;
    end;
 
begin
metka:
clrscr;
writeln('1-Init');
writeln('2-Add_beg');
writeln('3-Del_beg');
writeln('4-List');
writeln('5-Size');
writeln('6-Find');
writeln('7-Clear');
writeln('8-Find(over_bal=3)');
writeln('9-Exit');
ch:=readkey;
case ch of
'1':begin
Init;
writeln('Data was initializated');
writeln('Press any key');
readkey;
goto metka;
end;
'2':begin
writeln('Input PIP?->');
readln(elem.pip);
writeln('Input 4 marks: ');
readln(elem.d1); readln(elem.d2);
readln(elem.d3); readln(elem.d4);
add_beg(elem);
writeln('Press any key');
readkey;
goto metka;
end;
'3':
begin
flag:=del_beg(elem);
if flag then
    begin
    write(elem.pip,' ');
    write(elem.d1,' '); write(elem.d2,' ');
    write(elem.d3,' '); writeln(elem.d4);
    writeln('This was deleted');
    end
    else writeln('Spisok pust');
readkey;
goto metka; 
end;
'4':begin
list;
writeln('Press any key');
readkey;
goto metka;
end;
'5':begin
writeln('Spisok mae ', size, ' elementiv');
writeln('Press any key');
readkey;
goto metka;
end;
'6':begin
write('Input PIP dlya perevirku: ');
readln(s);
find(s);
if blag=false
then writeln('V spusky ne isnye');
readkey;
goto metka;
end;
'7':begin
clear;
writeln('Spisok was cleared');
readkey;
goto metka;
end;
'8':begin
find_v;
if mlag=false
then writeln('Studentiv z over_bal 3 nemae');
readkey;
goto metka;
end;
end;
end.
0
13107 / 5888 / 1707
Регистрация: 19.09.2009
Сообщений: 8,808
07.02.2015, 14:20 8
Удаление из начала списка:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
function del_beg(var a : data) : Boolean;
var
  p : data_student;
begin
  del_beg := False;
  if pbeg <> nil then
  begin
    p := pbeg;
    pbeg := p^.next;
    a := p^.inf;
    Dispose(p);
    del_beg := True;
  end;
end;
Добавлено через 3 минуты
Добавление в начало списка:
Pascal
1
2
3
4
5
6
7
8
9
procedure add_beg(const a : data);
var
  P : data_student;
begin
  New(p);
  p^.inf := a;
  p^.next := pbeg;
  pbeg := p;
end;
Добавлено через 1 минуту
Вообще, здесь требуется доработка программы. Я сейчас напишу свой вариант для примера.
1
0 / 0 / 1
Регистрация: 07.11.2014
Сообщений: 76
07.02.2015, 14:25  [ТС] 9
Буду благодарен
0
13107 / 5888 / 1707
Регистрация: 19.09.2009
Сообщений: 8,808
08.02.2015, 06:23 10
Вариант программы со следующим меню:
Код
1: Добавление элементов в начало списка.
2: Удаление элементов из начала списка.
3: Очистка исходного списка.
4: Распечатка исходного списка.
5: Поиск элементов в исходном списке.
6: Создание производного списка из элементов, в которых
   средняя оценка равна 3.
7: Очистка производного списка.
8: Распечатка производного списка.
9: Выход.
Pascal
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
program Project1;
 
{$N+} {Подключение математического сопроцессора. При этом становится доступным тип Extended.}
 
type
  {Тип, описывающий оценку (TEstimate -> TEstm).}
  TEstm = 1..5;
  {Тип основных данных.}
  TData = record
    Fio,          {ФИО.}
    NGr : String; {Номер группы.}
    Arr : array [1..4] of TEstm; {Массив оценок.}
  end;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент.}
  end;
 
{Добавление элемента в начало списка.}
procedure AddF(var aPL : TPElem; const aData : TData);
var
  P : TPElem;
begin
  New(P);
  P^.Data := aData;
  P^.PNext := aPL;
  aPL := P;
end;
 
{Удаление элемента из начала списка. Если список непустой, то удаляется его
первый элемент и функция возвращает значение True. Если список пуст, то действие
отменяется и функция возвращает значение False.}
function DelF(var aPL : TPElem; var aData : TData) : Boolean;
var
  P : TPElem;
begin
  DelF := False;
  if aPL <> nil then
  begin
    P := aPL;
    aData := P^.Data;
    aPL := P^.PNext;
    Dispose(P);
    DelF := True;
  end;
end;
 
{Освобождение памяти, занятой для списка (очистка списка).}
procedure ListFree(var aPL : TPElem);
var
  Data : TData;
begin
  while DelF(aPL, Data) do;
end;
 
{Распечатка всего списка.}
procedure LWriteln(aPL : TPElem);
var
  i, j : Integer;
begin
  if aPL = nil then
    Writeln('Список пуст.')
  else
  begin
    i := 0;
    while aPL <> nil do
      with aPL^.Data do
      begin
        Inc(i); {Порядковый номер элемента.}
        Write(i, ': ', Fio, ', № группы: ', NGr, ', оценки: '); {ФИО и номер группы.}
        for j := Low(Arr) to High(Arr) do {Перечень оценок.}
          Write(Arr[j], ' ');
        Writeln;
        aPL := aPL^.PNext; {Указатель на следующий элемент списка.}
      end;
  end;
end;
 
{Процедура для создания списка из элементов, у которых средняя оценка = 3.}
procedure ListNew(aPL1 : TPElem; var aPL2 : TPElem);
var
  i, EstAvg : Integer;
  Avg : Extended;
begin
  ListFree(aPL2);   {Освобождаем память, выделенную для второго списка.}
  while aPL1 <> nil do {Перебор элементов списка aL1.}
    with aPL1^.Data do
    begin
      {Сначала вычисляем сумму оценок.}
      Avg := 0;
      for i := Low(Arr) to High(Arr) do
        Avg := Avg + Arr[i];
      {Вычисление средней оценки.}
      Avg := Avg / Length(Arr);
      {Приводим результат к целому числу путём математического округления.}
      if Frac(Avg) < 0.5 then {Если дробная часть меньше, чем 0.5.}
        EstAvg := Trunc(Avg)  {Отсечение дробной части.}
      else                    {Иначе - если дробная часть больше или равна 0.5.}
        EstAvg := Trunc(Avg) + 1;
      {Если средняя оценка = 3, то добавляем элемент в список aL2.}
      if EstAvg = 3 then
        AddF(aPL2, aPL1^.Data);
      aPL1 := aPL1^.PNext; {Указатель на следующий элемент списка aL1.}
    end;
end;
 
{Диалог добавления элементов в список.}
procedure WorkAdd(var aPL : TPElem);
var
  S : String;
  Data : TData;
  Code, i : Integer;
begin
  repeat
    Write('Добавить элемент в начало списка? (Да - Enter, Нет - любой символ и Enter): ');
    Readln(S);
    if S = '' then
      with Data do
      begin
        Write('ФИО: ');
        Readln(Fio);
        Write('№ группы: ');
        Readln(NGr);
        for i := Low(Arr) to High(Arr) do {Ввод оценок.}
        repeat
          Write('Оценка №', i, ': ');
          {$I-} {Отключение режима проверки ошибок ввода/вывода.}
          Readln(Arr[i]);
          {$I+} {Включение режима проверки ошибок ввода/вывода.}
          Code := IOResult; {Код результата последней операции ввода/вывода.}
          if (Code <> 0) or (Arr[i] < Low(TEstm)) or (Arr[i] > High(TEstm)) then
          begin
            Code := -1;
            Writeln('Неверный ввод! Значение должно быть целым числом из диапазона [',
              Low(TEstm), '..', High(TEstm), ']. Повторите.');
          end;
        until Code = 0;
        AddF(aPL, Data); {Добавление элемента в начало списка.}
      end;
  until S <> '';
  Writeln('Диалог ввода элементов списка завершён.');
end;
 
{Диалог удаления элементов из списка.}
procedure WorkDel(var aPL : TPElem);
var
  S : String;
  Data : TData;
  i : Integer;
begin
  repeat
    Write('Удалить элемент из начала списка? (Да - Enter, Нет - любой символ и Enter): ');
    Readln(S);
    if S = '' then
      if DelF(aPL, Data) then {Попытка удаления элемента.}
      begin
        Writeln('Удалён элемент:');
        Write('ФИО: ', Data.Fio, ', № группы: ', Data.NGr, ', оценки: '); {Распечатка ФИО и № группы.}
        for i := Low(Data.Arr) to High(Data.Arr) do {Распечатка оценок.}
          Write(Data.Arr[i], ' ');
        Writeln;
      end
      else
        Writeln('Список пуст. Действие отменено.');
  until (S <> '') or (aPL = nil);
  Writeln('Диалог удаления элементов списка завершён.');
end;
 
{Диалог поиска и распечатки элементов с заданным ФИО (фамилия, имя, отчество).}
procedure WorkFind(const aPL : TPElem);
var
  P : TPElem;
  S, SFio : String;
  i, j : Integer;
begin
  repeat
    Write('Выполнить поиск элемента? (Да - Enter, Нет - любой символ и Enter): ');
    Readln(S);
    if S = '' then
    begin
      Write('Задайте ФИО: ');
      Readln(SFio);
      P := aPL;
      i := 0;
      while P <> nil do
        with P^.Data do
        begin
          if Fio = SFio then
          begin
            Inc(i);
            Write(i, ': ', Fio, ', № группы: ', NGr, ', оценки: '); {ФИО и номер группы.}
            for j := Low(Arr) to High(Arr) do {Перечень оценок.}
              Write(Arr[j], ' ');
            Writeln;
          end;
          P := P^.PNext;
        end;
      Writeln('Всего найдено элементов: ', i);
    end;
  until S <> '';
  Writeln('Диалог поиска элементов списка завершён.');
end;
 
var
  PL1, PL2 : TPElem;
  Cmd : Integer;
begin
  {Начальная инициализация списков.}
  PL1 := nil;
  PL2 := nil;
  repeat
    {Меню.}
    Writeln('----------');
    Writeln('Выберите действие:');
    Writeln('1: Добавление элементов в начало списка.');
    Writeln('2: Удаление элементов из начала списка.');
    Writeln('3: Очистка исходного списка.');
    Writeln('4: Распечатка исходного списка.');
    Writeln('5: Поиск элементов в исходном списке.');
    Writeln('6: Создание производного списка из элементов, в которых',
      #13#10'   средняя оценка равна 3.');
    Writeln('7: Очистка производного списка.');
    Writeln('8: Распечатка производного списка.');
    Writeln('9: Выход.');
    Write('Задайте команду: ');
    Readln(Cmd);
    case Cmd of
      1: WorkAdd(PL1);
      2: WorkDel(PL1);
      3:
      begin
        ListFree(PL1);
        Writeln('Исходный список очищен, память освобождена.');
      end;
      4:
      begin
        Writeln('Содержимое исходного списка:');
        LWriteln(PL1);
      end;
      5: WorkFind(PL1);
      6:
      begin
        ListNew(PL1, PL2);
        Writeln('Составлен производный список.');
      end;
      7:
      begin
        ListFree(PL2);
        Writeln('Производный список очищен, память освобождена.');
      end;
      8:
      begin
        Writeln('Содержимое производного списка:');
        LWriteln(PL2);
      end;
      9:
      begin
        ListFree(PL1);
        ListFree(PL2);
        Writeln('Память, выделенная для списков, освобождена.');
        Writeln('Работа программы завершена.');
      end;
      else
        Writeln('Незарегистрированная команда. Повторите ввод.');
    end;
    Write('Для продолжения нажмите Enter.');
    Readln;
  until Cmd = 9;
end.
Добавлено через 13 часов 49 минут
Если нужно добавить пункт для определения количества элементов в списке:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
{Функция для определения количества элементов в списке.}
function ListSize(aPL : TPElem) : Integer;
var
  Cnt : Integer;
begin
  Cnt := 0;
  while aPL <> nil do
  begin
    Inc(Cnt);
    aPL := aPL^.PNext;
  end;
  ListSize := Cnt;
end;
Затем, в код меню добавить соответствующий пункт и вывод реализовать таким образом:
Pascal
1
2
3
4
5
case Cmd of
  ...
  NN: Writeln('Количество элементов в исходном списке: ', ListSize(PL1));
  ...
end;
0
08.02.2015, 06:23
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
08.02.2015, 06:23
Помогаю со студенческими работами здесь

Разработать программу, которая вводит фактические данные из таблицы и выводит на экран таблицу
Помогите сделать это задание(желательно в Visual Studio). 1. Разработать программу, которая...

Разработать программу, которая вводит данные и выводит текст TRUE, буду очень благодарен
Задание 1 Постановка задачи. Разработать программу, которая вводит данные и выводит текст TRUE,...

Разработать программу, которая вводит данные и выводит тест True если условие истинно, в противном случае False
Разработать программу, которая вводит данные и выводит тест TRUE , если указанное в варианте...

Разработать программу, которая читает c клавиатуры данные о лицах ...прог. record
type data=record day:1..31; month: 1..12; year:integer; end; Person=record...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
10
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru