Помощь - Поиск - Пользователи - Календарь
Полная версия: бин. деревья
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Renbo
Обычным способом вывести легко, через способ ЛОП всё выходит упорядоченным )
А вот необходимо прикрепить к этому прокрутку.
Я вот что сделал, но что-то в переменных запутался, подскажите плизз:


TYPE
ND=^NODE;
Node=record
INF1:integer;
INF2:string;
LEFT:ND;
RIGHT:ND;
end;

VAR
ROOT,P,Q:ND;
otvet:string;
ch:char;
F:integer;

procedure Shapka;
Begin
clrscr;
writeln('------------------------------------------------------------');
writeln('№':3,' * Табельный номер * Фамилия');
writeln('------------------------------------------------------------');
end;



procedure node_count(P:ND; VAR n_count:Integer); {обход дерева с подсчётом кол-ва узлов}
Begin
IF P<>NIL then
begin
IF (P^.LEFT<>NIL) or (P^.RIGHT<>NIL) then
inc(n_count);
IF (P^.LEFT=NIL) and (P^.RIGHT=NIL) then
inc(n_count);
node_count(P^.LEFT,n_count);
node_count(P^.RIGHT,n_count);
end;
End;

function node_count:integer; {получение количества узлов в дереве}
VAR
n_count:integer;
Begin
n_count:=0;
node_count(ROOT,n_count);
node_count:=n_count;
End;

procedure show(P:ND;VAR i:integer); {обход дерева через ЛОП}
Begin
IF P<>NIL then
begin
show(P^.LEFT,i);
IF P^.LEFT=NIL then
inc(i);
writeln(i:3,' * ',p^.INF1:10,' * ',p^.INF2:30);
IF P^.RIGHT=NIL then
inc(i);
show(P^.RIGHT,i);
end;
End;


Procedure vivodilka; {процедура по выводу с прокруткой, которая работает не корректно}
VAR
curr_poss,i,n:integer;
refresh:boolean;
Begin
curr_poss:=0;
refresh:=true;
i:=0;
repeat
if refresh then
begin
Shapka;
n:=0;
repeat
inc(n);
IF i = n+curr_poss then
begin
write(i+curr_poss:3);
show(ROOT,i);
end;
until (i > 10) or (P=NIL);
refresh:=false;
end;
case ord(readkey) of
80: if curr_poss+10 < node_count then
begin
inc(curr_poss,10);
refresh:=true;
end;
72: if curr_poss-10 >=0 then
begin
dec(curr_poss,10);
refresh:=true;
end;
13: break;
end;
until false;
End;




Renbo
Я тут подумал и решил сделать через вспомогательный массив динамический, но что-то не то, мож ОЗУ уже сдохло?


TYPE
ND=^NODE;
Node=record
INF1:integer;
INF2:string[5];
LEFT:ND;
RIGHT:ND;
end;

MasNode=record
INF1:integer;
INF2:string[5];
end;



mas=array[1..100] of MasNode;
tmas=^mas;

procedure MasCreate(P:ND;i:integer);
Begin
IF P<> NIL then
begin
MasCreate(P^.LEFT,i);
IF P^.LEFT=NIL then
inc(i);
Z^[i].INF1:=p^.INF1;
Z^[i].INF2:=p^.INF2;
IF P^.RIGHT=NIL then
inc(i);
MasCreate(P^.RIGHT,i);
end;
End;

procedure vivod_procrytka;
VAR
curr_poss,i,n,k:integer;
refresh:boolean;
Begin

getmem(Z,nd_count*sizeof(MasNode));
curr_poss:=0;
refresh:=true;
i:=0;
MasCreate(ROOT,i);

readkey;
clrscr;
repeat
if refresh then
begin
Shapka;
i:=1;
repeat
write(curr_poss+i:3);
writeln(' * ',Z^[curr_poss+i].INF1:10,' * ',Z^[curr_poss+i].INF2:30);
inc(i);
until (i > 10) or (curr_poss+i-1 >= nd_count{ это число узлов во всём дереве});
refresh:=false;
end;
case ord(readkey) of
80: if curr_poss+10 < nd_count { это число узлов во всём дереве} then
begin
inc(curr_poss,10);
refresh:=true;
end;
72: if curr_poss-10 >=0 then
begin
dec(curr_poss,10);
refresh:=true;
end;
13: break;
end;
until false;
freemem(Z,nd_count*sizeof(MasNode));
End;


