outline.pas

这是不可多得的源代码

begin
  if FSelectedItem <> FRootNode then
  begin
    if not FSelectedItem.IsVisible then
      FSelectedItem := FSelectedItem.GetVisibleParent;
  end
  else if FRootNode.List.Count > 0 then
    FSelectedItem := FRootNode.GetVisibleNode(Row + 1);
  Result := FSelectedItem.Index
end;

procedure TCustomOutline.ResetSelectedItem;
begin
  FSelectedItem := FRootNode;
end;

procedure TCustomOutline.SetRowFromNode(Node: TOutlineNode);
var
  RowValue: LongInt;
begin
  if Node <> FRootNode then
  begin
    RowValue := 0;
    FRootNode.GetRowOfNode(Node, RowValue);
    Row := RowValue - 2;
  end;
end;

procedure TCustomOutline.SetSelectedItem(Value: Longint);
var
  Node: TOutlineNode;
begin
  if FBlockInsert then Exit;
  if (Value = 0) and (FRootNode.List.Count > 0) then Value := 1;
  if Value > 0 then
  begin
    Node := FSelectedItem;
    if Value <> FSelectedItem.Index then
    try
      Node := FRootNode.GetNodeAtIndex(Value);
    except
      on OutlineError do Error(SOutlineIndexError);
    end;
    if not Node.IsVisible then Node := Node.GetVisibleParent;
    FSelectedItem := Node;
    SetRowFromNode(Node);
  end
  else Error(SOutlineSelection);
end;

function TCustomOutline.Insert(Index: LongInt; const Text: string): LongInt;
begin
  Result := InsertObject(Index, Text, nil);
end;

function TCustomOutline.InsertObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
begin
  Result := -1;
  if Index > 0 then Result := AttachNode(Index, Text, Data, oaInsert)
  else if Index = 0 then Result := AddChildObject(Index, Text, Data)
  else Error(SOutlineError);
  SetCurItem(Index);
end;

function TCustomOutline.Add(Index: LongInt; const Text: string): LongInt;
begin
  Result := AddObject(Index, Text, nil);
end;

function TCustomOutline.AddObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
begin
  Result := -1;
  if Index > 0 then Result := AttachNode(Index, Text, Data, oaAdd)
  else If Index = 0 then Result := AddChildObject(Index, Text, Data)
  else Error(SOutlineError);
  SetCurItem(Index);
end;

function TCustomOutline.AddChild(Index: LongInt; const Text: string): LongInt;
begin
  Result := AddChildObject(Index, Text, nil);
end;

function TCustomOutline.AddChildObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
begin
  Result := -1;
  if Index >= 0 then Result := AttachNode(Index, Text, Data, oaAddChild)
  else Error(SOutlineError);
  SetCurItem(Index);
end;

procedure TCustomOutline.Delete(Index: LongInt);
begin
  if Index > 0 then
  begin
    try
      FRootNode.GetNodeAtIndex(Index).Free;
    except
      on OutlineError do Error(SOutlineIndexError);
    end;
  end
  else Error(SOutlineError);
end;

procedure TCustomOutline.Move(Destination, Source: LongInt; AttachMode: TAttachMode);
begin
  if (AttachMode = oaAddChild) or (Destination > 0) then
    MoveNode(Destination, Source, AttachMode)
  else Error(SOutlineError);
end;

procedure TCustomOutline.DeleteNode(Node: TOutlineNode; CurIndex: LongInt);
begin
  if (FGoodNode = FRootNode) and (FRootNode.List.Count <> 0) then
    FRootNode[0].SetGoodIndex;
  try
    FCurItem := FRootNode.GetNodeAtIndex(CurIndex);
  except
    on OutlineError do FCurItem := FRootNode;
  end;
  if (FSelectedItem = FRootNode) and (Node <> FRootNode) then
    GetSelectedItem;
  if ResizeGrid then Invalidate;
end;

procedure TCustomOutline.SetLevel(Node: TOutlineNode; CurLevel, NewLevel: Cardinal);
var
  NumLevels: Integer;

  procedure MoveUp(Node: TOutlineNode; NumLevels: Cardinal);
  var
    Parent: TOutlineNode;
    I: Cardinal;
    Index: Integer;
  begin
    Parent := Node;
    for I := NumLevels downto 1 do
      Parent := Parent.Parent;
    Index := Parent.Parent.GetNextChild(Parent.Index);
    if Index = InvalidIndex then Node.MoveTo(Parent.Parent.Index, oaAddChild)
    else Node.MoveTo(Index, oaInsert);
  end;

  procedure MoveDown(Node: TOutlineNode; NumLevels: Cardinal);
  var
    Parent: TOutlineNode;
    I: Cardinal;
  begin
    while NumLevels > 0 do
    begin
      Parent := Node.Parent;
      for I := Parent.List.Count - 1 downto 0 do
        if Parent.Items[I].Index = Node.Index then Break;
      if I > 0 then
      begin
        Parent := Parent.Items[I - 1];
        Node.MoveTo(Parent.Index, oaAddChild);
      end else Error(SOutlineBadLevel);
      Dec(NumLevels);
    end;
  end;

