народ, я застрял... нужно написать просмотр двунаправленого динамического списка с последнего элемента... я написал следующее
procedure TForm1.Button8Click(Sender: TObject); var i:integer; begin new(p2); p:=head; While P <> Nil Do Begin p^.pred:=p; if p^.sled=nil then last:=p; p:=p^.sled;
End;
Label9.Caption:=''; Label10.Caption:=''; Label11.Caption:=''; Label12.Caption:=''; Label14.Caption:=''; i:=1; p:=last; While P <> Nil Do Begin Label9.Caption:=Label9.Caption+chr(13)+P^.shifr; Label10.Caption:=Label10.Caption+chr(13)+P^.naim; Label11.Caption:=Label11.Caption+chr(13)+P^.cena; Label12.Caption:=Label12.Caption+chr(13)+P^.ves; Label14.Caption:=Label14.Caption+chr(13)+IntToStr(i); p:=head^.pred; inc(i); End; end;
но оно зацикливается на последнем элементе....
в архиве весь проект... нид хелп... в понедельник сдавать, а без этого препод не принимает(((
Все дело в сортировке. Она просто изначально предназначена для работы с односвязным списком, и неправильно заполняет поле Prev, а сделать так, чтобы было проще я тебе предлагал - ты отказался... И потом: у тебя там что-то накручено с добавлением элемента... В общем, все, что я изменил, чтобы программа работала прилично:
// Обрати внимание, идем с последнего к первому, и не надо никаких выкрутасов procedure TForm1.Button8Click(Sender: TObject); var i:integer; begin p := last; Label9.Caption:=''; Label10.Caption:=''; Label11.Caption:=''; Label12.Caption:=''; Label14.Caption:=''; i := 1; while P <> nil do begin Label9.Caption := Label9.Caption+chr(13)+P^.shifr; Label10.Caption := Label10.Caption+chr(13)+P^.naim; Label11.Caption := Label11.Caption+chr(13)+P^.cena; Label12.Caption := Label12.Caption+chr(13)+P^.ves; Label14.Caption := Label14.Caption+chr(13)+IntToStr(i); p := p^.pred; inc(i); end; end;
// Сама сортировка тоже изменена: procedure TForm1.Button7Click(Sender: TObject);
// Не захотел отделить данные от указателей - получай доп. процедуру копирования procedure CopyTo(var Dest: telem; Src: telem); begin Dest.shifr := Src.shifr; Dest.naim := Src.naim; Dest.cena := Src.cena; Dest.ves := Src.ves; end;
procedure SortVst(var first: pelem); var i, j: pelem; T: telem; begin i := first; while i <> nil do begin T := i^; j := i^.pred; while (j <> nil) and (T.shifr < j^.shifr) do begin CopyTo(j^.sled^, j^); j := j^.pred; end;
if j = nil then CopyTo(first^, T) else CopyTo(j^.sled^, T);
i := i^.sled; end; end;
begin
if head <> nil then begin SortVst(head); end else begin ShowMessage('Список пуст'); end;
end;
// Ну, и добавление элемента в список, как я и говорил: procedure TForm1.Button1Click(Sender: TObject); begin New(p); p^.shifr:=Edit1.Text; p^.naim:=Edit2.text; p^.cena:=Edit3.Text; p^.ves:=Edit4.Text;
p^.sled := head; p^.pred := nil; if head = nil then last := p else head^.pred := p;
head := p; end;
Вроде ничего не забыл... В аттаче проект, но у меня D2009, предупреждаю сразу...
ещё одна проблемка возникла... удаление по номеру у меня однонаправленое... после него просмотр с конца не работает.... нид хелп
Добавлено через 6 мин. думаю это будет примерно так
procedure TForm1.Button2Click(Sender: TObject); var d:Boolean; i:integer; begin d:=false; i:=0; //счётчик P:=Head; Last:=nil; While (not d) and (P<>Nil) Do Begin If StrToInt(Edit5.Text)-1=i Then Begin p^.pred^.sled:=p^.sled; p^.sled^.pred:=p^.pred; d:=True; Dispose(p); end else begin
head^.pred:=p; //этот участок не правильный, не зннаю что написать p:=p^.sled; end; inc(i); End; //закрытие цикла end;
procedure TForm1.Button2Click(Sender: TObject); var i: integer; p: PElem; begin i := 0; p := head; while (p <> nil) and (StrToInt(Edit5.Text) - 1 <> i) do begin p := p^.sled; inc(i); end;
if p <> nil then begin if p^.pred <> nil then p^.pred^.sled := p^.sled else head := p^.sled; if p^.sled <> nil then p^.sled^.pred := p^.pred else last := p^.pred;
d:=false; {i:=0; //счётчик P:=Head; // Last:=nil; While (not d) and (P<>Nil) Do Begin If StrToInt(Edit5.Text)-1=i Then Begin p^.pred^.sled:=p^.sled; p^.sled^.pred:=p^.pred; d:=True; Dispose(p); end else begin p:=p^.sled; end; inc(i); End;
закоментил Last:=nil; но в итоге получались накладки с выводом...
кому надо могу выложить отчёт по этой программе... в отчёте таблицы спецификаций исходный текст модулей и файла проекта блоксхемы по существенным операциям скрины работы программы