type
 rlist=^relem;
  relem=record
  proc:string[200];
  tch:real;
  pam:real;
  mon:string[200];
  rl:rlist;
  ll:rlist;
  end;
var
  Form1: TForm1;
  t,p,l:rlist;     // t-начало списка, l-конец списка
  X:integer;

procedure TForm1.CleanStringGrid(q: integer); // очищаем таблицу
var t,c:integer;
begin
case q of
 1:
   for t:=1 to StringGrid1.RowCount do
   for c:=0 to StringGrid1.ColCount do
   StringGrid1.Cells[c,t]:='';
 2:
   for t:=1 to StringGrid2.RowCount do
   for c:=0 to StringGrid2.ColCount do
   StringGrid2.Cells[c,t]:='';
end;
end;

// удаление
procedure TForm1.BitBtn3Click(Sender: TObject);
var e:integer;
p:rlist;
n:rlist;
// t- это голова списка, l-это конец списка
// lr - это ссылка на предидущий, rr- на следующий
begin
n:=t;
if x=0 then begin
Application.MessageBox('Выберите строку!','Информация',mb_ok);
exit;
end;
if x=1 then  // если клацнули на первую строку, то
begin
if n^.rl=t then          // если элемент указывает сам на себя, то
 begin
  n^.rl:=nil;               // зануляем все указатели
  t:=nil;
  dispose(n);               //элемент удаляем
  n:=nil;
  CleanStringGrid(1);       // очищаем таблицу
  Application.MessageBox('Список пуст!','Информация',mb_ok);
  exit;                     //выходим
 end
else
// в противном случае, если нужно удалить первый,
//но после первого еще чего то есть, то
 begin
  t:=n^.rl;      // сдвигаем начало списка на следующий
  t^.ll:=l;      // связываем первый с последним
  dispose(n);    // прежнюю голову списка удаляем
 end;
end
 else        // если выбрана не первая строка, а значит нужно удалить не первый эл-нт, то
 begin
  for e:=2 to x do // проходим цикл нужное количество раз чтобы дойти до нужного эл-нта
  n:=n^.rl;
  if n^.rl=t then   // если он последний, то
   begin
    l:=n^.ll;       //перемещаем указатель последнего на предидущий
    l^.rl:=t;       //"направляем" последний эл-нт списка на начало
    dispose(n);     //а прежний хвост списка удаляем
   end
  else             // если он не последний и не первый удаляем из середины
   begin
    p:=n^.rl;
    p^.ll:=n^.ll;
    p:=n^.ll;
    p^.rl:=n^.rl;
    dispose(n);
   end;
  end;
if t=Nil then
begin
CleanStringGrid(1);
exit;
end;
 CleanStringGrid(1);
 Prosmotr(BitBtn3);
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
begin
x:=StringGrid1.Row;
end;

//добавление
procedure TForm1.AddClick(Sender: TObject);
var p:rlist;
begin
if t=nil then
begin
new(t);
t^.proc:=ComboBox1.Text;
t^.tch:=strtofloat(ComboBox2.Text);
t^.pam:=strtofloat(ComboBox3.Text);
t^.mon:=ComboBox4.Text;
t^.rl:=t;
end
else
begin
p:=t; // ставим указатель на начало списка
while p^.rl<>t do  //ищем конец списка; условие: пока следующий не указывает на начало списка делать ->
p:=p^.rl; // переставление указателя на следующий
begin
new(l);
l^.proc:=ComboBox1.Text;
l^.tch:=strtofloat(ComboBox2.Text);
l^.pam:=strtofloat(ComboBox3.Text);
l^.mon:=ComboBox4.Text;
l^.rl:=t;     //указатель нового элемента указывает на начало списка, это значит что мы добавили его в конец списка
p^.rl:=l;
l:=p;
end;
end;
Prosmotr(Add);  // вызываем просмотр, чтобы сразу заносить эл. в таблицу
end;

// просмотр списка
procedure TForm1.Prosmotr(Sender: TObject);
var g:rlist;
    i:byte;
begin
StringGrid1.RowCount:=1;
if t<>nil then
begin
g:=t;
i:=1;
repeat
StringGrid1.RowCount:=i+1;
StringGrid1.FixedRows:=1;
StringGrid1.Cells[0,i]:=g^.proc;
StringGrid1.Cells[1,i]:=floattostr(g^.tch);
StringGrid1.Cells[2,i]:=floattostr(g^.pam);
StringGrid1.Cells[3,i]:=g^.mon;
g:=g^.rl;
i:=i+1;
until g=t;
end;
end;

