[CJB]: This script is an example for a BWidget NoteBook that allows dragging and dropping widgets between pages. Click on the "Child" labels and drag them to a NoteBook label or frame or back to their original location. ---- ====== package require Tk 8.5 package require BWidget 1.9 #Create main widgets. set m [MainFrame .m] set p [PanedWindow [$m getframe].p] set f [frame [$p add].f];#Side frame set n [NoteBook [$p add].n] pack $m -fill both -expand 1 pack $p -fill both -expand 1 pack $f -fill both -expand 1 pack $n -fill both -expand 1 $n bindtabs [list TabPress %W %x] #DnD Target binds $n bindtabs <> [list ChildDrop %d] bind DropTarget <> [list ChildDrop %d %W] bindtags $f [linsert [bindtags $f] 1 DropTarget] #Tab creation foreach tab [list First Second Third] { $n insert end $tab -text $tab $n itemconfigure $tab -background #c0c0ff -activebackground #c0ffc0 set w [$n getframe $tab] $w configure -background bisque bindtags $w [linsert [bindtags $w] 1 DropTarget] } $n raise [$n pages 0] #DnD Source binds bind DropSource [list ChildButtonPress %W] bind DropSource [list ChildButtonRelease %W %X %Y %x %y] bind DropSource [list ChildMotion %W %X %Y %x %y] #DnD Source Creation foreach text [list "Child A" "Child B" "Child C" "Child D" "Child E"] { set w $p.[string map {{ } _} [string tolower $text]] label $w -text $text -background lightgray bindtags $w [linsert [bindtags $w] 1 DropSource ] pack $w -in $f -fill x } #Sets "active" widget and colors it green. proc ChildButtonPress {w} { variable active $w $w configure -background green } #Generates a <> event on the underlying widget #Needs to generate another event first for the NoteBook to trigger correctly. #In this case we use an event. (Probably not needed in concurrency with ChildMotion) #The child will be colored red if an error occurs. proc ChildButtonRelease {W X Y x y } { variable active variable n if {[info exists active]} { set z [winfo containing $X $Y] $W configure -background red catch { set x [expr {$X - [winfo rootx $n.c]}] set y [expr {$Y - [winfo rooty $n.c]}] #Needs a primary event to allow correct trigger on virtual event. event generate $z -x $x -y $y event generate $z <> -x $x -y $y -data $W $W configure -background lightgray } m o if {[dict get $o -code] != 0} {puts stderr $m} unset -nocomplain active } } #Passes events to underlying widgets while dragging children. proc ChildMotion {W X Y x y} { set w [winfo containing $X $Y] if {$w ne $W} { set x [expr {$X - [winfo rootx $w]}] set y [expr {$Y - [winfo rooty $w]}] event generate $w -x $x -y $y } } #If the child is dropped on a frame, it is packed inside the frame. #If the child is dropped on a notebook tab, it is packed inside the frame for that tab. #Must be valid or will likely cause an error. proc ChildDrop {child frame_or_tab} { variable n puts "ChildDrop: $child -> $frame_or_tab" if {[winfo exists $frame_or_tab]} { pack $child -in $frame_or_tab } else { pack $child -in [$n getframe $frame_or_tab] } raise $child } #Fixes a glitch where clicking on the tab label sets the tab to inactive. #Mostly a cosmetic fix for active coloring behavior. proc TabPress {W x tab} { event generate $W -x $x -y 2 } #Utility for debugging binds/traces proc print {args} {puts $args} bind all {console show} ====== ---- <> Widget