DN468836422

Subject: a poor man's drag and drop (was Re: Mouse Bindings on Windows) (longish) - DN [1]

Bryan Oakley <oakley@channelpoint.com> - 20 Apr 1999 - comp.lang.tcl

 > #ROHIT DUGAR# wrote:
 >
 > Hi All,
 >
 > I want to bind mouse motions to a widget in such a way that when the
 > user has held down the right mouse button (button-3) and he enters the
 > widget, the action should perform.
 >
 > bind .b <Enter> {
 > puts "I am Invincible"
 > }
 >
 > does not work if the user enters the button 'b' with the right button
 > pressed untill the user releases the right button. Is there a binding
 > which would get executed when the right mouse button is held down, the
 > mouse enters .b and the action (puts "I am Invincible" ) occurs.
 >

 The way bindings work, as long as a button is pressed, the widget that
 handles the press event is the only widget that sees the motion event
 (someobody correct me if I'm wrong or if it's slightly more complex than
 that).

 But, you can use this to your advantage. Remember that you can get the
 absolute (root) x and y coordinates of the mouse with your event. And we
 have the command [winfo containing], which tells us which widget
 "contains" this x,y position. So, your command that handles the motion
 can modify the appearance of widgets that it moves over, or perhaps send
 them events to process (such as <<DragEnter>>, for example).

 Here's a quick hack I just threw together to illustrate the
 possibilities. The example is contrived and hard-coded for some specific
 widgets, but you can see the general idea.

     catch {destroy .l1 .l2 .reset}

     label .l1 \
         -text "Right-click and drag this label..." \
         -bd 2 \
         -padx 10 \
         -relief groove \
         -height 4
     pack .l1 -fill x -pady 10

     label .l2 \
         -text "... and drag it over this label" \
         -bd 2 \
         -padx 10 \
         -relief groove \
         -height 4
     pack .l2 -fill x -pady 10

     bind .l1 <ButtonPress-3>   [list drag start %W]
     bind .l1 <Motion>          [list drag motion %X %Y]
     bind .l1 <ButtonRelease-3> [list drag stop %X %Y]

     bind .l2 <<DragOver>>      [list drag over %W]
     bind .l2 <<DragLeave>>     [list drag leave %W]
     bind .l2 <<DragDrop>>      [list drag drop  %W]

     button .reset -text "Reset" -command {
     .l2 configure \
         -foreground black \
         -text "... and drag it over this label"
     }
     pack .reset

     proc drag {command args} {
     global _dragging
     global _lastwidget
     global _dragwidget

     switch $command {
         init {
         # one-time code to initialize variables
         set _lastwidget {}
         set _dragging 0
         }

         start {
         set w [lindex $args 0]
         set _dragging 1
         set _lastwidget $w
         set _dragwidget $w
         $w configure -cursor gobbler
         }

         motion {
         if {!$_dragging} {return}

         set x [lindex $args 0]
         set y [lindex $args 1]
         set w [winfo containing $x $y]
         if {$w != $_lastwidget && [winfo exists $_lastwidget]} {
             event generate $_lastwidget <<DragLeave>>
         }
         set _lastwidget $w
         if {[winfo exists $w]} {
             event generate $w <<DragOver>>
         }
         if {$w == ".l2"}  {
             $_dragwidget configure -cursor gumby
         } else {
             $_dragwidget  configure -cursor gobbler
         }
         }

         stop {
         if {!$_dragging} {return}
         set x [lindex $args 0]
         set y [lindex $args 1]
         set w [winfo containing $x $y]
         if {[winfo exists $w]} {
             event generate $w <<DragLeave>>
             event generate $w <<DragDrop>>
         }
         set _dragging 0
         $_dragwidget configure -cursor {}
         }

         over {
         if {!$_dragging} {return}
         set w [lindex $args 0]
         $w configure -relief raised
         }

         leave {
         if {!$_dragging} {return}
         set w [lindex $args 0]
         $w configure -relief groove
         $w configure -cursor {}
         }

         drop {
         set w [lindex $args 0]
         $w configure -foreground red -text "THUD!!!"
         }
     }
     }

     drag init

 (this was tested on an NT box; I assume it works just fine on Unix and
 probably ought to work ok on the mac, too).

 --
 Bryan Oakley            mailto:oakley@channelpoint.com
 ChannelPoint, Inc.        http://purl.oclc.org/net/oakley