[s0Creator]

В общем тоже не ахти - давно с такими примитивами не работал и старался изменения по минимуму - но вроде работает

Код:

program new_stack;

{$APPTYPE CONSOLE}

uses
  SysUtils;
type
  PElem = ^TElem;
  TElem = record // структура элемента
    inf: real;
    next: PElem;
  end;

  TStack = record
    first: PElem;
  end;

  TOcher = record
    first: PElem;
    last: PElem;
  end;

  /////////////////////// Добавляем в стек ///////////////////////////////////////

procedure Push_stak(var Stack: TStack; Sim: real);
var
  x: PElem;
begin
  New(X);
  X^.inf := Sim;
  X^.next := Stack.first;
  Stack.first := X;
end;

//////////////////////////// Достаём верхний элемент стека /////////////////////

function Pop_stak(var Stack: TStack; var INF: real): Boolean;
var
  x: PElem;
begin
  if Stack.first = nil then
    Result := false
  else
  begin
    Result := true;
    X := Stack.first;
    Stack.first := X^.next;
    INF := X^.inf;
    Dispose(x);
  end;
end;

//////////////////////////// Удаляем элемент стека /////////////////////

procedure Remove_stak(var Stack: TStack; Elem: PElem);
var
  x: PElem;
begin

  if Stack.first = Elem then
    Stack.first := Elem^.next
  else
  begin
    X := Stack.first;
    while X^.next <> nil do
    begin
      if X^.next = Elem then
      begin
        X^.next := Elem^.next;
        break;
      end;
      X := X^.next;
    end;

    Dispose(Elem);
  end;
end;
//////////////////////////////////////////////////////////////////////////////////

//////////////////////// Занесение в очередь ///////////////////////////////////

procedure Push_Ocher(var Ocher: TOcher; c: real);
var
  Elem: PElem;
begin
  new(Elem);
  Elem^.inf := c;
  Elem^.Next := nil;
  if Ocher.first = nil {проверяем, пуста ли очередь} then
    Ocher.first := Elem {ставим указатель начала очереди на первый созданный элемент}
  else
    Ocher.last^.next := Elem; {ставим созданный элемент в конец очереди}
  Ocher.last := Elem; {переносим указатель конца очереди на последний элемент}
end;

///////////////////////////// Чтение из очереди /////////////////////////////////

function Pop_Ocher(var Ocher: TOcher; var INF: real): Boolean;
var
  Elem: PElem;
begin
  if Ocher.first = nil then
    Result := false
      //    writeln('Очередь пуста')
  else
  begin
    Result := true;
    Elem := Ocher.first; {ставим промежуточный указатель на первый элемент очереди}
    INF := Elem^.inf; {считываем искомое значение в переменную с}
    Ocher.first := Elem^.Next; {указатель начала переносим на следующий элемент}
    if Elem^.Next = nil then {очередь пуста}
      Ocher.last := nil;
    dispose(Elem); {освобождаем память, занятую уже ненужным первым элементом}
  end;
end;

var
  MY: TStack;
  TmpElem, NextElem: PElem;
  I: Integer;
  uz, R, S: real;
  Ocher: TOcher;
begin
  R := 0;
  S := 0;
  Randomize;
  write('Input Uz :');
  readln(uz);

  MY.first := nil;
  Ocher.first := nil;
  Ocher.last := nil;

  for I := 0 to 10 do
  begin
    Push_stak(MY, random(10000) / 100);
  end;

  write('Ishodn stack :');

  TmpElem := MY.first;
  while TmpElem <> nil do
  begin
    write(Format('%.2f', [TmpElem^.inf]));
    write('-->');
    TmpElem := TmpElem^.next;
  end;
  writeln('');
  readln;

  TmpElem := MY.first;
  while TmpElem <> nil do
  begin
    NextElem := TmpElem^.next;
    if TmpElem^.inf <= uz then // не превосходят, значит <= а было <
    begin
      R := R + TmpElem^.inf;
      Push_Ocher(Ocher, TmpElem^.inf); {помещаем элемент в очередь }
      Remove_stak(MY, TmpElem); {удаляем из стека}
    end
    else // значит больше
    begin
      S := S + TmpElem^.inf;
    end;
    TmpElem := NextElem;
  end;

  /////////////// Вывод стека ////////////////////////////////////////////////
  write('Stack :');
  TmpElem := MY.first;
  while TmpElem <> nil do
  begin
    write(Format('%.2f', [TmpElem^.inf]));
    write('-->');
    TmpElem := TmpElem^.next;
  end;
  writeln('');

  /////////////// Вывод Очереди ////////////////////////////////////////////////
  write('Ocher :');
  TmpElem := Ocher.first;
  while TmpElem <> nil do
  begin
    write(Format('%.2f', [TmpElem^.inf]));
    write('-->');
    TmpElem := TmpElem^.next;
  end;
  writeln('');

  /////////////// Вывод итогового числа ////////////////////////////////////////////////
  write('Iskomoe chislo : ');
  write((uz + R) / (uz + S));

  ///// очищаем
  while Pop_stak(MY, R) do ;
  while Pop_Ocher(Ocher, R) do ;

  readln;
end.

Смотри - если что не так или вопросы процитируй отвечу.
( я не очень люблю много коментов - ленивый )