Пытаюсь написать процедуру удаления элемента из двусвязного списка
procedure TDataList.DelItem;
var PDel: TList;
begin
// Процедура переводит указатель на выбранный элемент
GoToItem(FPointer);
PDel := FItems;
if FCount = 1 then begin
// Если в списке 1 элемент, отчистить список полностью
DelAll;
end
// Если элементов списка больше 1 и Выбран первый элемент в списке
else if (FCount > 1) and (FPointer = 1) then begin
// Перевод указателя на следующий элемент списка
FItems := FItems^.PNext;
// Удаление - Вот тут возникает ошибка, вроде что-то из памяти прочитать не может
Dispose(PDel);
end;
end;
Весь код класса:
unit UList;
interface
uses Messages, Dialogs, SysUtils, Classes, Grids, UStudent;
type
TArray = array of integer;
TData = TStudent;
TList = ^List;
List = record
Data: TData;
PNext,
PPrev: TList;
end;
TDataList = class
private
FItems: TList;
FCount,FPointer: Integer;
public
// Конструктор и деструктор
constructor Create(); overload;
destructor Destroy(); overload;
// Процедуры
procedure AddItem(Key: Integer; Data: TStudent);
procedure DelAll();
procedure DelItem();
procedure GoToItem(Index: Integer);
procedure SetPointer(Index: Integer);
procedure Go(Key: Integer);
// Functions
function GetList(): TList;
function GetCount(): Integer;
function GetPointer(): Integer;
property Pointer: Integer read GetPointer write SetPointer;
end;
implementation
procedure TDataList.AddItem(Key: Integer; Data: TStudent);
var Item: TList;
begin
FCount := FCount + 1;
New(Item);
Item^.Data := Data;
// Если список пуст
if FItems = Nil then begin
Item^.PNext := Nil;
Item^.PPrev := Nil;
FItems := Item;
FPointer := 1;
end
else begin
case Key of
// Добавление в начало списка
1: begin
while FItems^.PPrev <> Nil do begin
FItems := FItems^.PPrev;
end;
Item^.PNext := FItems;
Item^.PPrev := Nil;
FItems^.PPrev := Item;
FPointer := 1;
end;
// Добавление в конец списка
2: begin
while FItems^.PNext <> Nil do begin
FItems := FItems^.PNext;
end;
Item^.PNext := Nil;
Item^.PPrev := FItems;
FItems^.PNext := Item;
FPointer := FCount;
end;
// Добавление перед элементом
3: begin
if FItems^.PPrev = Nil then begin
AddItem(1,Data);
end
else begin
GoToItem(FPointer);
Item^.PPrev := FItems^.PPrev;
Item^.PNext := FItems;
FItems^.PPrev := Item;
Item^.PPrev^.PNext := Item;
end;
end;
// Добавление после элемента
4: begin
if FPointer = FCount then begin
AddItem(2,Data);
end
else begin
GoToItem(FPointer);
Item^.PPrev := FItems;
Item^.PNext := FItems^.PNext;
FItems^.PNext := Item;
Item^.PNext^.PPrev := Item;
end;
end;
end;
end;
end;
constructor TDataList.Create;
begin
FCount := 0;
FPointer := 0;
FItems := Nil;
end;
procedure TDataList.DelAll;
var PDel: TList;
begin
Go(1);
while FItems <> Nil do begin
PDel := FItems;
FItems := FITems^.PNext;
Dispose(PDel);
end;
FCount := 0;
FPointer := 0;
end;
procedure TDataList.DelItem;
var PDel: TList;
begin
GoToItem(FPointer);
PDel := FItems;
// Удалить весь список если в нем всего 1 запись
if FCount = 1 then begin
DelAll;
end
// Удаление первого элемента списка
else if (FCount > 1) and (FPointer = 1) then begin
// Перевожу указатель на следующий элемент
FItems := FItems^.PNext;
FItems^.PPrev := Nil;
Dispose(PDel);
// FCount кол-во элементов в списке
FCount := FCount - 1;
end;
end;
destructor TDataList.Destroy;
begin
//
end;
function TDataList.GetCount: Integer;
begin
Result := FCount;
end;
function TDataList.GetList: TList;
begin
Result := FItems;
end;
function TDataList.GetPointer: Integer;
begin
Result := FPointer;
end;
procedure TDataList.Go(Key: Integer);
begin
case Key of
// Go to First
1: begin
while FItems^.PPrev <> Nil do begin
FItems := FItems^.PPrev;
end;
FPointer := 1;
end;
// Go to Last
2: begin
while FItems^.PNext <> Nil do begin
FItems := FItems^.PNext;
end;
FPointer := FCount;
end;
// Go to Next
3: begin
if FItems^.PNext <> Nil then begin
FItems := FItems^.PNext;
end;
FPointer := FPointer + 1;
end;
// Go to Prev
4: begin
if FItems^.PPrev <> Nil then begin
FItems := FItems^.PPrev;
end;
FPointer := FPointer - 1;
end;
end;
end;
procedure TDataList.GoToItem(Index: Integer);
var I: Integer;
begin
while FItems^.PPrev <> Nil do begin
FItems := FItems^.PPrev;
end;
for I := 1 to Index - 1 do begin
if FItems^.PNext <> Nil then FItems := FItems^.PNext;
end;
end;
procedure TDataList.SetPointer(Index: Integer);
begin
FPointer := Index;
end;
end.