Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
0 / 0 / 0
Регистрация: 21.11.2016
Сообщений: 6
1

Список: удаление элемента и всего списка

10.12.2016, 19:25. Показов 1286. Ответов 0
Метки нет (Все метки)

Author24 — интернет-сервис помощи студентам
Возникли проблемы с процедурой удаления. При удалении первого элемента удалялось всё, кроме первого (при добавлении нового элемента оставался один только этот элемент). При удалении со 2 до предпоследнего удалялись все элементы с выбранного до последнего (при добавлении всё исправлялось). При удалении последнего элемента он не удалялся (при добавлении нового элемента удалялся последний элемент, а новый не добавлялся). В предыдущей версии (до введения переменной Х, первоначальный вид программы) такая проблема возникала только при удалении последнего элемента списка, которая исправлялась при добавлении нового. Прикладываю новый код:
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
program Lab6;
{$APPTYPE CONSOLE}
{$R *.res}
uses
  System.SysUtils;
 
const a:array[1..8] of string[50]=('1.Create list','2.Show list','3.Delete person','4.Add person','5.Create file and add informations to file','6.Read list from file','7.Delete list','8.Exit');
Type ss=string[100];
DD=record
  Fn:ss;
  sn:ss;
  tn:ss;
  Addres:ss;
  Number:ss;
end;
Plist=^list;
list=record
  lis:dd;
  next:Plist;
end;
ff=file of DD;
procedure AddL(var aPList, aPElem,x1 : plist);
begin
  if aPElem = nil then Exit;
   if aPList = nil then
    begin
    x1:=apelem;
    aPElem^.Next := aPElem //Единственный элемент указывает сам на себя.
    end
  else begin     //Добавляем новый элемент после последнего в списке.
    aPElem^.Next := aPList^.Next;
    aPList^.Next := aPElem;
  end;
  //Указатель списка переводим на добавленный элемент. - Теперь он является
  //последним в списке.
  aPList := aPElem;
end;
Procedure CreateList(var lp,pelem,x1:plist; var z:integer);
Var i,m1:integer;
Begin
if z<>0 then
  begin
  Writeln('List already was created');
  exit;
  end;
Writeln('How much persons do you want to add?');
Readln(m1);
for I := 1 to m1 do
Begin
new(lp);
Writeln('Person ',i,':');
Write('First name: ');
Readln(lp^.lis.fn);
Write('Second name: ');
Readln(lp^.lis.sn);
Write('Thirdname: ');
Readln(lp^.lis.tn);
Write('Addres: ');
Readln(lp^.lis.Addres);
Write('Number: ');
Readln(lp^.lis.Number);
AddL(pelem,lp,x1);
z:=z+1;
End;
Writeln('***List was created***');
End;
procedure Show(const aPList ,x1: plist);
var
  PElem: plist;
  i: Integer;
begin
  if aPList = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
  Writeln('List:');
  PElem := x1; //Указатель на первый элемент списка.
  i:=0;
  Repeat
    Inc(i);
    Write(i,':  ',PElem^.lis.Fn,' ',PElem^.lis.sn,' ',PElem^.lis.tn,' ',PElem^.lis.Addres,' ',PElem^.lis.number);
    Writeln;
    PElem := PElem^.Next;
    Until pelem=aPlist.next;
  Writeln;
end;
Procedure CreateFile(var f1:ff; var filenamex:ss; var ps1,x1:plist);
Var i:integer;
ps2:plist;
Begin
if ps1 = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
ps2 := x1;
Writeln('Write name of file');
Readln(filenamex);
Assignfile(f1,filenamex);
Rewrite(f1);
Repeat
write(f1,ps2.lis);
Ps2 := x1;
Until ps2=ps1.next;
Writeln('***Persons was saved***');
Writeln('File:');
ps2:=ps1.next;
i:=0;
Repeat
  inc(i);
  Write(i,':  ',Ps2^.lis.Fn,' ',Ps2^.lis.sn,' ',Ps2^.lis.tn,' ',Ps2^.lis.Addres,' ',Ps2^.lis.number);
  Writeln;
  ps2 := ps2^.Next;
Until ps2=ps1.next;
End;
Procedure delete(var pelem,x1:plist);
Var s:string;
t:plist;
Begin
if pelem = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
Writeln('***Delete***');
Writeln('Write first name');
Readln(s);
t:=pelem;
while (pelem<>nil)and (pelem^.lis.Fn<>s) do
  begin
  t:=pelem;
  pelem:=pelem^.next;
  end;
