Процедуры в delphi

@Sonyaaa · Регистрация: 26.10.2012

Студворк — интернет-сервис помощи студентам

Здравствуйте, у меня тут такая проблема, нужно сделать лабораторную. Задание:
Создать базу данных для хранения следующей информации: наименование оборудования, дата покупки, дата истечения гарантии, стоимость, фирма-производитель.
1. Получить список оборудования, на которое истечет гарантия во втором полугодии следующего года.
2. Найти общую стоимость оборудования, выпущенного заданной фирмой-производителем.
3. Найти количество оборудования, приобретенного за август прошлого года.
4. Определить средний срок (в месяцах) гарантии на указанное оборудование, выпущенное указанной фирмой.

Вот сама программа, которая у меня получилась:

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
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
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
program lab1112;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils,
  Windows;
 
type  Date=record
      D:0..31;{дни}
      M:0..12;{месяцы}
      Y:0..2012;{годы}
      end;
 
      Rec=record
      Obor:string;{Наименование оборудования}
      Date_P:Date;{Дата покупки}
      Date_IG:Date;{Дата истечения гарантии}
      Sto:string;{Стоимость}
      Firm:string;{Фирма-производитель}
      end;
 
      Mas=array of Rec;
 
var M: Mas;
    i: integer;
    o,j,s,e,z,b,f: integer;
    Firm1,Firm2,Obor1,W: string;
    Dates: Date;
    P,Q: double;
procedure Gen(var M:Mas); //рандомное составление базы данных из 200 записей
var e,o:Integer;
    k:string;
    F:array[0..4] of string;
    N:array[0..4] of string;
 
begin
  Randomize;
  k:='АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
  F[0]:='Sony';
  F[1]:='Apple';
  F[2]:='Philips';
  F[3]:='ASUS';
  F[4]:='HP';
  N[0]:='Мобильный телефон';
  N[1]:='Коммуникатор';
  N[2]:='Планшетный ПК';
  N[3]:='Ноутбук';
  N[4]:='Аудиоплеер';
 
  for i:=1 to 200 do
  begin
    o:=Random(4);
    M[i].Firm:=F[o];
    e:=Random(4);
    M[i].Obor:=N[e];
    M[i].Sto:=IntToStr(Random(50000));
    M[i].Date_P.M:=1+random(11);
    if (M[i].Date_P.M=1) or(M[i].Date_P.M=3) or (M[i].Date_P.M=5) or (M[i].Date_P.M=7) or
    (M[i].Date_P.M=8) or (M[i].Date_P.M=10) or (M[i].Date_P.M=12) and (M[i].Date_P.M<>2) then
      M[i].Date_P.D:=1+random(30) else
      M[i].Date_P.D:=1+random(29);
    if M[i].Date_P.M=2 then M[i].Date_P.D:=1+random(27);
    M[i].Date_P.Y:=2008+random(Dates.Y-2008);
    M[i].Date_IG.M:=1+random(11);
    if (M[i].Date_IG.M=1) or(M[i].Date_IG.M=3) or (M[i].Date_IG.M=5) or (M[i].Date_IG.M=7) or
    (M[i].Date_IG.M=8) or (M[i].Date_IG.M=10) or (M[i].Date_IG.M=12) and (M[i].Date_IG.M<>2) then
      M[i].Date_IG.D:=1+random(30) else
      M[i].Date_IG.D:=1+random(29);
    if M[i].Date_IG.M=2 then M[i].Date_IG.D:=1+random(27);
    M[i].Date_IG.Y:=2009+random(Dates.Y-2008);
  end;
end;
 
procedure Vivod(i,b:Integer; M:Mas);  //print - вывод записи на экран
begin
Writeln('Какую запись показать?');
Readln(i);
if i<=b then
  begin
    Writeln('Наименование оборудования:', M[i].Obor);
    Writeln('Дата покупки:');
    Writeln('День:', M[i].Date_P.D);
    Writeln('Месяц:', M[i].Date_P.M);
    Writeln('Год:', M[i].Date_P.Y);
    Writeln('Дата истечения гарантии:');
    Writeln('День:', M[i].Date_IG.D);
    Writeln('Месяц:', M[i].Date_IG.M);
    Writeln('Год:', M[i].Date_IG.Y);
    Writeln('Стоимость:', M[i].Sto);
    Writeln('Фирма-производитель', M[i].Firm);
  end
  else Writeln('Такой записи не существует.');
