Высокоуровневые методы информатики и программирования

      temp1 := first;

      while temp1.next <> nil do

        temp1 := temp1^.next;

      temp1^.next := el;

      el^.next := nil;

    end

      else                

    begin

      temp1 := first;

      k := 1;

      while k < index do

      begin

        k := k + 1;

        temp1 := temp1^.next;

      end;

      temp2 := temp1^.next;

      temp1^.next := el;

      el^.next := temp2;

    end;

  end;

end;

function CounterElement(var first : link) : integer;

var

  k : integer;

  temp : link;

begin

  if first = nil then

    k := 0

  else

  begin

    k := 1;

    temp := first;

    while temp^.next <> nil do

    begin

      k := k + 1;           

      temp := temp^.next;

    end;

  end;

 

  Result := k;

end;

function SaveInFile(var fn : TFileName; var first : link) : boolean;

var

  list : TStringList;

  i, count : integer;

  temp : link;

  part_str1, part_str2, part_str3 : string;

begin

  list := TStringList.Create;

  i := 0;

  count := CounterElement(first);

  temp := first;

  if first <> nil then

  begin

    repeat

      i := i + 1;

      part_str1 := IntToStr(temp^.key);

      part_str2 := temp^.info;

      if (temp^.next = nil) then

        part_str3 := '-1'

      else

        part_str3 := IntToStr(temp^.next.key);

      temp := temp^.next;

      list.Add(part_str1 + ';' + part_str2 + ';' + part_str3);

    until i = count;

    try

      list.SaveToFile(fn);

    finally

      list.Free;

    end;

  end;

  Result := true;

end;

function LoadOutFile(var fn : TFileName; var first : link) : boolean;

var

  tf : TextFile;

  list : TStringList;

  str : string;

  temp : link;

begin

  list := TStringList.Create;

  list.Delimiter := ';';

  try

    Assign(tf, fn);

    Reset(tf);

    while not eof(tf) do

    begin

      ReadLn(tf,str);

      list.DelimitedText := str;

      new(temp);

      temp^.info := list.Strings[1];

      temp^.key := StrToInt(list.Strings[0]);

      temp^.next := nil;

      InsertElementInEnd(temp, first);

    end;

    close(tf);

  except

    ShowMessage('Ошибка восстановления!');

  end;

  list.Free;

    Result := true;

end;

procedure DeleteElementInBegin(var first : link);

var

  temp : link;

begin

  if first <> nil then

  begin

    temp := first;

    if temp^.next = nil then

    begin

      dispose(temp);

      first := nil;

    end

      else

    begin

      temp := first;

      first := first^.next;

      dispose(temp);

    end;

  end

    else

      ShowMessage(Списко пуст!');

end;

procedure DeleteElementInEnd(var first : link);

var

  temp1, temp2 : link;

begin

  if first <> nil then

  begin

    if first^.next =nil then

    begin

      temp1 := first;

      dispose(temp1);

      first := nil;

    end

      else

    begin

      temp1 := first;

      temp2 := first;

      while temp1^.next <> nil do

      begin

        temp2 := temp1;

        temp1 := temp1^.next;

      end;

      dispose(temp1);

      temp2^.next := nil;

    end

  end

    else

    ShowMessage('Список пуст!');

end;

procedure DeletePostKey(var key : integer; var first : link);

var

  temp1, temp2 : link;

  i, index : integer;

  is_item : boolean;

begin

  if first <> nil then

  begin

    temp1 := first;

    temp2 := first;

    index := 0;

    is_item := false;

    for i := 0 to CounterElement(first) - 1 do

    begin

      if temp1.key = key then

      begin     

        is_item := true;

        break;

      end

        else

      begin

        temp2 := temp1;

        temp1 := temp1^.next;

      end;

      index := index + 1;

    end;

    if is_item = true then

      DeleteIntermediateElement(first, index);

        end

    else

    ShowMessage('Список пуст!');

end;

procedure DeleteIntermediateElement(var first : link; var index : integer);

var

  t, q, r : link;

  k, n : integer;

begin

  n := CounterElement(first);

  if (index < 1) or (index > n) then

  begin

    ShowMessage('index задан некорректно!');

    Exit;

  end

    else

  begin

    if index = 1 then  

    begin

      t := first;

      first := first^.next;

      dispose(t);

      ShowMessage(' Операция выполнена успешно!');

    end

      else

    if index = n then 

    begin

      DeleteElementInEnd(first);

    end

      else

    begin

      t := first;

      q := nil;

      k := 1;

      while k < index do

      begin

        k := k + 1;

        q := t;

        t := t^.next;

      end;

      r := t^.next;

      q^.next := r;

      dispose(t);

      ShowMessage('Операция выполнена успешно!');

    end;

  end;

end;

procedure ChangeMaxKeyAndLast(var first : link);

var

  max, i, index : integer;

  temp1, temp2, temp3, temp4 : link;

begin

  max := 0; i := 1; index := 0;

  temp1 := first;

  temp2 := first;

  repeat

    if temp1.key > max then

    begin 

      max := temp1.key;

      temp2 := temp1; 

      temp1 := temp1^.next;

      index := i;                

    end

      else temp1 := temp1^.next;

    i := i + 1;

  until i = CounterElement(first) + 1;

  if (index + 1 = i) then exit;

  temp3 := first;

  temp4 := first;

  while temp3^.next <> nil do

  begin

    temp4 := temp3;

    temp3 := temp3^.next;

  end;

  temp4.next := nil;

  InsertPostIndex(temp3, first, index);

  first := first^.next;

  temp4^.next := temp2;

  temp2^.next := nil; 

end;

end.

 

Список литературы

1. Калмыкова О.В., Грибанов В.П., Сорока Р.И. Основы алгоритмизации и программирования: Учебное пособие, руководство по изучению дисциплины, практикум, учебная программа. – М.: 2004. – 220 с.
2. Павловская Т.А. Программирование на языке высокого уровня: Учебник для вузов. – СПб.: Питер, 2007. – 393 с.
3. Архангельский А.Я. Приемы программирования в Delphi на основе VCL. – М.: ООО «Бином-Пресс», 2006. – 944 с.
4. Кэнту М. Delphi 7 для профессионалов. – СПб.: Питер, 2004. – 354 с.