if (pelem<>nil) then
    Begin
    T^.next:=pelem^.next;
    Dispose(pelem);
    End
    else t^.next:=nil;
Writeln('***Person was deleted***');
End;
Procedure Add(var lp,pelem,x1:plist);
Begin
if lp = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
Writeln('***Add***');
Writeln('Write about new person');
new(lp);
Write('First name: ');
Readln(lp^.lis.fn);
Write('Second name: ');
Readln(lp^.lis.sn);
Write('Thirdname: ');
Readln(lp^.lis.tn);
Write('Addres: ');
Readln(lp^.lis.Addres);
Write('Number: ');
Readln(lp^.lis.Number);
AddL(pelem,lp,x1);
Writeln('***Person was added***');
End;
Procedure ReadF(var f1:ff; var filenamex:ss; var ps1,ps2,x1:plist);
Var i:integer;
Begin
Writeln('Write name of file');
Readln(filenamex);
if  not FileExists(filenamex) then
  begin
  Writeln('File was not found');
  Exit;
  end;
Writeln('***Reading***');
Assignfile(f1,filenamex);
i:=0;
Reset(f1);
while not EOF(f1) do
  begin
  new(ps1);
  Read(f1,ps1.lis);
  addL(ps2,ps1,x1);
  end;
Closefile(f1);
Writeln('File was read');
End;
procedure ListFree(var x1: pList; var z:integer);
var
  PNext, PDel : plist;
begin
  if x1 = nil then Exit;
  PNext := x1;
  while PNext^.next <> nil do begin
    PDel := PNext;
    PNext := PNext^.Next;
    Writeln('fghn');
    Dispose(PDel);
  end;
  z:=0;
end;
Var i,n,z1:integer;
f:ff;
ps,pd,x:plist;
filename:ss;
begin
Writeln('***Start work***');
for I := 1 to 8 do writeln(a[i]);
 Readln(n);
 while (n>0) and (n<9) do
  begin
  case n of
  1: Createlist(ps,pd,x,z1);
  2: Show(ps,x);
  3: delete(ps,x);
  4: add(ps,pd,x);
  5: CreateFile(f,filename,ps,x);
  6: ReadF(f,filename,ps,pd,x);
  7: ListFree(x,z1);
  8: halt;
  end;
  Readln(n);
  end;
end.
И первоначальный код:
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
program Lab6;
{$APPTYPE CONSOLE}
{$R *.res}
uses
  System.SysUtils;
const a:array[1..7] of string[50]=('1.Create list','2.Show list','3.Delete person','4.Add person','5.Create file and add informations to file','6.Read list from file','7.Exit');
Type ss=string[100];
DD=record
  Fn:ss;
  sn:ss;
  tn:ss;
  Addres:ss;
  Number:ss;
end;
Plist=^list;
list=record
  lis:dd;
  next:Plist;
end;
ff=file of DD;
Var i,n:integer;
f:ff;
ps,pd:plist;
filename:ss;
procedure AddL(var aPList, aPElem : plist);
begin
  if aPElem = nil then Exit;
   if aPList = nil then
    aPElem^.Next := aPElem //Единственный элемент указывает сам на себя.
  else begin     //Добавляем новый элемент после последнего в списке.
    aPElem^.Next := aPList^.Next;
    aPList^.Next := aPElem;
  end;
  //Указатель списка переводим на добавленный элемент. - Теперь он является
  //последним в списке.
  aPList := aPElem;
end;
Procedure CreateList(var lp,pelem:plist);
Var i,m1:integer;
Begin
Writeln('How much persons do you want to add?');
Readln(m1);
for I := 1 to m1 do
Begin
new(lp);
Writeln('Person ',i,':');
Write('First name: ');
Readln(lp^.lis.fn);
Write('Second name: ');
Readln(lp^.lis.sn);
Write('Thirdname: ');
Readln(lp^.lis.tn);
Write('Addres: ');
Readln(lp^.lis.Addres);
Write('Number: ');
Readln(lp^.lis.Number);
AddL(pelem,lp);
End;
Writeln('***List was created***');
End;
procedure Show(const aPList : plist);
var
  PElem: plist;
  i: Integer;
begin
  if aPList = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
  Writeln('List:');
  PElem := aPList.Next; //Указатель на первый элемент списка.
  i:=0;
  Repeat
    Inc(i);
    Write(i,':  ',PElem^.lis.Fn,' ',PElem^.lis.sn,' ',PElem^.lis.tn,' ',PElem^.lis.Addres,' ',PElem^.lis.number);
    Writeln;
    PElem := PElem^.Next;
    Until pelem=aPlist.next;
  Writeln;
