unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
type
TForm1 =
class(TForm)
Image1: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
type link = ^node;
node =
record
info, key : integer;
l,r : link;
red : boolean;
end;
var head, z : link;
procedure Bild(xa,xe,y: integer; b:link);
var x1: integer;
begin
form1.Image1.Canvas.pen.color:=0;
if b<>z
then
begin
x1:=(xa+xe)
div 2;
Form1.Image1.Canvas.MoveTo(x1+3,y+13);
Form1.Image1.Canvas.LineTo((x1+xe)
div 2,y+40);
Bild(xa,x1,y+40,b^.r);
if b^.red
then
Form1.Image1.Canvas.Pen.Color:=clRed
else
Form1.Image1.Canvas.Pen.Color:=clBlack;
Form1.Image1.Canvas.TextOut((xa+xe)
div 2,y,IntToStr(b^.info));
Form1.Image1.Canvas.MoveTo(x1+3,y+13);
Form1.Image1.Canvas.LineTo((x1+xa)
div 2,y+40);
Bild(x1,xe,y+40,b^.l);
end
else
Form1.Image1.Canvas.TextOut((xa+xe)
div 2,y,'
nil');
end;
procedure rbtinitialize;
begin
new(z);
z^.l:=z;
z^.r:=z;
z^.red := false;
new(head);
head^.key:=0;
head^.r:=z;
head^.l:=z;
end;
function rotate(v:integer; y:link) : link;
var c,gc : link;
begin
if v < y^.key
then
c :=y^.l
else
c:=y^.r;
if v < c^.key
then
begin
gc:=c^.l;
c^.l:=gc^.r;
gc^.r:=c;
end
else
begin
gc:=c^.r;
c^.r:=gc^.l;
gc^.l:=c;
end;
if v < y^.key
then
y^.l:=gc
else
y^.r:=gc;
rotate := gc
end;
function split (v:integer; gg,g,p,x : link) : link;
begin
x^.red:=true;
x^.l^.red := false;
x^.r^.red:= false;
if p^.red
then
begin
g^.red := true;
if (v < g^.key) <> (v < p^.key)
then
p:=rotate(v,g);
x:= rotate(v,gg);
x^.red :=false
end;
head^.r^.red := false;
split:=x;
end;
function rbtreeinsert(v:integer; x : link) : link;
var gg, g, p : link;
begin
p:=x;
g:=x;
repeat
gg:=g;
g:=p;
p:=x;
if v < x^.key
then
x:=x^.l
else
x:=x^.r;
if x^.l^.red
and x^.r^.red
then x:= split(v,gg,g,p,x);
until x=z;
new(x);
x^.info := v ;
x^.l:=z;
x^.r:=z;
if v < p^.key
then
p^.l:=x
else
p^.r:=x;
rbtreeinsert:=x;
x := split (v,gg,g,p,x);
end;
procedure TForm1.Button1Click(Sender: TObject);
var i: integer;
begin
image1.Canvas.Rectangle(0,0,500,500);
rbtinitialize;
randomize;
for i:=1
to 20
do
rbtreeinsert(i,head);
if head.red
then Button1Click(self)
else
Bild(0,400,10,head^.r);
end;
end.