end;
 
procedure help;   //help -  помощь
begin
  Writeln;
  Writeln('add-добавить запись');
  Writeln('delete-удалить запись');
  Writeln('edit-редактировать запись');
  Writeln('exit-выйти из программы');
  Writeln('print-вывести запись');
  Writeln('1-Получить список оборудования, на которое истечет гарантия во втором полугодии следующего года.');
  Writeln('2-Найти общую стоимость оборудования, выпушенного заданной фирмой-производителем.');
  Writeln('3-Найти количество оборудования, приобратанного за август прошлого года.');
  Writeln('4-Определить средний срок(в месяцах) гарантии на указанное оборудование, выпущенное указанной фирмой-производителем.');
end;
 
procedure Vvod_Date(var Dates:Date);  //ввод даты
begin
  Writeln('Введите текущую дату:');
  Write('День:'); Readln(Dates.D);
  Write('Месяц:'); Readln(Dates.M);
  Write('Год:'); Readln(Dates.Y);
end;
 
procedure Add(i:Integer; var M:Mas);   //add - добавление записи
begin
  Writeln;
  Write('Введите номер заполняемой записи: ');
  Readln(i);
  Writeln;
  if(b-1)<i then
  begin
    b:=i;
    SetLength(M,b+1);
  end;
  Writeln('Заполним ', i ,' запись.');
  Writeln('Наименование оборудования:'); Readln(M[i].Obor);
  Writeln('Фирма-производитель:'); Readln(M[i].Firm);
  Writeln('Стоимость:'); Readln(M[i].Sto);
  Writeln('Дата покупки:');
  Write('День:'); Read(M[i].Date_P.D);
  Write('Месяц:'); Read(M[i].Date_P.M);
  Write('Год:'); Read(M[i].Date_P.Y);
  Writeln('Дата истечения гарантии:');
  Write('День:'); Read(M[i].Date_IG.D);
  Write('Месяц:'); Read(M[i].Date_IG.M);
  Write('Год:'); Read(M[i].Date_IG.Y);
end;
 
procedure Del(i:Integer; var M:Mas);   //del - удаление записи
begin
  Writeln;
  Writeln('Введите номер удаляемой записи:');
  Readln(i);
  M[i].Obor:=' ';
  M[i].Firm:=' ';
  M[i].Sto:=' ';
  M[i].Date_P.D:=0;
  M[i].Date_P.M:=0;
  M[i].Date_P.Y:=0;
  M[i].Date_IG.D:=0;
  M[i].Date_IG.M:=0;
  M[i].Date_IG.Y:=0;
end;
 
procedure one(i,b:Integer; Dates:Date; var M:Mas);      //1 - 1 задание
  procedure one1(i,b:Integer; Dates:Date; var M:Mas);
  begin
    If (M[i].Date_IG.M=7) or (M[i].Date_IG.M=8) or (M[i].Date_IG.M=9) or (M[i].Date_IG.M=10) or
    (M[i].Date_IG.M=11) or (M[i].Date_IG.M=12) and (M[i].Date_IG.Y=(Dates.Y+1)) then
    begin
      Write('Фирма-производитель: ', M[i].Firm, ' ');
      Write('Оборудование: ', M[i].Obor, ' ');
      Writeln;
    end;
  end;
begin
  Writeln('Cписок оборудования, на которое истечет гарантия во втором полугодии следующего года:');
  for i:=1 to b do
  one1(i,b,Dates,M);
end;
 
procedure two(i,b,s:Integer; Firm1:string; var M:Mas);   //2 - второе задание
  procedure two2(i,b,s:Integer; Firm1:string; var M:Mas);
  begin
    S:=0;
    for i:=1 to b do
    begin
      if Firm1=M[i].Firm then
      S:=S+StrToInt(M[i].Sto);
    end;
    Writeln('Фирмой ', Firm1, ' выпущено товаров на сумму ', S);
  end;
