Основные действия с очередью я реализовал (очистить, проверить, добавить, удалить, прочитать 1 и посл. элемент).

Вот реализация всех действий с очередью:

Program ochered;
Uses crt;
Type spd = ^Tspd;
     Tspd = record
     data:string;
     next,last:spd;
     end;
Var op:integer;
    stek, stek1,stek2:spd;
    st0,st1,st2:spd;
    data:string;
procedure add(var sp,st:spd; data:string);
var temp:spd;
begin
new(temp);
temp^.data:=data;
temp^.next:=nil;
 if sp = nil
  then
   begin
   temp^.last:=nil;
   sp:=temp;
   st:=sp;
    end
     else
      begin
      temp^.last:=st;
      st^.next:=temp;
      st:=temp;
    end;
 end;
procedure view(sp:spd);
begin
 if sp = nil
  then
   writeln('ochered pysta');
while sp<>nil do
 begin
 write(sp^.data,'  ');
 sp:=sp^.next;
 end;
end;
function proverka(sp:spd):boolean;
begin
 if sp = nil
  then
   proverka:=false
  else
   proverka:=true;
end;
function del(var sp, st:spd):string;
var temp:spd;
begin
 if sp = nil
  then
   begin
   writeln('Error: ochered pysta ');
   readkey;
   exit;
 end;
del:=sp^.data;
temp:=sp;
sp:=sp^.next;
 if sp = nil
  then
   st:=nil;
dispose(temp);
end;
procedure clear(var sp, st:spd);
var temp:spd;
begin clrscr;
 while sp<>nil do
 begin
 temp:=sp;
 sp:=sp^.next;
 dispose(temp);
 end;
 st:=nil;
end;
function read_the_first_element(sp:spd):string;
var a:string;
begin
   a:=sp^.data;
   read_the_first_element:=a;
end;
function read_the_last_element(st:spd):string;
var a:string;
begin
   a:=st^.data;
   read_the_last_element:=a;
end;
begin
st0:=nil;
repeat
clrscr;
writeln;
writeln('1-add element');
writeln('2-del element');
writeln('3-view ochered');
writeln('4-clear ochered');
writeln('5-read_1_element');
writeln('6-read_posledn.element');
writeln;
writeln('0-exit');
readln(op);
case op of
1:begin
   clrscr;
   write('vvedite znachenie dobavl. elementa ');
   readln(data);
   clrscr;
   add(stek, st0, data);
   writeln;
   writeln('element dobavlen');
   writeln;
   writeln('vasha ochered ');
   writeln;
   view(stek);
   writeln;
   writeln;
   writeln('najmite klavishy');
   readkey;
   end;
2:begin
   clrscr;
   if proverka(stek) then
    begin
    writeln(' element ', del(stek, st0),' udalen ');
    writeln;
    writeln('vasha ochered');
    writeln;
    view(stek);
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
   end else
   begin
    writeln('ydalenie ne vozmojno - ochered pysta');
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
   end;
  end;
3: begin
    clrscr;
    writeln;
    writeln('vasha ochered');
    writeln;
    view(stek);
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
   end;
4:begin
  clear(stek, st0);
  writeln('vasha ochered ochishena');
    writeln;
    writeln;
    writeln('najmite klavishy');
    readkey;
  end;
5:begin
   clrscr;
   writeln;
   writeln(''prochten. pervyu element');
   writeln;
   writeln(read_the_first_element(stek));
   writeln;
   writeln('vasha ochered');
   writeln;
   view(stek);
   writeln;
   writeln;
   writeln('najmite klavishy');
   readkey;
end;
6:begin
   clrscr;
   writeln;
   writeln('prochten. posled element');
   writeln;
   writeln(read_the_last_element(st0));
   writeln;
   writeln('vasha ochered');
   writeln;
   view(stek);
   writeln;
   writeln;
   writeln('najmite klavishy');
   readkey;
end;
0:begin
    exit;
    end;
    end;
until op=0;
end.

Хочу встроить в данную программу, эти 2 маленькие задачки, вызывая их в основной программе.

1.Пусть уже построена очередь Q, содержащая целые числа. Вычислить сумму и произведение элементов, находящихся в очереди.

2.Пусть уже построена очередь Q, содержащая целые числа. Вычислить количество элементов очереди кратных 3.

Подскажите как реализовать эти програмки.

Сообщение отредактировано: Бунтарь - 26.12.2010 14:38