Добавил:
Kaz
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз:
Предмет:
Файл:АСОИ, Delphi, много вариантов 2 сем / 3деревья / кол-во фамилий с буквы а / Unit3
.pas 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.
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.