procedure DeleteItem(var item:rlist);
begin
  if item=nil then Exit;
  item.lr.rr:=item.rr;
  item.rr.lr:=item.lr;
  if item=t then t:=item.rr;
  Dispose(item);
  item:=nil;
end;

procedure DeleteItem(item:rlist);
begin
  if item=nil then Exit;
  item.lr.rr:=item.rr;  
  item.rr.lr:=item.lr; 
  if item=t then t:=item.rr;
  Dispose(item);
end;

type
  rlist=^relem;
  relem=record
    proc:string[200];
    tch:real;
    pam:real;
    mon:string[200];
    Prev:rlist;//Prev
    Next:rlist;//Next
  end;
  TForm1 = class(TForm)
    Add: TButton;
    Memo1: TMemo;
    Edit1: TEdit;
    Button3: TButton;
    Button4: TButton;
    Edit2: TEdit;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    ComboBox3: TComboBox;
    ComboBox4: TComboBox;
    StringGrid1: TStringGrid;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    Edit3: TEdit;
    procedure AddClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure StringGrid1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
  private
    { Private declarations }
    First:rlist;
    X:Integer;
    function GetItem:rlist;
    function IndexToItem(index:integer):rlist;
    procedure DeleteItem(var item:rlist);
    procedure AddItem(item:rlist);
    function ItemsCount:Integer;
    procedure WriteList;
    procedure ClearStringGrid;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function TForm1.GetItem:rlist;
begin
  New(Result);
  Result.proc:=ComboBox1.Text;
  Result.tch:=StrToFloat(ComboBox2.Text);
  Result.pam:=StrToFloat(ComboBox3.Text);
  Result.mon:=ComboBox4.Text;
  Result.Prev:=nil;
  Result.Next:=nil;
end;

function TForm1.IndexToItem(index: integer): rlist;
var
  i:integer;
begin
  Result:=First;
  for i:=1 to index-1 do Result:=Result.Next;
end;

procedure TForm1.DeleteItem(var item:rlist);
begin
  if item=nil then Exit;
  item.Prev.Next:=item.Next;
  item.Next.Prev:=item.Prev;
  if item=First then
    if First.Next=First then
    begin
      Dispose(First);
      First:=nil;
    end
  else
    begin
      First:=item.Next;
      Dispose(item);
      item:=nil;
    end;
end;

procedure TForm1.AddItem(item: rlist);
begin
  if First=nil then
    begin
      First:=item;
      item.Prev:=item;
      item.Next:=item;
    end
  else
    begin
      First.Prev.Next:=item;
      item.Prev:=First.Prev;
      item.Next:=First;
      First.Prev:=item;
    end;
end;

function TForm1.ItemsCount:Integer;
var
  item:rlist;
begin
  Result:=0;
  if First=nil then Exit;
  Result:=1;
  item:=First;
  while item.Next<>First do
  begin
    item:=item.Next;
    Inc(Result);
  end;
end;

procedure TForm1.WriteList;
var
  item:rlist;
  i:Integer;
begin
  if ItemsCount=0 then
  begin
    ClearStringGrid;
    Exit;
  end;
  StringGrid1.RowCount:=ItemsCount+1;
  StringGrid1.FixedRows:=1;
  item:=First;
  for i:=1 to ItemsCount do
  begin
    StringGrid1.Cells[0,i]:=item.proc;
    StringGrid1.Cells[1,i]:=FloatToStr(item.tch);
    StringGrid1.Cells[2,i]:=FloatToStr(item.pam);
    StringGrid1.Cells[3,i]:=item.mon;
    item:=item.Next;
  end;
end;

procedure TForm1.AddClick(Sender: TObject);
begin
  AddItem(GetItem);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  WriteList;
end;

procedure TForm1.StringGrid1Click(Sender: TObject);
begin
  X:=StringGrid1.Row;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  item:rlist;
begin
  if X=0 then
  begin
    ShowMessage('Строка не выбрана');Exit;
  end;
  if First=nil then
    begin
    ShowMessage('Список пуст');Exit;
  end;
  item:=IndexToItem(X);
  DeleteItem(item);
  if ItemsCount>0 then WriteList
  else ClearStringGrid;
end;

procedure TForm1.ClearStringGrid;
begin
  StringGrid1.RowCount:=2;
  StringGrid1.FixedRows:=1;
  StringGrid1.Cells[0,1]:='';
  StringGrid1.Cells[1,1]:='';
  StringGrid1.Cells[2,1]:='';
  StringGrid1.Cells[3,1]:='';
end;

end.