tssetlib.pas

企业进销存管理系统

    end; //TtsIntegerSetList


function IntCompare(Int1, Int2: Pointer): Integer;


implementation

//******************************************************************************
//Implementation of class TtsSetNode

constructor TtsSetNode.CreatePtr(NodeValue : Pointer);
begin
    Initialize;
end;

procedure TtsSetNode.Initialize;
begin
    FBalance := 0;
    FLeft := nil;
    FRight := nil;
end;

destructor TtsSetNode.Destroy;
begin
    inherited Destroy;
end;

procedure TtsSetNode.Assign(Source: TtsSetNode);
begin
    FLeft := nil;
    FRight := nil;
    FBalance := Source.FBalance;
end;

function TtsSetNode.Release(DestroyingSet : Boolean) : Pointer;
begin
    Free;
    Result := nil;
end;

function TtsSetNode.Compare(NodeSet: TtsCustomSet; NodeValue : Pointer) : TtsSetOrder;
{The compare method should compare NodeValue to the object itself. The method
 must be overridden.

 Return value:
    ordLarger if NodeValue is larger
    ordSmaller if NodeValue is smaller
    ordEqual if NodeValue is equal
}
begin
    Result := ordEqual;
end;

function TtsSetNode.CompareKey(NodeSet: TtsCustomSet; KeyValue : Pointer) : TtsSetOrder;
begin
    Result := Compare(NodeSet, KeyValue);
end;

function TtsSetNode.Value : Pointer;
begin
    Result := nil;
end;

//End implementation of class TtsSetNode
//******************************************************************************

//******************************************************************************
//Implementation of class TtsSetList

constructor TtsSetList.CreateCnt(NrOfElements : Longint);
begin
    Create;
    Initialize;

    if NrOfElements > 0 then
    begin
        FCount := NrOfElements;
        GetMem(FItems, FCount * SizeOf(Pointer));
    end;
end;

procedure TtsSetList.Initialize;
begin
    FCount := 0;
    FItems := nil;
end;

destructor TtsSetList.Destroy;
begin
    if FItems <> nil then FreeMem(FItems);
    inherited Destroy;
end;

procedure TtsSetList.SetItems(Index : Longint; Value : Pointer);
begin
    if (Index > 0) and (Index <= FCount) then
    begin
        FItems[Index] := Value;
    end;
end;

function TtsSetList.GetItems(Index : Longint) : Pointer;
begin
    if (Index > 0) and (Index <= FCount) then
        Result := FItems[Index]
    else
        Result := nil;
end;

//End implementation of class TtsSetList
//******************************************************************************


//******************************************************************************
//Implementation of class TtsNodeStack

constructor TtsNodeStack.Create;
begin
    inherited;
    FBuffer := nil;
    FBufSize := 0;
    FCount := 0;
end;

destructor TtsNodeStack.Destroy;
begin
    ReallocMem(FBuffer, 0);
    inherited;
end;

function TtsNodeStack.Push(Node: TtsSetNode; Direction: Shortint): Integer;
begin
    if FCount >= FBufSize then
    begin
        FBufSize := FCount + 10;
        ReallocMem(FBuffer, FBufSize * SizeOf(TtsNodeStackElement));
    end;

    Inc(FCount);
    FBuffer[FCount].Node := Node;
    FBuffer[FCount].Direction := Direction;
    Result := FCount;
end;

function TtsNodeStack.Pop: TtsNodeStackElement;
begin
    if Count > 0 then
    begin
        Result := FBuffer[FCount];
        Dec(FCount);
    end
    else
    begin
        Result.Node := nil;
        Result.Direction := 0;
    end;
end;

procedure TtsNodeStack.Replace(Index: Integer; Node: TtsSetNode; Direction: Shortint);
begin
    FBuffer[Index].Node := Node;
    FBuffer[Index].Direction := Direction;
end;

procedure TtsNodeStack.Reset;
begin
    FCount := 0;
