бин. деревья, вывод дерева ввиде таблички с прокруткой на стрелочках Опции

[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]

Вот он исходник работающий  TREES.pas ( 6.56 килобайт ) Кол-во скачиваний: 377

Я для отладки выводил сперва массив созданный и всё работало нормально, как только опять врнулся к прокрутке - он стал шалить. Стала появляться экзит код 201, когда ты пытаешься вывести на экран больше 10 записей (у вывода с прокруткой), если в дерево вводить элементы типа таких :
INF1 INF2
111 AAA
222 BBB
900 CCC
20 DDD
80 EEEE



если номера в поле INF1 идут упорядоченными более-менее(тоесть при создании дерева ты их вводишь упорядоченными), то всё нормально выводится.

Сообщение отредактировано: Renbo - 7.05.2007 21:58

[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;