treevwex.pas

delphi编程控件

        FOnMouseSelect(self);
      end;
    else
      inherited;
  end; { case }
end;


var
  LastDragSource: TDragObject = nil;

procedure TCustomTreeViewEx.DoScroll(Node: TTreeNode; MouseX, MouseY: Integer);
var
  TickCount: Integer;
  P: TPoint;
begin
  if (Node <> nil) then
  begin
  { UP: }
    if {(not Dragging and (MouseY < 0)) or}
       ((MouseY < DragScrollBorder) and
        ((MouseY >= 0) or
         ((LastDragSource = nil) and (MouseY > -DragScrollBorder)))) then
    begin
      TickCount := GetTickCount;
      if ((TickCount - FDragScrollTickCount) >= DoNextScrollTickCount) then
      begin
        Node := Node.GetPrevVisible;
        if (Node <> nil) then
        begin
          FDragScrollTickCount := TickCount;
          if (LastDragSource <> nil) then
            LastDragSource.HideDragImage;
          Node.MakeVisible;
          if (LastDragSource <> nil) then
          begin
            LastDragSource.ShowDragImage;
            Windows.GetCursorPos(P);
            Windows.SetCursorPos(P.X, P.Y);
          end;
          if (FScrollTimer = 0) then
            FScrollTimer := SetTimer(Handle, TimerIDScroll,
                                     DoNextScrollTickCount, nil);
        end;
      end;
      exit;
    end;
  { Down: }
    if {(not Dragging and (MouseY > ClientHeight)) or}
       ((MouseY > (ClientHeight - DragScrollBorder)) and
        ((MouseY <= ClientHeight) or
         ((LastDragSource = nil) and
          (MouseY < (ClientHeight + DragScrollBorder))))) then
    begin
      TickCount := GetTickCount;
      if ((TickCount - FDragScrollTickCount) >= DoNextScrollTickCount) then
      begin
        Node := Node.GetNextVisible;
        if (Node <> nil) then
        begin
          FDragScrollTickCount := TickCount;
          if (LastDragSource <> nil) then
            LastDragSource.HideDragImage;
          Node.MakeVisible;
          if (LastDragSource <> nil) then
          begin
            LastDragSource.ShowDragImage;
            (*
            with WMMouse do
            begin
              Msg := WM_MOUSEMOVE;
              Keys := 0;
              Result := 0;
              Pos.X := MouseX;
              Pos.Y := MouseY;
            end;
            LastDragSource.MouseMsg(WMMouse); private >:-(
            *)
            Windows.GetCursorPos(P);
            Windows.SetCursorPos(P.X, P.Y);
          end;
          if (FScrollTimer = 0) then
            FScrollTimer := SetTimer(Handle, TimerIDScroll,
                                     DoNextScrollTickCount, nil);
        end;
      end;
      exit;
    end;
  end;
end;

procedure TCustomTreeViewEx.CMDrag(var Message: TCMDrag);
var
  PossibleDrop: Boolean;
begin
  inherited;
  with Message, DragRec^ do
  begin
    PossibleDrop := (Result <> 0);
    if (DragMessage = dmDragMove) then
      with ScreenToClient(Pos) do DoDragOver(Source, X, Y, PossibleDrop);
    if FDontAcceptLastPossibleDropTarget or
       (DragMessage = dmDragDrop) or (DragMessage = dmDragLeave) or
       ((DragMessage = dmDragMove) and not PossibleDrop) then
    begin
      if (FLastPossibleDropTarget <> nil) then
      begin
        FLastPossibleDropTarget.DropTarget := false;
        FLastPossibleDropTarget := nil;
      end;
      FLastPossibleDropTarget := nil;
//      if PossibleDrop and FDontAcceptLastPossibleDropTarget then
//        Selected.DropTarget := true;
    end;
    if (DragMessage = dmDragDrop) or (DragMessage = dmDragLeave) then
      LastDragSource := nil
    else
      LastDragSource := Source;
  end;
end;

procedure TCustomTreeViewEx.DoDragOver(Source: TDragObject; X, Y: Integer;
  PossibleDrop: Boolean);
var
  Node: TTreeNode;
begin
  Node := GetNodeAt(X, Y);
  if (Node <> nil) then
  begin
    if PossibleDrop then
      if (Node.DropTarget) then
        FLastPossibleDropTarget := Node
      else
        FLastPossibleDropTarget := nil;
    DoScroll(Node, X, Y);
  end;
end;

function TCustomTreeViewEx.MultipleRootsAllowed: Boolean;
begin
  result := (tveMultipleRootsAllowed in Options);
end;

procedure TCustomTreeViewEx.DragOver(Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
var
  DestinationNode: TTreeNode;
  HT: THitTests;
begin
  FDontAcceptLastPossibleDropTarget := false;
  inherited;
  DestinationNode := GetNodeAt(X, Y);
(*
  if (DestinationNode <> nil) then
  { do little scrolling if half-shown: }
    DestinationNode.MakeVisible;
*)
  if Assigned(OnDragOver) and not Accept then
  { Accept was set to false on event OnDragOver }
    exit;
  if not (tveAutoDragMove in Options) then
  { we are not responible for dragging-things }
    exit;
  if (Source <> self) then
  { that has to be done by decentant.DragOver or by OnDragOver. }
    exit;
{ At this point, we know that Selected is the node that gets dragged.
  Maybe DestinationNode is the target:
  We will test this with GetHitTestInfoAt(X, Y). }
  Accept := false;
  if (Selected = nil) then
  { error: should not happen here }
    exit;
  if ReadOnly then
  { error: should not happen here }
    exit;
  if MultipleRootsAllowed and not IsRootNode(Selected) then
  begin
  { Node could become another root:
    Accept if the dragged node does not touch another node: }
    if (DestinationNode = nil) then
    begin
      FDontAcceptLastPossibleDropTarget := true;
      Accept := true;
      exit;
    end;
    HT := GetHitTestInfoAt(X, Y);
    if (HT - [htOnIndent] <> HT) then
    begin
      FDontAcceptLastPossibleDropTarget := true;
      Accept := true;
      exit;
    end;
  end;
  if (DestinationNode <> nil) and (DestinationNode <> Selected) and
     (Selected.Parent <> DestinationNode) and
     (not DestinationNode.HasAsParent(Selected)) then
  begin
    HT := GetHitTestInfoAt(X, Y);
    if (HT - [htOnItem, htOnIcon, {htOnIndent,} htOnRight] <> HT) then
    { DestinationNode is a candidate to get the new parent of the dragged node }
      Accept := true;
  end;
end;

procedure TCustomTreeViewEx.DragCanceled;
begin
  KillAllTimer;
  inherited;
  if (FLastPossibleDropTarget <> nil) then
  begin
    FLastPossibleDropTarget.DropTarget := false;
    FLastPossibleDropTarget := nil;
  end;
  if (Selected <> nil) then
    Selected.MakeVisible;
end;

procedure TCustomTreeViewEx.DragDrop(Source: TObject; X, Y: Integer);
var
  DestinationNode: TTreeNode;
  HT: THitTests;
begin
  KillAllTimer;
  if (Source <> self) or (Selected = nil) or
     not (tveAutoDragMove in Options) then
  begin
    inherited;
    exit;
  end;
  HT := GetHitTestInfoAt(X, Y);
  DestinationNode := GetNodeAt(X, Y);
  if (DestinationNode = nil) then
  begin
    if MultipleRootsAllowed and not IsRootNode(Selected) then
      MoveNode(Selected, nil, naAdd)
    else
      inherited;
    exit;
  end;
  if MultipleRootsAllowed and (htOnIndent in HT) and
     not IsRootNode(Selected) then
  begin
    MoveNode(Selected, nil, naAdd);
    exit;
  end;
  if (HT - [htOnItem, htOnIcon, {htNowhere, htOnIndent,} htOnRight] <> HT) then
  begin
    MoveNode(Selected, DestinationNode, naAddChild);
    exit;
  end;
  inherited;
end;

function TCustomTreeViewEx.MoveNode(Source, Destination: TTreeNode;
  Mode: TNodeAttachMode): Boolean;
begin
  Result := false;
  if (Source = nil) then
    exit;
  if not CanEdit(Source) then
    exit;
  Source.MoveTo(Destination, Mode);
{ Delphi 2.0: sometimes Source is vanished: }
{ bugfix part 1: }
  if (Destination <> nil) then
    Destination.HasChildren := true;
{ bugfix part 2: }
  Source.MakeVisible;
  Result := true;
end;

procedure TCustomTreeViewEx.WMChar(var Message: TWMKeyDown);
begin
  if (Char(Message.CharCode) in IgnoreWMChars) or
     (tvesIgnoreNextWMChar in FState) then
  begin
  { Message.Result := 1; }
    Message.CharCode := 0;
    Exclude(FState, tvesIgnoreNextWMChar);
  end
  else
    inherited;
end;

procedure TCustomTreeViewEx.WndProc(var Message: TMessage);
begin
  case Message.Msg of
    WM_KEYDOWN:
      if (TWMKeyDown(Message).CharCode = 27) and Dragging then
      begin
        CancelDrag;
        Include(FState, tvesIgnoreNextWMChar); { avoid beep }
        TWMKeyDown(Message).CharCode := 0;
      { Message.Result := 1; }
        exit;
      end;
    WM_RBUTTONDOWN:
      Include(FState, tvesRightButtonPressed);
    WM_KILLFOCUS:
      begin
        Exclude(FState, tvesRightButtonPressed); { no PopupMenu }
        if (tvesWaitingForPopupMenu in FState) then
        begin
          Exclude(FState, tvesWaitingForPopupMenu); { no PopupMenu anyway }
          Items.EndUpdate;
        end;
      end;
  end;
  inherited WndProc(Message);
end;

procedure TCustomTreeViewEx.CNNotify(var Message: TWMNotify);
var
  MousePos: TPoint;
  ClientMousePos: TPoint;
  NodeRect: TRect;
begin
  with Message.NMHdr^ do
    case code of
      TVN_BEGINRDRAG:
        begin
          Exclude(FState, tvesRightButtonPressed); { no PopupMenu }
          if (tvesWaitingForPopupMenu in FState) then
          begin
            Exclude(FState, tvesWaitingForPopupMenu); { no PopupMenu anyway }
            Items.EndUpdate;
          end;
        end;
      NM_RCLICK:
        begin
        { A Node received a WM_RBUTTONUP-message: }
          if (tvesWaitingForPopupMenu in FState) or
             (tvesRightButtonPressed in FState) then
          begin
          { Initialize start of PopupMenu: }
            GetCursorPos(MousePos);
            ClientMousePos := ScreenToClient(MousePos);
            with ClientMousePos do
              FRSelected := GetNodeAt(X, Y);
            if (FRSelected <> nil) then
            begin
            { Don't show PopupMenu at the middle of the node: }
              NodeRect := FRSelected.DisplayRect(false);
              ClientMousePos.Y := NodeRect.Bottom;
            end;
            with PointToSmallPoint(ClientMousePos) do
              Perform(WM_RBUTTONUP, 0, MakeLong(X, Y));
          end;
          exit; { don't give message to TTreeView.CNNotify }
        end;
      -12: { NM_??? (please send me a mail if you know what it is) }
        if (tvesRightButtonPressed in FState) then
        begin
        { A Node received a WM_RBUTTONUP-message and got the focus: }
          Exclude(FState, tvesRightButtonPressed); { do it only once }
          Include(FState, tvesWaitingForPopupMenu);
        { Now, maybe  the focused and the selected node are not the same.
          We will show this until the PopupMenu is visible: }
          Items.BeginUpdate; { make changes of the tree invisible }
        end;
    end;
  inherited;
end;

procedure TCustomTreeViewEx.WMRButtonUp(var Message: TWMRButtonUp);
begin
{ Calling inherited will show PopupMenu }
  if (tvesWaitingForPopupMenu in FState) then
  begin
  { Allow PopupMenu if initialized at CNNotify: }
    Exclude(FState, tvesWaitingForPopupMenu);
    Items.EndUpdate;
    inherited;
  end
  else
    if (tvesRightButtonPressed in FState) then
    { Allow PopupMenu if CNNotify was called with NM_RCLICK: }
      inherited;
  Exclude(FState, tvesRightButtonPressed);
end;



end.