begin
  Writeln('Введите фирму: ');
  Readln(Firm1);
  two2(i,b,s,Firm1,M);
end;
 
procedure three(i,j,b:Integer; Dates:Date; var M:Mas);   //3 - третее задание
  procedure three3(i,j,b:Integer; Dates:Date; var M:Mas);
  begin
    if (M[i].Date_P.M=8) and (M[i].Date_P.Y=Dates.Y-1) then
    j:=j+1;
  end;
begin
  write('За август прошлого года продано ');
  for i:=1 to b do
  begin
    three3(i,j,b,Dates,M);
  end;
  write(j, ' товаров.');
end;
 
procedure four(i,b:integer; var P:Double); // 4 - четвертое задание
  procedure four4(i,b:integer; var P:Double);
  var Month1,Month2:TDateTime;
  begin
    Month1:=StrToDate(IntToStr(M[i].Date_P.M)+ '.' + IntToStr(M[i].Date_P.Y));
    Month2:=StrToDate(IntToStr(M[i].Date_IG.M)+ '.' + IntToStr(M[i].Date_IG.Y));
    P:=Month2-Month1;
  end;
begin
  Writeln('Введите фирму: '); Readln(Firm2);
  Writeln('Введите наименование оборудования: '); Readln(Obor1);
  z:=1;
  Q:=0;
  for i:=1 to b do
  If (M[i].Firm=Firm2) and (M[i].Obor=Obor1) then
  begin
    z:=z+1;
    four4(i,b,P);
    Q:=Q+P;
  end;
  if z<>1 then
  Q:=Q/z;
  Writeln('Средний скор гарантии на ', Obor1, ' фирмы ', Firm2, '  равен ', Q:0:0, '(В месяцах)');
end;
 
begin                                 // сама программа
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
  SetLength(M,201);
  f:=0;
  i:=200;
  b:=200;
  Vvod_Date(Dates);
  Gen(M);
    {for i:=1 to b do
    if(M[i].Date_P.M=7) and (M[i].Date_P.Y=Dates.Y-1)
    then Writeln(M[i].Firm);  }
  while f=0 do
  begin
    Writeln;
    Writeln('Введите команду:');
    Readln(W);
    if (W='Print') or (W='print') then
    begin
      Vivod(i,b,M);
    end;
    if (W='Help') or (W='help') then
    begin
      help;
    end;
    if (W='Delete') or (W='delete') then
    begin
      Del(i,M);
    end;
    if (W='Add') or (W='add') then
    begin
      Add(i,M);
    end;
    if (W='Exit') or (W='exit') then
    begin
      f:=1;
    end;
    if (W='1') then
    begin
      Writeln;
      one(i,b,DAtes,M);
    end;
    if (W='2') then
    begin
      Writeln;
      two(i,b,s,Firm1,M);
    end;
    if (W='3') then
    begin
      Writeln;
      three(i,j,b,DAtes,M);
    end;
    if (W='4') then
    begin
      Writeln;
      four(i,b,P);
    end;
  end;
  Readln;
end.

у меня есть пара просьб.
1.)Не могли бы Вы посмотреть почему процедура для 3 задания работает не правильно, я понять не могу никак(
2.)Нужно сделать так, чтобы при удалении записи, программа смещала все записи(т.е. если я удалила 5-ю запись, то 6-я запись станет 5-й, 7-я станет 6-й и т.д.) и то же самое при добавлении записи.
Буду очень благодарна

Новые блоги и статьи Все статьи Все блоги /
Программный отбор значения справочника Maks 21.03.2026 Процедура ВодителиНачалоВыбора(Элемент, ДанныеВыбора, ВыборДобавлением, СтандартнаяОбработка) / / Отключаем стандартную обработку (стандартное открытие формы выбора без фильтров) . . .	Переходник USB-CAN-GPIO Eddy_Em 20.03.2026 Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .	Оттенки серого Argus19 18.03.2026 Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .	SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip
Символические и жёсткие ссылки в Linux. algri14 15.03.2026 Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .	[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ФедосеевПавел 14.03.2026 Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .	делаю науч статью по влиянию грибов на сукцессию anaschu 13.03.2026 прикрепляю статью	SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат: