Двусвязные списки

[aidar9012]

Помогите с двусвязным списком. Надо реализовать удаление элемента перед заданным в Delphi 7. Вот текст программы:

{Задание: Двусвязный список: создание,добавление в конец списка,
удаление элемента перед заданным,
упорядочивание списка пузырьковым методом. }


interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls;

type
   ppt = ^node;
   node=record
    inf:integer;
    pred,next:ppt;
    end;
    TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button5: TButton;
    Button6: TButton;
    Edit1: TEdit;
    Button2: TButton;
    Button3: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;
  procedure init(var p:ppt);
  procedure add(p:ppt);
  procedure delet(var p:ppt);
  procedure bubblesort(var p:ppt);
  procedure shows(p:ppt);
var
  Form1: TForm1;
  p:ppt;

implementation



{$R *.dfm}
{Процедура создания списка из одного элемента}
procedure init(var p:ppt);
begin
new(p);
p^.inf:=StrToInt(Form1.Edit1.Text);
p^.next:=nil;
p^.pred:=nil;
shows(p);
Form1.Label2.Caption:='Создан список из 1-го элемента.';
end;

{Процедура добавления элемента в конец списка}
procedure add(p:ppt);
var q,r:ppt;
begin
q:=p;
if q^.next=nil then begin
new(r);
r^.inf:=StrToInt(Form1.Edit1.Text);
r^.next:=q^.next;
q^.next:=r;
r^.pred:=q;
end
else add(p^.next);
end;

{Процедура удаления элемента перед заданным.}
procedure delet(var p:ppt);



{Процедура отображения списка}
procedure shows(p:ppt);
begin
Form1.ListBox1.Items.Clear;
while p<>nil do
 begin
 Form1.ListBox1.Items.Add(IntToStr(p^.inf));
 p:=p^.next;
 end;
end;



{Процедура сортировки}
procedure bubblesort(var p:ppt);
var i:integer;
q,s:ppt;
begin
q:=p^.next;
q^.pred:=p;
while q<>nil do
begin
q^.pred:=q;
q:=q^.next;
s:=q;
end;
while p<>s do
begin
q:=p;
while q^.next<>s do
begin
if  q^.inf> q^.next^.inf then
begin
i:=q^.inf;
q^.inf:=q^.next^.inf;
q^.next^.inf:=i;
end;
q^.pred:=q;
q:=q^.next;end;
s:=q;
shows(p);end;
end;

// Начало основной программы //
{Создание списка из одного элемента}
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Visible:=True;
Button2.Visible:=True;
Button3.Visible:=True;
if Edit1.Text=''
 then Edit1.Text:=IntToStr(0);
init(p);
Edit1.Text:='';
shows(p);
end;

{Добавление элемента в конец списка}
procedure TForm1.Button2Click(Sender: TObject);
begin
if Edit1.Text=''
 then Edit1.Text:=IntToStr(0);
add(p);
shows(p);
Edit1.Text:='';
end;


{Удаление элемента перед заданным}
procedure TForm1.Button3Click(Sender: TObject);
begin
if Edit1.Text=''
 then Edit1.Text:=IntToStr(0);
delet(p);
shows(p);
Edit1.Text:='';
end;

{сортировка}
procedure TForm1.Button5Click(Sender: TObject);
begin
bubblesort(p);
end;

procedure TForm1.Button6Click(Sender: TObject);
{Выход}
begin
Close;
end;

end.

[baster128]

Что в процедуре procedure delet(var ppt); хотел сказать?

Попробуй не проверял и как работает не знаю. Спрашивай если что...

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, StdCtrls;

type
   ppt = ^node;
   node=record
    inf:integer;
    pred,next:ppt;
    end;
type
    TForm1 = class(TForm)
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }

  procedure init(var p:ppt);
  procedure add(p:ppt);
  procedure delet(var p:ppt);
  procedure bubblesort(var p:ppt);
  procedure shows(p:ppt);
  end;
var
  Form1: TForm1;
  p:ppt;

implementation



{$R *.dfm}
{Процедура создания списка из одного элемента}
procedure TForm1.init(var p:ppt);
begin
new(p);
p^.inf:=StrToInt(Form1.Edit1.Text);
p^.next:=nil;
p^.pred:=nil;
shows(p);
Form1.Label2.Caption:='Создан список из 1-го элемента.';
end;

{Процедура добавления элемента в конец списка}
procedure TForm1.add(p:ppt);
var q,r:ppt;
begin
q:=p;
if q^.next=nil then begin
new(r);
r^.inf:=StrToInt(Form1.Edit1.Text);
r^.next:=q^.next;
q^.next:=r;
r^.pred:=q;
end
else add(p^.next);
end;

