mmoutline.pas

一套及时通讯的原码

  end;
  try
    if IsCurItem(Index) then CurrentNode := FCurItem
    else
      try
        CurrentNode := FRootNode.GetNodeAtIndex(Index);
      except
        on OutlineError do Error(SOutlineIndexError);
      end;

    if AttachMode = oaAdd then
    begin
      CurrentNode := CurrentNode.Parent;
      if CurrentNode = nil then Error(SOutlineError);
      AttachMode := oaAddChild;
    end;

    with CurrentNode do
    begin
      case AttachMode of
        oaInsert: Result := Parent.InsertNode(Index, NewNode);
        oaAddChild:
          begin
             if GetLevel > MaxLevels then Error(SOutlineMaxLevels);
             Result := AddNode(NewNode);
          end;
      end;
    end;
    if ResizeGrid then Invalidate;
  except
    NewNode.Destroy;
    Application.HandleException(Self);
  end;
end;

function TMMCustomOutline.Get(Index: LongInt): TOutlineNode;
begin
  if IsCurItem(Index) then Result := FCurItem
  else
    try
      Result := FRootNode.GetNodeAtIndex(Index);
    except
      on OutlineError do Error(SOutlineIndexError);
    end;
  if Result = FRootNode then Error(SOutlineError);
end;

function TMMCustomOutline.GetSelectedItem: LongInt;
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 TMMCustomOutline.ResetSelectedItem;
begin
  FSelectedItem := FRootNode;
end;

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

procedure TMMCustomOutline.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
    if Value = FSelectedItem.Index then Node := FSelectedItem else
    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 TMMCustomOutline.Insert(Index: LongInt; const Text: string): LongInt;
begin
  Result := InsertObject(Index, Text, nil);
end;

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

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

function TMMCustomOutline.AddObject(Index: LongInt; const Text: string; const Data: Pointer): LongInt;
begin
  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 TMMCustomOutline.AddChild(Index: LongInt; const Text: string): LongInt;
begin
  Result := AddChildObject(Index, Text, nil);
end;

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

procedure TMMCustomOutline.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 TMMCustomOutline.Move(Destination, Source: LongInt; AttachMode: TAttachMode);
begin
  if (AttachMode = oaAddChild) or (Destination > 0) then
    MoveNode(Destination, Source, AttachMode)
  else Error(SOutlineError);
end;

procedure TMMCustomOutline.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 TMMCustomOutline.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 TMMCustomOutline.Click;
begin
  if FRootNode.List.Count > 0 then
    SelectedItem := FRootNode.GetVisibleNode(Row + 1).Index;
  inherited Click;
end;

procedure TMMCustomOutline.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 TMMCustomOutline.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 TMMCustomOutline.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 TMMCustomOutline.DblClick;
var
  Node: TOutlineNode;
begin
  inherited DblClick;
  Node := FSelectedItem;
  if Node <> FRootNode then DoExpand(Node);
end;

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

procedure TMMCustomOutline.FullExpand;
begin
  FRootNode.FullExpand;
end;

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

procedure TMMCustomOutline.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 TMMCustomOutline.DoExpand(Node: TOutlineNode);
begin
  with Node do
    Expanded := not Expanded;
end;

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

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

procedure TMMCustomOutline.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 TMMCustomOutline.ResizeGrid: Boolean;
var
  i: integer;
  OldRowCount: LongInt;
begin
  Result := False;
  if not FBlockInsert then
  begin
    OldRowCount := RowCount;
    FSettingHeight := True;
    try
      i := FRootNode.ExpandCount;
      RowCount := i;

      if (i > 0) then
      for i := 0 to RowCount-1 do
      begin
         if GetVisibleNode(i).HasItems then
            RowHeights[i] := FItemHeight
         else
            RowHeights[i] := FChildItemHeight;
      end;

    finally
      FSettingHeight := False;
    end;
    Result := RowCount <> OldRowCount;
    if FSelectedItem <> FRootNode then SelectedItem := FSelectedItem.Index;
  end;
end;

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

function TMMCustomOutline.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;
  end;

  FGoodNode := Result;
end;

function TMMCustomOutline.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