treevwex.pas

delphi编程控件

    result := CanEdit(Node);
  if result and Node.HasChildren then
    for i := 0 to Node.Count - 1 do
    begin
      result := CanDelete(Node.Item[i]);
      if not result then
        exit;
    end;
end;

function TCustomTreeViewEx.DoDelete(Node: TTreeNode): Boolean;
begin
  Items.Delete(Node);
  result := true;
end;

function TCustomTreeViewEx.GetDeleteQuestion(Node: TTreeNode): string;
begin
  if (Node <> nil) and (Pos('%s', stveDefaultDeleteQuestion) > 0) then
    result := Format(stveDefaultDeleteQuestion, [Node.Text])
  else
    result := stveDefaultDeleteQuestion;
end;

function TCustomTreeViewEx.ShowDeletePrompt(Node: TTreeNode;
  var DeleteAll: Boolean; ShowDeleteAllButton: Boolean): Boolean;
const
  mb: array[boolean] of TMsgDlgButtons =
    ([mbOK, mbCancel], [mbOK, mbCancel, mbAll]);
var
  Msg: Integer;
begin
  Result := DeleteAll or not (tveConfirmDelete in Options);
  if Result then
    DeleteAll := true
  else
  begin
    Msg := MessageDlg(GetDeleteQuestion(Node),
                      mtConfirmation, mb[ShowDeleteAllButton], 0);
    if (Msg = mrOk) then
      Result := true
    else
      if (Msg = mrAll) then
      begin
        Result := true;
        DeleteAll := true;
      end;
  end;
end;

procedure TCustomTreeViewEx.InternalDeleteNode(Node: TTreeNode;
  AskForDeleteAll: Boolean; var DeleteAll, Canceled: Boolean);
var
  i: Integer;
  OldSelected: TTreeNode;
  NewSelected: TTreeNode;
begin
  if Canceled or (Node = nil) then
    exit;
  if Node.HasChildren then
    for i := Node.Count - 1 downto 0 do
    begin
      InternalDeleteNode(Node.Item[i], AskForDeleteAll, DeleteAll, Canceled);
      if Canceled then
        exit;
    end;
  if (Node = Selected) then
  begin
    if (Node.GetNextSibling <> nil) then
      NewSelected := Node.GetNextSibling
    else
      if (Node.GetPrevSibling <> nil) then
        NewSelected := Node.GetPrevSibling
      else
        if (Node.Parent <> nil) then
          NewSelected := Node.Parent
        else
          NewSelected := nil;
  end
  else
    NewSelected := Selected;
  OldSelected := Selected;
  Selected := Node;
  Canceled := not ShowDeletePrompt(Node, DeleteAll, AskForDeleteAll);
  if not Canceled then
  begin
    DoDelete(Node);
    if (NewSelected <> nil) then
      Selected := NewSelected;
  end
  else
    if (OldSelected <> nil) then
      Selected := OldSelected;
end;

procedure TCustomTreeViewEx.DeleteNode(Node: TTreeNode);
var
  AskForDeleteAll: Boolean;
  DeleteAll: Boolean;
  Canceled: Boolean;
begin
  if not CanDelete(Node) then
    exit;
  AskForDeleteAll := Node.HasChildren;
  DeleteAll := false;
  Canceled := false;
  InternalDeleteNode(Node, AskForDeleteAll, DeleteAll, Canceled);
end;

function TCustomTreeViewEx.CanEdit(Node: TTreeNode): Boolean;
begin
  KillAllTimer;
  if ReadOnly or ((tveRootItemReadOnly in Options) and IsRootNode(Node)) then
    Result := false
  else
    Result := inherited CanEdit(Node);
end;

function TCustomTreeViewEx.DragAllowed(Node: TTreeNode): Boolean;
begin
  Inc(FDisableCount);
  try
    result := CanEdit(Node) and not IsSingleRootNode(Node);
  finally
    Dec(FDisableCount);
  end;
end;

{$HINTS OFF}
procedure TCustomTreeViewEx.Insert(AsChild: Boolean);
var
  NewNode: TTreeNode;
begin
  KillAllTimer;
  Inc(FDisableCount);
  try
    if AsChild and (Selected <> nil) then
      NewNode := Items.AddChild(Selected, '')
    else
      NewNode := Items.Insert(Selected, '');
    if (NewNode <> nil) then
    begin
      if Focused then
        NewNode.EditText;
    end;
  finally
    Dec(FDisableCount);
  end;
end;
{$HINTS ON}

procedure TCustomTreeViewEx.Delete;
begin
  KillAllTimer;
  DeleteNode(Selected);
end;

procedure TCustomTreeViewEx.KeyDown(var Key: Word; Shift: TShiftState);
begin
  KillAllTimer;
  inherited KeyDown(Key, Shift);
  case Key of
    VK_INSERT:
      if (tveAllowInsert in Options) and (not IsEditing) and
         (not ReadOnly) then
      begin
        if (tveInsertAsChild in Options) then
          Insert(true)
        else
          Insert((ssShift in Shift) or (ssCtrl in Shift));
        Key := 0;
      end;
    VK_DELETE:
      if (tveAllowDelete in Options) and (not IsEditing) and
         (not ReadOnly) then
      begin
        Delete;
        Key := 0;
      end;
  end;
end;