end;
Procedure CreateFile(var f1:ff; var filenamex:ss; var ps1:plist);
Var i:integer;
ps2:plist;
Begin
if ps1 = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
ps2 := ps1.Next;
Writeln('Write name of file');
Readln(filenamex);
Assignfile(f1,filenamex);
Rewrite(f1);
Repeat
write(f,ps2.lis);
Ps2 := ps2^.Next;
Until ps2=ps1.next;
Writeln('***Persons was saved***');
Writeln('File:');
ps2:=ps1.next;
i:=0;
Repeat
  inc(i);
  Write(i,':  ',Ps2^.lis.Fn,' ',Ps2^.lis.sn,' ',Ps2^.lis.tn,' ',Ps2^.lis.Addres,' ',Ps2^.lis.number);
  Writeln;
  ps2 := ps2^.Next;
Until ps2=ps1.next;
End;
Procedure delete(var pelem:plist);
Var s:string;
t:plist;
Begin
if pelem = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
Writeln('***Delete***');
Writeln('Write first name');
Readln(s);
t:=pelem;
while (pelem<>nil)and (pelem^.lis.Fn<>s) do
  begin
  t:=pelem;
  pelem:=pelem^.next;
  end;
if (pelem<>nil) then
    Begin
    T^.next:=pelem^.next;
    Dispose(pelem);
    End
    else t^.next:=nil;
Writeln('***Person was deleted***');
End;
Procedure Add(var lp,pelem:plist);
Begin
if lp = nil then begin
    Writeln('List is empty.');
    Exit;
  end;
Writeln('***Add***');
Writeln('Write about new person');
new(lp);
Write('First name: ');
Readln(lp^.lis.fn);
Write('Second name: ');
Readln(lp^.lis.sn);
Write('Thirdname: ');
Readln(lp^.lis.tn);
Write('Addres: ');
Readln(lp^.lis.Addres);
Write('Number: ');
Readln(lp^.lis.Number);
AddL(pelem,lp);
Writeln('***Person was added***');
End;
Procedure ReadF(var f1:ff; var filenamex:ss; var ps1,ps2:plist);
Var i:integer;
Begin
Writeln('Write name of file');
Readln(filenamex);
if  not FileExists(filenamex) then
  begin
  Writeln('File was not found');
  Exit;
  end;
Writeln('***Reading***');
Assignfile(f1,filenamex);
{$I-}
i:=0;
Reset(f1);
while not EOF(f) or (i<>5) do
  begin
  inc(i);
  new(ps1);
  Read(f1,ps1.lis);
  addL(ps2,ps1);
  end;
Writeln('File was read');
End;
begin
Writeln('***Start work***');
for I := 1 to 7 do writeln(a[i]);
 Readln(n);
 while (n>0) and (n<8) do
  begin
  case n of
  1: Createlist(ps,pd);
  2: Show(ps);
  3: delete(ps);
  4: add(ps,pd);
  5: CreateFile(f,filename,ps);
  6: ReadF(f,filename,ps,pd);
  7: halt;
  end;
  Readln(n);
  end;
end.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
10.12.2016, 19:25
Ответы с готовыми решениями:

Вставка нового элемента в список, удаление элемента из списка, просмотра содержимого списка
очень нужно:tender: 1. Разработать подпрограммы, реализующие основные операции обработки линейного...

Удаление элемента списка и всего списка
Компилируется, но не работает. Что и как исправить? #include &lt;cstdlib&gt; #include &lt;iostream&gt;...

Список: Формирование списка из n элементов, вставка элемента после минимального, удаление дубликатов.
Формирование списка из n элементов. Вставка элемента после минимального. Оставить в списке только...

Удаление всего списка
Организовать линейный список цветов: хранить название цвета и его числовой код. Упорядочивать по...

0
10.12.2016, 19:25
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
10.12.2016, 19:25
Помогаю со студенческими работами здесь

программа которая берет список и создает список другой из этого же списка + тот же список без последнего элемента
надо написать программу которая берет список и создает список другой из этого же списка + тот же...

Удаление элемента, стоящего посередине списка (если длина списка нечетна)
Написать функцию, которая удаляет из списка элемент, стоящий в середине (удалённый от начала и...

Однонаправленный список. Вывод элементов, списка. Удаление списка.
Создать однонаправленный список натуральных чисел. Найти и вывести элементы списка, кратные 3....

Удаление элемента списка/вывод нового списка
В общем, в 3м массиве у меня по идее должен был собраться новый список но выводится он чего-то не...


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

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