Interfaces and Collection Classes in Delphi

Example 3: The TRbNode class encapsulates the entire color trick

type
  TRbColor = (rbBlack, rbRed);
  TRbNode = class
  private
    fLeft, fRight: TRbNode;
    fItem: ICollectible;
    fParent: Integer;
    function GetParent: TRbNode;
    procedure SetParent(Parent: TRbNode);
  protected
    constructor Create(Item: ICollectible; Leaf, Parent: TRbNode; Color: 
                     TRbColor);
    function IsRed: Boolean;
    function IsBlack: Boolean;
    function GetColor: TRbColor; virtual;
    procedure SetColor(Color: TRbColor); virtual;

    property Left: TRbNode read fLeft write fLeft;
    property Right: TRbNode read fRight write fRight;
    property Item: ICollectible read fItem write fItem;
    property Color: TRbColor read GetColor write SetColor;
    property Parent: TRbNode read GetParent write SetParent;
  end;


const
  ColorMask = $00000001;
  PointerMask = $FFFFFFFE;

constructor TRbNode.Create(Item: ICollectible; Leaf, Parent: TRbNode; Color:
                         TRbColor);
begin
  inherited Create;
  fItem := Item;
  fParent := Integer(Parent);
  // Start out with color = rbBlack
  fLeft := Leaf;
  fRight := Leaf;
  Self.Color := Color;
end;

function TRbNode.GetColor: TRbColor;
begin
  if (fParent and ColorMask) <> 0 then
    Result := rbRed
  else
    Result := rbBlack;
end;

function TRbNode.GetParent: TRbNode;
begin
  Result := TRbNode(fParent and PointerMask)
end;

function TRbNode.IsBlack: Boolean;
begin
  Result := Color = rbBlack;
end;

function TRbNode.IsRed: Boolean;
begin
  Result := Color = rbRed;
end;

procedure TRbNode.SetColor(Color: TRbColor);
begin
  if Color = rbRed then
    fParent := fParent or ColorMask
  else
    fParent := fParent and PointerMask;
end;

procedure TRbNode.SetParent(Parent: TRbNode);
begin
  fParent := (fParent and ColorMask) or Integer(Parent);
end;