procedure TCustomTreeViewEx.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  HT: THitTests;
begin
  if (ssDouble in Shift) then
  begin
    if (FMouseSelectTimer <> 0) then
    begin
      KillTimer(Handle, TimerIDMouseSelect);
      FMouseSelectTimer := 0;
    end;
    Include(FState, tvesMouseStillDownAfterDoubleClick);
    inherited;
    exit;
  end;
  if (Button = mbLeft) then
    FLMouseDownTickCount := GetTickCount;
  inherited;
  if (Button = mbLeft) then
  begin
      if (not Dragging) and (Selected <> nil) and
         (GetNodeAt(X, Y) = Selected) then
      begin
        if (tveAutoDragMove in Options) and DragAllowed(Selected) then
          BeginDrag(False);
        if Assigned(FOnMouseSelect) and
           (not (tveMouseMoveSelect in FOptions)) and
           (not (ssDouble in Shift)) then
        begin
          HT := GetHitTestInfoAt(X, Y);
          if (HT - [htOnItem {, htOnIcon, htOnIndent, htOnRight}] <> HT) then
          begin
            if not Selected.HasChildren then
              FOnMouseSelect(self)
            else
            { maybe it becomes a doubleclick, wait a little bit: }
              if (FMouseSelectTimer = 0) then
                FMouseSelectTimer :=
                  SetTimer(Handle, TimerIDMouseSelect,
                    GetDoubleClickTime - (GetTickCount - FLMouseDownTickCount),
                    nil);
          end;
        end;
      end;
  end;
end;

procedure TCustomTreeViewEx.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Node: TTreeNode;
  XInClientRect, YInClientRect: Integer;
function NodeLineFullVisible(Node: TTreeNode): Boolean;
var
  NodeRect: TRect;
begin
  NodeRect := Node.DisplayRect(false);
  result := (NodeRect.Top >= 0) and (NodeRect.Bottom <= ClientHeight);
end;
begin
  inherited MouseMove(Shift, X, Y);
  if (tveMouseMoveSelect in FOptions) or Dragging then
  begin
    if (ssLeft in Shift) then
    begin
      if (Y < 1) then
        YInClientRect := 1
      else
        if (Y >= ClientHeight) then
          YInClientRect := ClientHeight - 1
        else
          YInClientRect := Y;
      if (X < 1) then
        XInClientRect := 1
      else
        if (X >= ClientWidth) then
          XInClientRect := ClientWidth - 1
        else
          XInClientRect := X;
      Node := GetNodeAt(XInClientRect, YInClientRect);
      if (Node <> nil) then
      begin
        DoScroll(Node, X, Y);
        try
          Node := GetNodeAt(XInClientRect, YInClientRect);
        except
          Node := nil;
        end;
      end;
    end
    else
      Node := GetNodeAt(X, Y);
    if (Node <> nil) and NodeLineFullVisible(Node) then
    begin
      Node.MakeVisible;
      if not Dragging then
        Selected := Node;
    end;
  end;
end;

procedure TCustomTreeViewEx.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  HT: THitTests;
  DeltaMouseDownTickCount: Integer;

procedure StartMouseSelect;
begin
  if not Selected.HasChildren then
    FOnMouseSelect(self)
  else
  { maybe it becomes a doubleclick, wait a little bit: }
    if (FMouseSelectTimer = 0) then
      FMouseSelectTimer :=
        SetTimer(Handle, TimerIDMouseSelect,
                 GetDoubleClickTime - DeltaMouseDownTickCount, nil);
end;

begin { MouseUp }
  if (FScrollTimer <> 0) then
  begin
    KillTimer(Handle, TimerIDScroll);
    FScrollTimer := 0;
  end;
  inherited MouseUp(Button, Shift, X, Y);
  if (tvesMouseStillDownAfterDoubleClick in FState) then
    Exclude(FState, tvesMouseStillDownAfterDoubleClick)
  else
  begin
      if (Button = mbLeft) then
      begin
        if (not Dragging) and (Selected <> nil) and
           (GetNodeAt(X, Y) = Selected) then
        begin
          DeltaMouseDownTickCount := (GetTickCount - FLMouseDownTickCount);
          if (DeltaMouseDownTickCount < GetDoubleClickTime) and
             Assigned(FOnMouseSelect) then
          begin
            HT := GetHitTestInfoAt(X, Y);
            if (tveMouseMoveSelect in FOptions) then
            begin
            { MouseSelect if not hit on Icon or Indent: }
              if (HT - [htOnItem {, htOnIcon, htOnIndent}, htOnRight] <>
                  HT) then
                StartMouseSelect;
            end
            else
            begin
            { MouseSelect on direct hit only: }
              if (HT - [htOnItem {, htOnIcon, htOnIndent, htOnRight}] <>
                  HT) then
                StartMouseSelect;
            end;
          end;
        end;
      end;
  end;
end;

procedure TCustomTreeViewEx.WMTimer(var Msg: TWMTimer);
var
  Node: TTreeNode;
  P: TPoint;
begin
  case Msg.TimerID of
    TimerIDScroll:
      begin
        KillTimer(Handle, TimerIDScroll);
        FScrollTimer := 0;
        GetCursorPos(P);
        with ScreenToClient(P) do
        begin
          if (Y < 1) then
            Y := 1
          else
            if (Y >= ClientHeight) then
              Y := ClientHeight - 1;
          if (X < 1) then
            X := 1
          else
            if (X >= ClientWidth) then
              X := ClientWidth - 1;
          Node := GetNodeAt(X, Y);
          if (Node <> nil) then
          begin
            with ScreenToClient(P) do
              DoScroll(Node, X, Y);
            if (tveMouseMoveSelect in FOptions) or Dragging then
            begin
              Node := GetNodeAt(X, Y);
              if (Node <> nil) then
              begin
                Node.MakeVisible;
                if (tveMouseMoveSelect in FOptions) then
                  Selected := Node;
              end;
            end;
          end;
        end;
      end;
    TimerIDMouseSelect:
      begin
        KillTimer(Handle, TimerIDMouseSelect);
        FMouseSelectTimer := 0;