begin
  NumLevels := CurLevel - NewLevel;
  if (NewLevel > 0) then
  begin
    if (NumLevels > 0) then MoveUp(Node, NumLevels)
    else MoveDown(Node, ABS(NumLevels));
  end
  else Error(SOutlineBadLevel);
end;

procedure TCustomOutline.Click;
begin
  if FRootNode.List.Count > 0 then
    SelectedItem := FRootNode.GetVisibleNode(Row + 1).Index;
  inherited Click;
end;

procedure TCustomOutline.WMSize(var Message: TWMSize);
begin
  inherited;
  if FSettingWidth or FSettingHeight then Exit;
  if (ScrollBars in [ssNone, ssVertical]) or
    ((Style = otOwnerDraw) and Assigned(FOnDrawItem)) then
    DefaultColWidth := ClientWidth
  else SetHorzScrollBar;
end;

procedure TCustomOutline.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if FSelectedItem <> FRootNode then
    case Key of
      '+': FSelectedItem.Expanded := True;
      '-': FSelectedItem.Expanded := False;
      '*': FSelectedItem.FullExpand;
    end;
end;

procedure TCustomOutline.KeyDown(var Key: Word; Shift: TShiftState);
var
  Node: TOutlineNode;
begin
  inherited KeyDown(Key, Shift);
  if FRootNode.List.Count = 0 then Exit;
  Node := FRootNode.GetVisibleNode(Row + 1);
  case Key of
    VK_HOME:
      begin
        SelectedItem := TOutlineNode(FRootNode.List.First).Index;
        Exit;
      end;
    VK_END:
      begin
        Node := TOutlineNode(FRootNode.List.Last);
        while Node.Expanded and Node.HasItems do
          Node := TOutlineNode(Node.List.Last);
        SelectedItem := Node.Index;
        Exit;
      end;
    VK_RETURN:
      begin
        Node.Expanded := not Node.Expanded;
        Exit;
      end;
    VK_MULTIPLY:
      begin
        if ssCtrl in Shift then
        begin
          FullExpand;
          Exit;
        end;
      end;
    VK_RIGHT:
      begin
        if (not Node.HasItems) or (not Node.Expanded) then MessageBeep(0)
        else SelectedItem := SelectedItem + 1;
        Exit;
      end;
    VK_LEFT:
      begin
        if Node.Parent = FRootNode then MessageBeep(0)
        else SelectedItem := Node.Parent.Index;
        Exit;
      end;
    VK_UP:
      if ssCtrl in Shift then
      begin
        with Node.Parent do
        begin
          if List.First = Node then MessageBeep(0)
          else SelectedItem := Items[List.IndexOf(Node) - 1].Index;
        end;
        Exit;
      end;
    VK_DOWN:
      if ssCtrl in Shift then
      begin
        with Node.Parent do
        begin
          if List.Last = Node then MessageBeep(0)
          else SelectedItem := Items[List.IndexOf(Node) + 1].Index;
        end;
        Exit;
      end;
  end;
  SelectedItem := FRootNode.GetVisibleNode(Row + 1).Index;
end;

procedure TCustomOutline.DblClick;
var
  Node: TOutlineNode;
begin
  inherited DblClick;
  Node := FSelectedItem;
  if Node <> FRootNode then DoExpand(Node);
end;

procedure TCustomOutline.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  ResetSelectedItem;
  GetSelectedItem;
end;

procedure TCustomOutline.FullExpand;
begin
  FRootNode.FullExpand;
end;

procedure TCustomOutline.FullCollapse;
var
  I: Integer;
begin
  for I := 0 to FRootNode.List.Count - 1 do
    FRootNode.Items[I].Expanded := False;
end;

procedure TCustomOutline.SetHorzScrollBar;
begin
  if (ScrollBars in [ssHorizontal, ssBoth]) and
    (UpdateCount <= 0) and not FIgnoreScrollResize and
    not ((Style = otOwnerDraw) and Assigned(FOnDrawItem)) then
    SetDisplayWidth(FRootNode.GetMaxDisplayWidth(0));
end;

procedure TCustomOutline.DoExpand(Node: TOutlineNode);
begin
  with Node do
    Expanded := not Expanded;
end;

procedure TCustomOutline.BeginUpdate;
begin
  if UpdateCount = 0 then SetUpdateState(True);
  Inc(UpdateCount);
