uses crt; type InfoTyp=Longint; type TypKLice=Longint; UkBod=^Bod; Bod=record Klic:TypKlice; Info:InfoTyp; Levy,Pravy:UkBod; end; var ch:char; souborname:string; kl:char; anone:boolean; KonecProgramu:string; Strom:UkBod; I:Longint; Nic:UkBod; KNahrazeni:UkBod; Zastupce:UkBod; files:text; filess:text; radek:string; linecount:Longint; jojo:boolean; procedure hlavnimenu; begin TextBackground(0); clrscr; TextBackground(11); TextColor(15); write('|'); TextColor(10); write(' S'); TextColor(15); write('trom |'); TextColor(10); write(' Z'); TextColor(15); write('aznam |'); TextColor(10); write(' V'); TextColor(15); write('ypis |'); TextColor(10); write(' K'); TextColor(15); write('onec '); TextColor(10); write(' H'); TextColor(15); write('elp '); end; procedure polozkahlavnimenu; begin TextBackground(0); clrscr; hlavnimenu; anone:=false; repeat ch:=readkey; if ch='s' then anone:=true; if ch='z' then anone:=true; if ch='v' then anone:=true; if ch='k' then anone:=true; if ch='h' then anone:=true; until anone=true; end; procedure soubormenu; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(14); write(' Ul'); TextColor(11); write('o'); TextColor(14); write('z '); TextBackground(11); TextColor(15); writeln('|'); write('|'); TextBackground(6); TextColor(11); write(' N'); TextColor(14); write('ic '); TextBackground(11); TextColor(15); writeln('|'); end; procedure polozkasoubormenu; begin TextBackground(0); clrscr; soubormenu; anone:=false; repeat ch:=readkey; if ch='o' then anone:=true; if ch='n' then anone:=true; until anone=true; end; procedure zaznammenu; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' P'); TextColor(14); write('ridej '); TextBackground(11); TextColor(15); writeln('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' S'); TextColor(14); write('maz '); TextBackground(11); TextColor(15); writeln('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' N'); TextColor(14); write('ic '); TextBackground(11); TextColor(15); writeln('|'); end; procedure polozkazaznammenu; begin TextBackground(0); clrscr; zaznammenu; anone:=false; repeat ch:=readkey; if ch='p' then anone:=true; if ch='s' then anone:=true; if ch='n' then anone:=true; until anone=true; end; procedure vypismenu; begin TextBackground(0); clrscr; hlavnimenu; end; procedure zapisdo(Co:UkBod; Odsad:Integer); begin if Co <> nil then begin zapisdo(Co^.Levy, Odsad+2); writeln(Files,'':Odsad, Co^.Klic); zapisdo(Co^.Pravy, Odsad+2); end; end; procedure polozkavypismenu(Co:UkBod; Odsad:Integer); begin Assign(Files, 'zk-btree.tmp'); Rewrite(Files); zapisdo(Strom, 1); Close(Files); Assign(Files, 'zk-btree.tmp'); Reset(Files); TextBackground(0); clrscr; hlavnimenu; TextBackground(0); TextColor(15); writeln; writeln; LineCount:=0; while not Eof(Files) do begin ReadLn(files, radek); WriteLn(radek); LineCount:=LineCount+1; if LineCount=18 then begin LineCount:=0; writeln; textcolor(13); writeln(' Pro pokracovani vypisu stisknete klavesu ...'); kl:=readkey; TextBackground(0); clrscr; hlavnimenu; TextBackground(0); TextColor(15); writeln; writeln; end; end; close(files); writeln; textcolor(13); writeln(' Vypis sromu je ukoncen ...'); kl:=readkey; end; procedure konecmenu; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' A'); TextColor(14); write('no '); TextBackground(11); TextColor(15); writeln('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' N'); TextColor(14); write('e '); TextBackground(11); TextColor(15); writeln('|'); end; procedure polozkakonecmenu; begin TextBackground(0); clrscr; konecmenu; anone:=false; repeat ch:=readkey; if ch='a' then anone:=true; if ch='n' then anone:=true; until anone=true; end; procedure helpmenu; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' HELP '); TextBackground(11); TextColor(15); write('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' ^^^^^^ '); TextBackground(11); TextColor(15); write('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' Tak help tu opravdu nenajdete !!! '); TextBackground(11); TextColor(15); write('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' Kontaktujte prosim autora ->>'); TextColor(10); write(' ZK '); TextBackground(11); TextColor(15); write('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' e-mail je mozne zaslat na ->>'); TextColor(14); write(' zk.zk@post.cz '); TextBackground(11); TextColor(15); write('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(0); TextColor(0); write(' '); TextBackground(11); TextColor(15); write('|'); TextBackground(6); TextColor(11); write(' SPSSE a VOS Liberec, Cerven 2000 '); TextBackground(11); TextColor(15); write('|'); readkey; end; function vlozhodnota:integer; var hodnotaa:integer; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(9); textcolor(13); gotoxy(23,11);writeln(' Vozte prosim hodnotu: '); TextBackground(11); gotoxy(23,12);writeln('| |'); gotoxy(23,13);writeln('| |'); gotoxy(23,14);writeln('| |'); gotoxy(23,15);writeln('| |'); gotoxy(23,16);writeln('|_____________________________|'); textcolor(11); gotoxy(28,13);write('Hodnota : '); TextBackground(0); textcolor(15); write('.....'); TextBackground(6); textcolor(14); gotoxy(34,15);write('| OK |'); gotoxy(40,13); TextBackground(0); textcolor(15); read(hodnotaa); vlozhodnota:=hodnotaa; end; procedure zaznamje; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(9); textcolor(13); gotoxy(23,11);writeln(' Chybicka '); TextBackground(11); gotoxy(23,12);writeln('| |'); gotoxy(23,13);writeln('| |'); gotoxy(23,14);writeln('| |'); gotoxy(23,15);writeln('| |'); gotoxy(23,16);writeln('|_____________________________|'); textcolor(4); gotoxy(28,13);write('Zaznam jiz existuje'); TextBackground(6); textcolor(14); gotoxy(34,15);write('| OK |'); Sound(820); Delay(200); NoSound; kl:=readkey; end; procedure zaznamneni; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(9); textcolor(13); gotoxy(23,11);writeln(' Chybicka '); TextBackground(11); gotoxy(23,12);writeln('| |'); gotoxy(23,13);writeln('| |'); gotoxy(23,14);writeln('| |'); gotoxy(23,15);writeln('| |'); gotoxy(23,16);writeln('|_____________________________|'); textcolor(4); gotoxy(28,13);write('Zaznam neexistuje'); TextBackground(6); textcolor(14); gotoxy(34,15);write('| OK |'); Sound(820); Delay(200); NoSound; kl:=readkey; end; procedure zaznamvlozen; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(9); textcolor(13); gotoxy(23,11);writeln(' Zaznam '); TextBackground(11); gotoxy(23,12);writeln('| |'); gotoxy(23,13);writeln('| |'); gotoxy(23,14);writeln('| |'); gotoxy(23,15);writeln('| |'); gotoxy(23,16);writeln('|_____________________________|'); textcolor(4); gotoxy(28,13);write('Zaznam byl vlozen'); TextBackground(6); textcolor(14); gotoxy(34,15);write('| OK |'); end; procedure zaznamsmazan; begin TextBackground(0); clrscr; hlavnimenu; TextBackground(9); textcolor(13); gotoxy(23,11);writeln(' Zaznam '); TextBackground(11); gotoxy(23,12);writeln('| |'); gotoxy(23,13);writeln('| |'); gotoxy(23,14);writeln('| |'); gotoxy(23,15);writeln('| |'); gotoxy(23,16);writeln('|_____________________________|'); textcolor(4); gotoxy(28,13);write('Zaznam byl smazan'); TextBackground(6); textcolor(14); gotoxy(34,15);write('| OK |'); end; procedure StartProgramu; begin new(nic); Dispose(nic); end; procedure Zpracovani (X:UkBod); begin end; procedure Vykonej (Koho:UkBod); begin if Koho <> nil then begin Vykonej(Koho^.Levy); Zpracovani(Koho); Vykonej(Koho^.Pravy); end; end; function Pridej(Hodnota:TypKLice;var Misto:UkBod):UkBod; begin if Misto = nil then begin New(Misto); Misto^.Klic:=Hodnota; Misto^.Levy:=nil; Misto^.Pravy:=nil; Pridej:=Misto; zaznamvlozen; end else if Hodnota < Misto^.Klic then begin Pridej:=Pridej(Hodnota, Misto^.Levy); zaznamvlozen; end else if Hodnota > Misto^.Klic then begin Pridej:=Pridej(Hodnota, Misto^.Pravy); zaznamvlozen; end else begin zaznamje; Pridej:=Misto; end; end; function Zrus(Hodnota:Integer; var Kde:UkBod):UkBod; procedure Nahrad(var Kym:UkBod); begin if Kym^.Pravy <> nil then begin Nahrad(Kym^.Pravy); end else begin KNahrazeni^.Klic:=Kym^.Klic; KNahrazeni^.Info:=Kym^.Klic; Zrus:=Kym; Kym:= Kym^.Levy; end; end; begin {Zrus} if Kde = nil then begin zaznamneni; Zrus:=nil; end else if Hodnota < Kde^.Klic then begin Zrus:=Zrus(Hodnota, Kde^.Levy); end else if Hodnota > Kde^.Klic then begin Zrus:=Zrus(Hodnota, Kde^.Pravy); end else begin {mame ho!} Zrus:=Kde; if Kde^.Levy = nil then begin Kde:=Kde^.Pravy; end else if Kde^.Pravy = nil then begin Kde:=Kde^.Levy end else begin KNahrazeni:=Kde; Nahrad(Kde^.Levy); end; zaznamsmazan; end; end; {Zrus} procedure zaznampridej; begin i:=vlozhodnota; Nic:=Pridej(i,Strom); delay(300); clrscr; end; procedure smazzaznam; begin i:=vlozhodnota; { i:=i*(-1); } Nic:=Zrus(I, Strom); if Nic <> nil then Dispose(Nic); delay(300); clrscr; end; procedure zapisdos(Co:UkBod; Odsad:Integer); begin if Co <> nil then begin zapisdos(Co^.Levy, Odsad+2); writeln(Filess,'':Odsad, Co^.Klic); zapisdos(Co^.Pravy, Odsad+2); end; end; procedure souboruloz; begin clrscr; hlavnimenu; TextBackground(0); TextColor(15); writeln; write(' Zadejte cestu a jmeno souboru s koncovkou: '); readln(souborname); Assign(filess, souborname); rewrite(filess); zapisdos(Strom, 1); close(filess); clrscr; hlavnimenu; TextBackground(0); TextColor(15); writeln(''); writeln(' Zazanamy jsou ulozeny do: ',souborname); Sound(820); Delay(200); NoSound; delay(2000); end; procedure logoprogramu; begin TextBackground(0); TextColor(15); clrscr; TextColor(3); writeln('-------------------------------------------------------------------------------'); TextColor(15); writeln(' Binarni strom --->> ZK <<--- zk.zk@post.cz ---- SPSSE a VOS Liberec 26.6.2000'); TextColor(3); writeln('-------------------------------------------------------------------------------'); TextColor(7); writeln(''); writeln(''); writeln(''); end; begin StartProgramu; repeat polozkahlavnimenu; if ch='k' then begin polozkakonecmenu; hlavnimenu; if ch='a' then KonecProgramu:='konec'; ch:=' '; end; if ch='s' then begin polozkasoubormenu; hlavnimenu; if ch='o' then SouborUloz; ch:=' '; end; if ch='z' then begin polozkazaznammenu; hlavnimenu; if ch='p' then zaznampridej; if ch='s' then smazzaznam; ch:=' '; end; if ch='v' then begin polozkavypismenu(Strom, 1); hlavnimenu; end; if ch='h' then begin helpmenu; hlavnimenu; ch:=' '; end; until KonecProgramu='konec'; clrscr; logoprogramu; end.