Скачиваний:
13
Добавлен:
15.06.2014
Размер:
2.42 Кб
Скачать
unit Unit3;

interface
uses
SysUtils, StdCtrls, ComCtrls;

type Tkey =integer;
Tinf=record
s:string[100];
key:Tkey;
end;
Ptree=^tree;
Tree=record
inf:tinf;
a1,a2:Ptree;
end;


mas=array[1..100] of Tinf;


procedure FindK(var p:ptree;var k:integer; var sitem:string);
procedure AddIt(var inf:Tinf;var p:Ptree);
Procedure View(var TreeView1:TTreeView;var p:ptree);
procedure MakeB(var a:mas; var n:integer;var p:ptree);
procedure Read(var p:ptree; memo1:Tmemo);
procedure FindA(var p:ptree; var kol:integer);
procedure Delett(p:ptree);



implementation

procedure FindK(var p:ptree;var k:integer; var sitem:string);
var s:string;
begin
s:='';
if p.inf.key=k then begin
sitem:=p.inf.s;
end;
if p.inf.key>k then
if p.a1<>nil then
FindK(p.a1,k,sitem);
if p.inf.key<k then
if p.a2<>nil then
FindK(p.a2,k,sitem);
end;


procedure AddIt(var inf:Tinf;var p:Ptree);
begin
if p=nil then begin
new(p);
p.inf:=inf;
p^.a1:=nil;
p^.a2:=nil;
end;
if p.inf.key>inf.key then
AddIt(inf,p.a1);
if p.inf.key<inf.key then
AddIt(inf,p.a2);
end;


Procedure View(var TreeView1:TTreeview;var p:ptree);
Procedure VW(var p:ptree;var kl:Integer);
Begin if p <> Nil then begin
if kl=-1 then
TreeView1.Items.AddFirst(Nil, p^.Inf.s+' ' +IntToStr(p^.Inf.key))
else
TreeView1.Items.AddChildFirst(TreeView1. Items [kl], p^.Inf.s+' '+IntToStr(p^.Inf.key));
Inc(kl);
VW(p^.A1,kl);
VW(p^.A2,kl);
Dec(kl);
end;
end;
var kl:integer;
begin
TreeView1.Items.Clear;
kl:=-1;
VW(p,kl);
TreeView1.FullExpand;
end;


procedure MakeB(var a:mas; var n:integer;var p:ptree);
var i:integer;
begin
p:=nil;
for i:=1 to n do
AddIt(a[i],p);
end;


procedure Read(var p:ptree; memo1:Tmemo);
begin
if p<>nil then begin
Memo1.Lines.Add(p.inf.s+' '+IntToStr(p.inf.key));
Read(p.a1,memo1);
Read(p.a2,memo1);
end;
end;


procedure FindA(var p:ptree; var kol:integer);
begin
if p.inf.s[1]='А' then
inc(kol);
if p.a1<>nil then FindA(p.a1,kol);
if p.a2<>nil then FindA(p.a2,kol);
end;


procedure Delett(p:ptree);
begin
if p=nil then exit;
Delett(p.a1);
Delett(p.a2);
Dispose(p);
p:=nil;
end;




end.
Соседние файлы в папке кол-во фамилий с буквы а
  • #
    15.06.20142.63 Кб13Unit1.~pas
  • #
    15.06.20141.64 Кб13Unit2.dcu
  • #
    15.06.20141.36 Кб13Unit2.pas
  • #
    15.06.20141.35 Кб13Unit2.~pas
  • #
    15.06.20142.89 Кб13Unit3.dcu
  • #
    15.06.20142.42 Кб13Unit3.pas
  • #
    15.06.20142.26 Кб13Unit3.~pas