end;

function TtsNodeStack.GetItem(Index: Integer): TtsNodeStackElement;
begin
    if (Index > 0) and (Index <= FCount) then
    begin
        Result := FBuffer[Index];
    end
    else
    begin
        Result.Node := nil;
        Result.Direction := 0;
    end;
end;

//End implementation of class TtsNodeStack
//******************************************************************************


//******************************************************************************
//Implementation of class TtsCustomSet

constructor TtsCustomSet.Create;
begin
    Initialize;
end;

procedure TtsCustomSet.Initialize;
begin
    FCount := 0;
    FTopNode := nil;
    FStack := TtsNodeStack.Create;
end;

destructor TtsCustomSet.Destroy;
begin
    DestroyNodes(FTopNode);
    FStack.Free;
    inherited Destroy;
end;

procedure TtsCustomSet.DestroyNodes(Tree : TtsSetNode);
begin
    if Tree <> nil then
    begin
        DestroyNodes(Tree.Left);
        DestroyNodes(Tree.Right);
        Tree.Release(true);
    end;
end;

procedure TtsCustomSet.Clear;
begin
    DestroyNodes(FTopNode);
    FTopNode := nil;
    FCount := 0;
    FStack.Reset;
end;

function TtsCustomSet.NewNode(NodeValue : Pointer) : TtsSetNode;
begin
    NewNode := TtsSetNode.CreatePtr(NodeValue);
end;

function TtsCustomSet.CopyNodes(Node: TtsSetNode): TtsSetNode;
begin
    if Node = nil then
        Result := nil
    else
    begin
        Result := GetNewNode(Node.Value);
        Result.Assign(Node);
        Result.Left := CopyNodes(Node.Left);
        Result.Right := CopyNodes(Node.Right);
    end;
end;

procedure TtsCustomSet.Assign(Source: TtsCustomSet);
begin
    Inc(FAssigning);
    try
        FTopNode := CopyNodes(Source.FTopNode);
    finally
        Dec(FAssigning);
    end;
end;

function TtsCustomSet.GetAssigning: Boolean;
begin
    Result := FAssigning <> 0;
end;

function TtsCustomSet.GetNewNode(NodeValue: Pointer): TtsSetNode;
var
    Node :TtsSetNode;
begin
    Node := NewNode(NodeValue);
    Node.FBalance := 0;
    FCount := FCount + 1;
    Result := Node;
end;

procedure TtsCustomSet.SearchNode(NodeValue: Pointer; var ParentNode, BalanceNode,
                                  NewNode: TtsSetNode; var Found: Boolean);
var
    Compare: TtsSetOrder;
    CurNode: TtsSetNode;
begin
    ParentNode := nil;
    CurNode := FTopNode;
    BalanceNode := FTopNode;

    NewNode := nil;
    Found := False;
    while True do
    begin
        Compare := CurNode.Compare(Self, NodeValue);
        case Compare of
            ordEqual: begin NewNode := CurNode; Found := True; Break; end;
            ordSmaller: NewNode := CurNode.Left;
            ordLarger:  NewNode := CurNode.Right;
        end;

        if NewNode = nil then
        begin
            NewNode := GetNewNode(NodeValue);
            if Compare = ordSmaller then CurNode.Left := NewNode
                                    else CurNode.Right := NewNode;
            Break;
        end;

        if NewNode.Balance <> 0 then
        begin
            ParentNode := CurNode;
            BalanceNode := NewNode;
        end;

        CurNode := NewNode;
    end;
end;

procedure TtsCustomSet.InsertSetBalance(NodeValue: Pointer; FromNode, ToNode: TtsSetNode);
var
    CurNode: TtsSetNode;
begin
    CurNode := FromNode;
    while CurNode <> ToNode do
    begin
        if CurNode.Compare(Self, NodeValue) = ordSmaller then
        begin
            CurNode.Balance := -1;
            CurNode := CurNode.Left;
        end
        else
        begin
            CurNode.Balance := 1;
            CurNode := CurNode.Right;
        end;
    end;
