Список: удаление элемента и всего списка
10.12.2016, 19:25. Показов 1286. Ответов 0
Возникли проблемы с процедурой удаления. При удалении первого элемента удалялось всё, кроме первого (при добавлении нового элемента оставался один только этот элемент). При удалении со 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
|