{Процедура удаления элемента перед заданным.}
procedure TForm1.delet(var p:ppt);
begin
ListBox1.Items.Delete(ListBox1.ItemIndex-1);
end;



{Процедура отображения списка}
procedure TForm1.shows(p:ppt);
begin
ListBox1.Items.Clear;
while p<>nil do
 begin
 Form1.ListBox1.Items.Add(IntToStr(p^.inf));
 p:=p^.next;
 end;
end;



{Процедура сортировки}
procedure TForm1.bubblesort(var p:ppt);
var i:integer;
q,s:ppt;
begin
q:=p^.next;
q^.pred:=p;
while q<>nil do
begin
q^.pred:=q;
q:=q^.next;
s:=q;
end;
while p<>s do
begin
q:=p;
while q^.next<>s do
begin
if  q^.inf> q^.next^.inf then
begin
i:=q^.inf;
q^.inf:=q^.next^.inf;
q^.next^.inf:=i;
end;
q^.pred:=q;
q:=q^.next;end;
s:=q;
shows(p);end;
end;

// Начало основной программы //
{Создание списка из одного элемента}
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Visible:=True;
Button2.Visible:=True;
Button3.Visible:=True;
if Edit1.Text=''
 then Edit1.Text:=IntToStr(0);
init(p);
Edit1.Text:='';
shows(p);
end;

{Добавление элемента в конец списка}
procedure TForm1.Button2Click(Sender: TObject);
begin
if Edit1.Text=''
 then Edit1.Text:=IntToStr(0);
add(p);
shows(p);
Edit1.Text:='';
end;


{Удаление элемента перед заданным}
procedure TForm1.Button3Click(Sender: TObject);
begin
if Edit1.Text=''
 then Edit1.Text:=IntToStr(0);
delet(p);
shows(p);
Edit1.Text:='';
end;

{сортировка}
procedure TForm1.Button5Click(Sender: TObject);
begin
bubblesort(p);
end;

procedure TForm1.Button6Click(Sender: TObject);
{Выход}
begin
Close;
end;

end.

[Stilet]

С потолка:

{Процедура удаления элемента перед заданным.}
procedure delet(var p:ppt);
begin
 if  p^.Next<>nil then p^.Next^.prev:=p^.Prev
 if  p^.Prev<>nil then p^.Prev^.Next:=p^.Next;
 Dispose(p);
end;

baster128

Ты как бы пошутил??

[baster128]

Зачем вся лабуда эта с p^ если ListBox, вводи да удаляй что хошь.

[aidar9012]

Вот примерная процедура для удаления заданного. Как сделать что то подобное для удаления перед заданным?

{Процедура удаления заданного элемента.}
procedure delet(var p:ppt);
var q,r,w:ppt; {удаление заданного элемента}
    s,i:integer;

begin
s:=strtoint(form1.Edit1.Text);
q:=p;
i:=0;
while (q^.next <> nil) do
  begin
  r:=q;
  w:=q^.next;
    if q^.inf=s then
    begin
      if q^.pred=nil then
      w^.pred:=nil
      else
      if q^.next=nil then
      r^.next:=nil
      else
    r:=q^.pred;
    r^.next:=w;
    w^.pred:=r;
    i:=i+1;
    end;
  q:=q^.next;
  end;
end;

[mMAg]

Перейти на один элемент назад по списку и использовать процедуру, которую ты продемонстрировал.
Если честно, даже смотреть на неё не хочется. Какая-то слишком длинная она. Такое чувство, что тут не двухсвязный список. А двухсвязный список с поддержкой индексации и прямого доступа к любому элементу.

[aidar9012]

Вот еще одна примерная процедура для удаления заданного элемента:

{Процедура удаления заданного элемента.}
procedure delet(var p:ppt);
var q,r,w:ppt; {удаление заданного элемента}
    s,i:integer;

begin
if form1.edit1.text='' then showmessage('элемент не задан')
else
if p^.next=nil then showmessage ('Добавьте элементы')
else
s:=strtoint(form1.Edit1.Text);
q:=p;
i:=0;
while (q^.next <> nil) do
  begin
  {r:=q;  }
  w:=q^.next;
    if q^.inf=s then
    begin
      {if q^.pred=nil then
      w^.pred:=nil
      else
      if q^.next=nil then
      r^.next:=nil
      else }
      if q<>p then
      begin
    r^.next:=q^.next;
    q^.next^.pred:=r;
    i:=i+1;
    Dispose(q);
    end
    end;
    r:=q;
  q:=q^.next;
  end;
end;

Помогите пожалуйста переделать эту процедуру для поиска и удаления элемента перед заданным. Очень выручите!