end;

procedure TtsCustomSet.RotateSingle(Direction: Shortint; var SubTopNode: TtsSetNode;
                                    BalanceNode, BalanceChildNode: TtsSetNode);
begin
    SubTopNode := BalanceChildNode;
    if Direction > 0 then
    begin
        BalanceNode.Right := BalanceChildNode.Left;
        BalanceChildNode.Left := BalanceNode;
    end
    else
    begin
        BalanceNode.Left := BalanceChildNode.Right;
        BalanceChildNode.Right := BalanceNode;
    end;

    if BalanceChildNode.Balance <> 0 then
    begin
        BalanceNode.Balance := 0;
        BalanceChildNode.Balance := 0;
    end
    else
    begin
        BalanceNode.Balance := Direction;
        BalanceChildNode.Balance := -Direction;
    end;
end;

procedure TtsCustomSet.RotateDouble(Direction: Shortint; var SubTopNode: TtsSetNode;
                                    BalanceNode, BalanceChildNode: TtsSetNode);
begin
    if Direction > 0 then
    begin
        SubTopNode := BalanceChildNode.Left;
        BalanceChildNode.Left := SubTopNode.Right;
        SubTopNode.Right := BalanceChildNode;
        BalanceNode.Right := SubTopNode.Left;
        SubTopNode.Left := BalanceNode;
    end
    else
    begin
        SubTopNode := BalanceChildNode.Right;
        BalanceChildNode.Right := SubTopNode.Left;
        SubTopNode.Left := BalanceChildNode;
        BalanceNode.Left := SubTopNode.Right;
        SubTopNode.Right := BalanceNode;
    end;

    if SubTopNode.Balance = Direction then
    begin
        BalanceNode.Balance := -Direction;
        BalanceChildNode.Balance := 0;
    end
    else if SubTopNode.Balance = 0 then
    begin
        BalanceNode.Balance := 0;
        BalanceChildNode.Balance := 0;
    end
    else if SubTopNode.Balance = -Direction then
    begin
        BalanceNode.Balance := 0;
        BalanceChildNode.Balance := Direction;
    end;

    SubTopNode.Balance := 0;
end;

procedure TtsCustomSet.InsertRebalance(Direction: Shortint; ParentNode, BalanceNode, BalanceChildNode: TtsSetNode);
var
    SubTopNode: TtsSetNode;
begin
    if BalanceNode.Balance = 0 then
    begin
        BalanceNode.Balance := Direction;
        Exit;
    end;

    if BalanceNode.Balance = -Direction then
    begin
        BalanceNode.Balance := 0;
        exit;
    end;

    if BalanceChildNode.Balance = Direction
        then RotateSingle(Direction, SubTopNode, BalanceNode, BalanceChildNode)
        else RotateDouble(Direction, SubTopNode, BalanceNode, BalanceChildNode);

    if ParentNode = nil then
        FTopNode := SubTopNode
    else
    begin
        if BalanceNode = ParentNode.Right
            then ParentNode.Right := SubTopNode
            else ParentNode.Left := SubTopNode;
    end;
end;

function TtsCustomSet.AddNode(NodeValue : Pointer) : TtsSetNode;
var
    Found: Boolean;
    ParentNode: TtsSetNode;
    NewNode, BalanceNode: TtsSetNode;
    BalanceChildNode: TtsSetNode;
    Compare: TtsSetOrder;
    Direction: Shortint;
begin
    if FTopNode = nil then
    begin
        FTopNode := GetNewNode(NodeValue);
        Result := FTopNode;
        Exit;
    end;

    SearchNode(NodeValue, ParentNode, BalanceNode, NewNode, Found);
    Result := NewNode;
    if Found then Exit;

    Compare := BalanceNode.Compare(Self, NodeValue);