Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 12.05.2012, 19:33   #1
igarexa
 
Регистрация: 07.10.2011
Сообщений: 5
Радость ДЕК, процедура обмена элем-тов, паскаль

Здравствуйте, уважаемые программисты.
У меня есть программа с ДЕКом, отображённом в векториальной форме. По сути, программа работает, но мне необходимо сделать последний штрих. А именно добавить возможность менять 1. элемент на i -тый (и задаёт пользователь).
Нашёл некий пример, попытался подстроить в свою программу, но не выходит. Нет, программа компилируется, и запускается, но когда хочу использовать эту возможность, их программы выкидывает, и пишет exited with exitcode 216.
Более чем уверен, что процедуру надо подкорректировать, но не знаю как. Информацию искал усердно - безрезультатно, поиском пользовался - нету.Товарищи, помогите пожалуйста Уверен, с вашим проффесионализмом, это займёт минут 5 ))
А вот и сам код:
Код:
program MyDeque;
uses crt;
const MaxSize = 200;
type Position = 1..MaxSize;
	Count = 0..MaxSize;
	DequeueNo = 1..2;
	DataType = integer;
	KeyType = integer;
	StdElement = record
		data:DataType;
		key:KeyType;
		end;
	Dequeue = ^DequeueInstance;
	DequeueInstance = record
		head, tail:Count;
		el:array[Position] of StdElement;
		n:Count;
		end;
var sk,i,Num:integer; Dq:Dequeue; crea:boolean; elem:array[1..30] of StdElement; D: Dequeue;
label BG, BGG, FEND;

function Empty(D:Dequeue):boolean;
	{proveraet, pustoj li D^ dek}
begin Empty:=D^.n=0; end;

function Full(D:Dequeue):boolean;	
begin	Full:=D^.n=MaxSize; end;

function Size(D:Dequeue):Count;
begin	Size:=D^.n; end;

procedure Enqueue(var D:Dequeue; e:StdElement; DNo:DequeueNo); 
var i:Position;
begin if (not Full(D)) then with D^ do
	if Empty(D) then 
		begin
		el[1]:=e; head:=1; tail:=1; inc(n);
		end
		else case DNo of
			1:begin for i:=n downto 1 do {na4alo spiska}
				el[i+1]:=el[i];
				el[1]:=e; inc(n); tail:=n; end;
			2:begin {delatj element vo vtorom konce}
				inc(n); tail:=n; el[tail]:=e; end; end; end;
procedure Serve(var D:Dequeue; var e:StdElement; DNo:DequeueNo);
var i:Position;
begin if (not Empty(D)) then
	with D^ do
		case DNo of
		1:begin e:=el[head];
			for i:=2 to n do el[i-1]:=el[i];
				dec(n); tail:=n; end;
		2:begin e:=el[tail]; dec(n); tail:=n; end;
		end; end;

procedure Create(var D:Dequeue; var created:boolean); 
begin
	new(D);
	D^.head:=0; D^.tail:=0; D^.n:=0;
	created:=true;
end;

procedure Terminate(var D:Dequeue; var created:boolean);

begin
	if created then begin dispose(D); created:=false; end;
end;

procedure Start;
begin
	Randomize;
	for i:=1 to 10 do begin elem[i].data:=random(10); elem[i].key:=i; Enqueue(Dq,elem[i],2); end;
	for i:=1 to 10 do begin Serve(Dq,elem[i],1); writeln(elem[i].key,'.elem. ',elem[i].data); end;
	writeln; writeln('Nazmi 4to bi prodolzitj');
end;

procedure Insert;
begin
	for i:=1 to 3 do begin
	write('Vvedi ',i,'.pole elementa  => '); readln(elem[i+10].data);
	elem[i+10].key:=i+10;
	Enqueue(Dq,elem[i],2); end;
	for i:=1 to 13 do begin Serve(Dq,elem[i],1); writeln(elem[i].key,'.elem. ',elem[i].data); end;
	writeln; writeln('Nazmi 4to bi prodolzitj');