end;

procedure TCustomOutline.EndUpdate;
begin
  Dec(UpdateCount);
  if UpdateCount = 0 then SetUpdateState(False);
end;

procedure TCustomOutline.SetUpdateState(Value: Boolean);
begin
  if FBlockInsert <> Value then
  begin
    FBlockInsert := Value;
    if not FBlockInsert then
    begin
      if ResizeGrid then Invalidate;
      if FRootNode.List.Count > 0 then
        TOutlineNode(FRootNode.List.First).SetGoodIndex
      else
        FRootNode.SetGoodIndex;
      SetHorzScrollBar;
    end;
  end;
end;

function TCustomOutline.ResizeGrid: Boolean;
var
  OldRowCount: LongInt;
begin
  Result := False;
  if not FBlockInsert then
  begin
    OldRowCount := RowCount;
    FSettingHeight := True;
    try
      RowCount := FRootNode.ExpandCount;
    finally
      FSettingHeight := False;
    end;
    Result := RowCount <> OldRowCount;
    if FSelectedItem <> FRootNode then SelectedItem := FSelectedItem.Index;
  end;
end;

function TCustomOutline.BadIndex(Value: TOutlineNode): Boolean;
begin
  Result := CompareNodes(Value, FGoodNode) = ocGreater;
end;

function TCustomOutline.SetGoodIndex(Value: TOutlineNode): TOutlineNode;
var
  ParentNode: TOutlineNode;
  Index: Integer;
  Compare: TOutlineNodeCompare;
begin
  Compare := CompareNodes(FGoodNode, Value);

  case Compare of
    ocLess,
    ocSame:
      Result := FGoodNode;
    ocGreater:
      begin
        ParentNode := Value.Parent;
        Index := ParentNode.List.IndexOf(Value);
        if Index <> 0 then
          Result := ParentNode[Index - 1]
        else
          Result := ParentNode;
      end;
    ocInvalid:
      Result := FRootNode;
  else
    Result := FRootNode;    
  end;

  FGoodNode := Result;
end;

function TCustomOutline.CompareNodes(Value1, Value2: TOutlineNode): TOutlineNodeCompare;
var
  Level1: Integer;
  Level2: Integer;
  Index1: Integer;
  Index2: Integer;
  Value1ParentNode: TOutlineNode;
  Value2ParentNode: TOutlineNode;
  CommonNode: TOutlineNode;

  function GetParentNodeAtLevel(Value: TOutlineNode; Level: Integer): TOutlineNode;
  begin
    while Level > 0 do
    begin
      Value := Value.Parent;
      Dec(Level);
    end;
  Result := Value;
  end;

begin
  if Value1 = Value2 then
  begin
    Result := ocSame;
    Exit;
  end;

  Value1ParentNode := Value1;
  Value2ParentNode := Value2;

  Level1 := Value1.GetLevel;
  Level2 := Value2.GetLevel;

  if Level1 > Level2 then
    Value1ParentNode := GetParentNodeAtLevel(Value1, Level1 - Level2)
  else if Level2 > Level1 then
    Value2ParentNode := GetParentNodeAtLevel(Value2, Level2 - Level1);

  while Value1ParentNode.Parent <> Value2ParentNode.Parent do
  begin
    Value1ParentNode := Value1ParentNode.Parent;
    Value2ParentNode := Value2ParentNode.Parent;
  end;

  CommonNode := Value1ParentNode.Parent;
  if CommonNode <> nil then
  begin
    Index1 := CommonNode.List.IndexOf(Value1ParentNode);
    Index2 := CommonNode.List.IndexOf(Value2ParentNode);
    if Index1 < Index2 then Result := ocLess
    else if Index2 < Index1 then Result := ocGreater
    else begin
      if Level1 > Level2 then Result := ocGreater
      else if Level1 = Level2 then Result := ocSame
      else Result := ocLess;
    end
  end
  else
    Result := ocInvalid;
end;

function TCustomOutline.GetDataItem(Value: Pointer): Longint;
begin
  Result := FRootNode.GetDataItem(Value);
end;

function TCustomOutline.GetItem(X, Y: Integer): LongInt;
var
  Value: TGridCoord;
begin
  Result := -1;
  Value := MouseCoord(X, Y);
  with Value do
   if (Y > 0) or (FRootNode.List.Count > 0) then
     Result := FRootNode.GetVisibleNode(Y + 1).Index;
end;

function TCustomOutline.GetTextItem(const Value: string): Longint;
begin
  Result := FRootNode.GetTextItem(Value);
end;

procedure TCustomOutline.SetCurItem(Value: LongInt);
begin
  if Value < 0 then Error(SInvalidCurrentItem);
  if not IsCurItem(Value) then
    try