вот верный код(по крайней мере мою во время работы программы ошибок обнаружено не было), ну и нужна норм очистка списка
[more]unit AbstractUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, XPMan, ComCtrls, ExtCtrls, Grids;
type
list = ^cell;
elementtype = record
author, name, subject: shortstring;
year: integer;
end;
cell = record
element: elementtype;
next: list;
end;
//------------------------------------------------------------------------------
procedure InsertValue(x: elementtype; var head, pos: list);
procedure PrintList(head: list);
procedure MakeNull(var head: list);
procedure SaveListToFile(head: list; fName: string);
procedure LoadListFromFile(var head: list; fName: string);
function Locate(x: elementtype; head: list): list;
procedure DeleteValue(var pos, head: list);
//------------------------------------------------------------------------------
var
head, el_pos: list;
x: elementtype;
implementation
uses MainUnit;
{вставляет элемент х в список}
procedure InsertValue(x: elementtype; var head, pos: list);
var
p: list;
begin
New(p);
if head = nil then head:= p
else pos.next:= p;
p.element:= x;
p.next:= nil;
pos:= p;
end;
{выводит элементы списка}
procedure PrintList(head: list);
var
p: list;
index: integer;
begin
if head = nil then
begin
Application.MessageBox('Список пуст','Внимание',MB_ICONWARNING+MB_OK);
MainForm.StringGrid1.RowCount:= 2;
MainForm.StringGrid1.Rows[1].Clear;
Exit;
end
else begin
index:= 1;
p:= head;
while(p <> nil) do
begin
MainForm.StringGrid1.Cells[0,index]:= IntToStr(index);
MainForm.StringGrid1.Cells[1,index]:= p.element.author;
MainForm.StringGrid1.Cells[2,index]:= p.element.name;
MainForm.StringGrid1.Cells[3,index]:= IntToStr(p.element.year);
MainForm.StringGrid1.Cells[4,index]:= p.element.subject;
p:= p.next;
inc(index);
MainForm.StringGrid1.RowCount:= index;
end;
end;
end;
{очистка списка}
procedure MakeNull(var head: list);
begin
head:= nil;
end;
{сохранение списка в файл}
procedure SaveListToFile(head: list; fName: string);
var
p: list;
f: file of elementtype;
begin
if head = nil then
begin
Application.MessageBox('Список пуст','Ошибка',MB_ICONERROR+MB_OK);
Exit;
end;
AssignFile(f, fName);
Rewrite(f);
p:= head;
while( p <> nil) do
begin
write(f, p.element);
p:= p.next;
end;
CloseFile(f);
end;
{загрузка списка из файла}
procedure LoadListFromFile(var head: list; fName: string);
var
f: file of elementtype;
begin
if head <> nil then
case Application.MessageBox('Список не пуст. Очистить его?','Внимание',MB_ICONQUESTION+MB_YESNO) of
mrYes:
begin
MakeNull(head);
MainForm.StringGrid1.RowCount:= 2;
MainForm.StringGrid1.Rows[1].Clear;
end;
mrNO:
Exit;
end;
AssignFile(f, fName);
Reset(f);
while not eof(f) do
begin
read(f,x);
InsertValue(x,head,el_pos);
end;
CloseFile(f);
end;
{возвращает позицию элемента х в списке}
function Locate(x: elementtype; head: list): list;
var
p: list;
begin
p:= head;
while(p <> nil) do
begin
if (p.element.author = x.author) and (p.element.name = x.name) and
(p.element.year = x.year) and (p.element.subject = x.subject) then
begin
Result:= p;
Exit;
end;
p:= p.next;
end;
Result:= nil;
end;
{удаление элемента из списка}
procedure DeleteValue(var pos, head: list);
var
p: list;
begin
if head = nil then Exit;
if head.next = nil then
begin
MakeNull(head);
Exit;
end;
if pos = head then
begin
head:= head.next;
Exit;
end;
p:= head;
while(p.next <> pos) do p:= p.next;
if pos.next = nil then el_pos:= p;
p.next:= p.next.next;
end;
end.
[/more]
вот ссылка на код всей программы, может комы понадобиться, но она немного не доделана(освобождение памяти при очистке списка и удалении элемента, и еще не реализована сортировка)
Ссылка