end;

procedure MakeSwap(var e1 : StdElement; var e2: StdElement);
var e: StdElement;
begin
     e := e1;
     e1 := e2;
     e2 := e;
end;

procedure ASwap(var D: Dequeue; ith: integer);
var e: StdElement;
begin
     if (not Empty(D)) and ( ith <= Size(D) ) and (Size(D) >= 2) then
        with D^ do
             MakeSwap(el[head], el[ith]);
end;


procedure MainWd;
begin
	writeln('Operacii s dekom:');
	writeln('Viberi proceduru, nazimaja:');
	writeln('10 - sozdanie deka s RANDOM');
	writeln('11 - pomentaj 1. vij  ar i-tim');
	writeln('12 - dobavitj 3 novih elementa');
	writeln('13 - zakon4itj rabotu');
end;

procedure Name;
begin
	writeln('Avtor');
	writeln('');
	writeln('DITF');
	writeln('DEK otobrazennij v vektorialnoj forme.');
	writeln;
end;

begin
	Name; crea:=false;
	write('Esli ho4esh sozdatj dek, nazmi 1 => '); readln(sk);
	if sk=1 then Create(Dq,crea); {sozdaet dek}
	if (not crea) then begin write('DEKA netu. Operacii nedostupni. Nazmi knopku!'); readln; exit end;
	BG:
	if crea then begin
		BGG: ClrScr; MainWd;
		readln(Num);
		case Num of
		10: begin Start; readln; goto BGG; end;
		11: begin
                 if(Not empty(D))then
                begin
               Clrscr;
               Writeln('VVedi nomer elementa s kotorim ho4esh obmenatj');
                         Readln(i);
                         Aswap(D,i);
                 goto BGG; end; end;
		12: begin Insert; readln; goto BGG; end;
		13: goto FEND
		else begin writeln('viberi pravilnoe 4islo!'); readln; goto BGG; end;
		end;
		end;
	ClrScr;
  FEND: writeln('Ho4esh uni4tozitj dek? Esli da, nazmi 2 => '); readln(sk);
	if sk=2 then begin Terminate(Dq,crea); write('DEK uni4tozen, nazmi knopku!'); end {uni4tozaet dek}
			else begin writeln('Dek ne bil uni4tozen.'); goto BG; end;
	readln;
end.
Процедуры обмена: MakeSwap и ASwap, выделил их болдом.
igarexa вне форума Ответить с цитированием
Старый 13.05.2012, 06:22   #2
TinMan
Форумчанин
 
Аватар для TinMan
 
Регистрация: 05.09.2011
Сообщений: 869
По умолчанию

игареха, прога вылетает у тебя по той простой причине, что ты проверяешь на непустоту дек D, хотя надо проверять Dq. Насколько я понял, глобальная переменная D у тебя вообще лишняя, ты лучше ее убери, чтоб не путала тебя.

Но, увы, твои проблемы на этом не закончатся. Прога твоя написана настолько неправильно, что, потыкавшись минут 10 в разные места, я просто за голову схватился.. Советую все пересмотреть и переписать заново (кстати, отключи у себя в опциях возможность использования goto перед этим). Отвечу на все твои вопросы, если они будут по делу..
Успехов тебе.
Предпочитаю на "ты".
TinMan вне форума Ответить с цитированием
Старый 13.05.2012, 12:50   #3
igarexa
 
Регистрация: 07.10.2011
Сообщений: 5
По умолчанию

Tinman, благодарю за внимание, и за то что указал на ошибки, буду исправлять
igarexa вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Процедура. ПАскаль Elena04 Помощь студентам 1 24.04.2012 19:00
Паскаль.Процедура Ksushka12 Помощь студентам 5 08.06.2010 17:51
процедура в паскаль. кусака Помощь студентам 1 27.04.2010 21:07
Паскаль. Процедура P1RoG Помощь студентам 2 16.12.2009 18:03
Процедура (паскаль). aslanbek999 Помощь студентам 1 03.06.2009 17:38