Справочник функций

Ваш аккаунт

Войти через: 
Забыли пароль?
Регистрация
Информацию о новых материалах можно получать и без регистрации:

Почтовая рассылка

Подписчиков: -1
Последний выпуск: 19.06.2015

Работа с очередью в Delphi

84K
17 декабря 2013 года
Krake
1 / / 19.05.2013
Помогите пожалуйста реализовать код в delphi. Код рабочий сам проверял в TurboPascal. Но препод требует на delphi создать проект, а мне уже сдавать надо( На delphi никогда не работал, а за столь короткое время не успею его освоить( первый курс только... Знаю что тут особо не надо ничего менять, только кнопки добавить в форму, но у меня не получается( Помогите кто может!

Program Ochered;
uses
crt;
type
Tinf=integer;
List=^TList;
TList=record
data:TInf;
next:List;
end;


procedure AddElem(var stek1:List;znach1:TInf);
var
tmp:List;
begin
GetMem(tmp,sizeof(TList));
tmp^.next:=stek1;
tmp^.data:=znach1;
stek1:=tmp;
end;


procedure Print(stek1:List);
begin
if stek1=nil then
begin
writeln('OCHERED EMPTY.');
exit;
end;
while stek1<>nil do
begin
Write(stek1^.data, ' ');
stek1:=stek1^.next
end;
end;


Procedure FreeStek(stek1:List);
var
tmp:List;
begin
while stek1<>nil do
begin
tmp:=stek1;
stek1:=stek1^.next;
FreeMem(tmp,SizeOf(Tlist));
end;
end;


Function SearchElemZnach(stek1:List;znach1:TInf):List;
begin
if stek1<>nil then
while (Stek1<>nil) and (znach1<>stek1^.data) do
stek1:=stek1^.next;
SearchElemZnach:=stek1;
end;


Procedure DelElem(var stek1:List;tmp:List);
var
tmpi:List;
begin
if (stek1=nil) or (tmp=nil) then
exit;
if tmp=stek1 then
begin
stek1:=tmp^.next;
FreeMem(tmp,SizeOf(TList));
end
else
begin
tmpi:=stek1;
while tmpi^.next<>tmp do
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next;
FreeMem(tmp,sizeof(TList));
end;
end;


procedure DelElemZnach(var Stek1:List;znach1:TInf);
var
tmp:List;
begin
if Stek1=nil then
begin
Writeln('OCHERED EMPTY.');
exit;
end;
tmp:=SearchElemZnach(stek1,znach1);
if tmp=nil then
begin
writeln('ELEMENT ' ,znach1, ' OTSUTSTVUET V OCHEREDI.');
exit;
end;
DelElem(stek1,tmp);
Writeln('ELEMENT DELETE.');
end;


Procedure DelElemPos(var stek1:List;posi:integer);
var
i:integer;
tmp:List;
begin
if posi<1 then
exit;
if stek1=nil then
begin
Write('OCHERED EMPTY.');
exit
end;
i:=1;
tmp:=stek1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i)
end;
if tmp=nil then
begin
Writeln('elementa s nomerom ' ,posi, ' net v ocheredi.');
writeln('V ocheredi ' ,i-1, ' elementa.');
exit
end;
DelElem(stek1,tmp);
Writeln('element delete.');
end;


procedure SortBublInf(nach:list);
var
tmp,rab:List;
tmps:Tinf;
begin
GetMem(tmp,SizeOf(Tlist));
rab:=nach;
while rab<>nil do
begin
tmp:=rab^.next;
while tmp<>nil do
begin
if tmp^.data<rab^.data then
begin
tmps:=tmp^.data;
tmp^.data:=rab^.data;
rab^.data:=tmps
end;
tmp:=tmp^.next
end;
rab:=rab^.next
end
end;


var
Stk,
tmpl:List;
znach:Tinf;
ch:char;
begin
Stk:=nil;
repeat
clrscr;
Writeln('Programm ochered.');
Writeln('1) Dobavit element.');
Writeln('2) Vivod ocheredi.');
Writeln('3) Delete element po znach.');
Writeln('4) delete element po nomeru.');
Writeln('5) POISK ELEMENTA PO ZNACH.');
Writeln('6) SORTIROVKA ELEMENTOV METODOM "PUZ".');
Writeln('7) EXIT.');
writeln;
ch:=readkey;
case ch of
'1':begin
write('VVEDITE ZNACH ELEMENTA: ');
readln(znach);
AddElem(Stk,znach);
end;
'2':begin
clrscr;
Print(Stk);
readkey;
end;
'3':begin
Write('VVEDITE ZNACH DEL ELEMENT: ');
readln(znach);
DelElemZnach(Stk,znach);
readkey;
end;
'4':begin
Write('VVEDITE NOMER DEL ELEMENTA: ');
readln(znach);
DelElemPos(Stk,znach);
readkey;
end;
'5':begin
write('VVEDITE ZNACH ELEMENTA: ');
readln(znach);
tmpl:=SearchElemZnach(Stk,znach);
if tmpl=nil then
write('NE NAIDEN.')
else
write('ELEMENT ',tmpl^.data,' NAIDEN.');
readkey;
end;
'6':begin
if Stk=nil then
begin
Write('OCHERED PUSTA.');
readkey
end
else
begin
SortBublInf(Stk);
Write('OCHERED OTSORTIROVANA.');
readkey;
end
end;
end;
until ch='7';
FreeStek(Stk);
end.
Реклама на сайте | Обмен ссылками | Ссылки | Экспорт (RSS) | Контакты
Добавить статью | Добавить исходник | Добавить хостинг-провайдера | Добавить сайт в каталог