volvo
Ты вообще чего ждешь? Чтобы кто-то ЗАНОВО написал точно такое же заполнение дерева, как у тебя, телепатически определил, КАК ты вызываешь этот кусок кода, и протестировал? Что, нельзя сделать тестовую программу, которую надо запустить (а не дописывать больше половины), и она будет некорректно работать? Тогда будет о чем говорить...
Renbo
Вот он исходник работающий Нажмите для просмотра прикрепленного файла
Я для отладки выводил сперва массив созданный и всё работало нормально, как только опять врнулся к прокрутке - он стал шалить. Стала появляться экзит код 201, когда ты пытаешься вывести на экран больше 10 записей (у вывода с прокруткой), если в дерево вводить элементы типа таких :
INF1 INF2
111 AAA
222 BBB
900 CCC
20 DDD
80 EEEE



если номера в поле INF1 идут упорядоченными более-менее(тоесть при создании дерева ты их вводишь упорядоченными), то всё нормально выводится.
Renbo
думал-думал, и кажется что ошибка где-то в этой процедуре:


procedure MasCreate(P:ND;i:integer);
Begin
IF P<> NIL then
begin
MasCreate(P^.LEFT,i);
IF P^.LEFT=NIL then
inc(i);
Z^[i].INF1:=p^.INF1;
Z^[i].INF2:=p^.INF2;
IF P^.RIGHT=NIL then
inc(i);
MasCreate(P^.RIGHT,i);
end;
End;



Если от корня все ветки будут уходить тольо вправо, то массив создасться нормально и выведется нормально на экран с прокруткой. Если же произойдёт ветвление - то мне кажется i увеличится неверно, тоесть не будет например Z^[2]-го элемента и когда будет идти вывод, то он соответственно заступорится и выдаст ошибку. Моя мысль верна?
Renbo
вообщем я всё сделал. Выкладываю код для последующих так сказать поколений )
Вот он код для вывода дерева ввиде таблицы с прокруткой на стрелочках вверх-вниз


procedure Shapka;
Begin
clrscr;
writeln('------------------------------------------------------------');
writeln('№':3,' * Табельный номер * Фамилия');
writeln('------------------------------------------------------------');
end;


procedure MasCreate(P:ND;VAR i:integer);
Begin
IF P<> NIL then
begin
MasCreate(P^.LEFT,i);
IF (P^.LEFT<>NIL) or (P^.RIGHT<>NIL) then
begin
inc(i);
Z^[i].INF1:=p^.INF1;
Z^[i].INF2:=p^.INF2;
end;
IF (P^.LEFT=NIL) and (P^.RIGHT=NIL) then
begin
inc(i);
Z^[i].INF1:=p^.INF1;
Z^[i].INF2:=p^.INF2;
end;
MasCreate(P^.RIGHT,i);
end;
End;


procedure vivod_procrytka;
VAR
curr_poss,i,n,k:integer;
refresh:boolean;
Begin
clrscr;
IF ROOT=NIL then
begin
writeln('дерево не существует');
readkey;
exit;
end;
getmem(Z,nd_count*sizeof(ZAP));
curr_poss:=0;
refresh:=true;
i:=0;
MasCreate(ROOT,i);
repeat
if refresh then
begin
Shapka;
n:=1;
repeat
write(curr_poss+n:3);
writeln(' * ',Z^[curr_poss+n].INF1:10,' * ',Z^[curr_poss+n].INF2:30);
inc(n);
until (n > 10) or (curr_poss+n-1 >= i);
refresh:=false;
end;
case ord(readkey) of
80: if curr_poss+10 < i then
begin
inc(curr_poss,10);
refresh:=true;
end;
72: if curr_poss-10 >=0 then
begin
dec(curr_poss,10);
refresh:=true;
end;
13: break;
end;
until false;
freemem(Z,nd_count*sizeof(ZAP));
End;


Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.