home *** CD-ROM | disk | FTP | other *** search
/ PC World 2002 May / PCWorld_2002-05_cd.bin / Software / TemaCD / activetcltk / ActiveTcl8.3.4.1-8.win32-ix86.exe / ActiveTcl8.3.4.1-win32-ix86 / lib / bwidget1.3.0 / dragsite.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  6.4 KB  |  196 lines
  1. # ------------------------------------------------------------------------------
  2. #  dragsite.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: dragsite.tcl,v 1.6 2001/06/11 23:58:40 hobbs Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - DragSite::include
  8. #     - DragSite::setdrag
  9. #     - DragSite::register
  10. #     - DragSite::_begin_drag
  11. #     - DragSite::_init_drag
  12. #     - DragSite::_end_drag
  13. #     - DragSite::_update_operation
  14. # ------------------------------------------------------------------------------
  15.  
  16. namespace eval DragSite {
  17.     Widget::declare DragSite [list \
  18.         [list    -dragevent    Enum    1    0    [list 1 2 3]] \
  19.         [list    -draginitcmd    String    ""    0] \
  20.         [list    -dragendcmd    String    ""    0] \
  21.         ]
  22.  
  23.     variable _topw ".drag"
  24.     variable _tabops
  25.     variable _state
  26.     variable _x0
  27.     variable _y0
  28.  
  29.     bind BwDrag1 <ButtonPress-1> {DragSite::_begin_drag press  %W %s %X %Y}
  30.     bind BwDrag1 <B1-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
  31.     bind BwDrag2 <ButtonPress-2> {DragSite::_begin_drag press  %W %s %X %Y}
  32.     bind BwDrag2 <B2-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
  33.     bind BwDrag3 <ButtonPress-3> {DragSite::_begin_drag press  %W %s %X %Y}
  34.     bind BwDrag3 <B3-Motion>     {DragSite::_begin_drag motion %W %s %X %Y}
  35.  
  36.     proc use {} {}
  37. }
  38.  
  39.  
  40. # ------------------------------------------------------------------------------
  41. #  Command DragSite::include
  42. # ------------------------------------------------------------------------------
  43. proc DragSite::include { class type event } {
  44.     set dragoptions [list \
  45.         [list    -dragenabled    Boolean    0    0] \
  46.         [list    -draginitcmd    String    ""    0] \
  47.         [list    -dragendcmd    String    ""    0] \
  48.         [list    -dragtype    String    $type    0] \
  49.         [list    -dragevent    Enum    $event    0    [list 1 2 3]] \
  50.         ]
  51.     Widget::declare $class $dragoptions
  52. }
  53.  
  54.  
  55. # ------------------------------------------------------------------------------
  56. #  Command DragSite::setdrag
  57. #  Widget interface to register
  58. # ------------------------------------------------------------------------------
  59. proc DragSite::setdrag { path subpath initcmd endcmd {force 0}} {
  60.     set cen       [Widget::hasChanged $path -dragenabled en]
  61.     set cdragevt  [Widget::hasChanged $path -dragevent   dragevt]
  62.     if { $en } {
  63.         if { $force || $cen || $cdragevt } {
  64.             register $subpath \
  65.                 -draginitcmd $initcmd \
  66.                 -dragendcmd  $endcmd  \
  67.                 -dragevent   $dragevt
  68.         }
  69.     } else {
  70.         register $subpath
  71.     }
  72. }
  73.  
  74.  
  75. # ------------------------------------------------------------------------------
  76. #  Command DragSite::register
  77. # ------------------------------------------------------------------------------
  78. proc DragSite::register { path args } {
  79.     upvar \#0 DragSite::$path drag
  80.  
  81.     if { [info exists drag] } {
  82.         bind $path $drag(evt) {}
  83.         unset drag
  84.     }
  85.     Widget::init DragSite .drag$path $args
  86.     set event   [Widget::getMegawidgetOption .drag$path -dragevent]
  87.     set initcmd [Widget::getMegawidgetOption .drag$path -draginitcmd]
  88.     set endcmd  [Widget::getMegawidgetOption .drag$path -dragendcmd]
  89.     set tags    [bindtags $path]
  90.     set idx     [lsearch $tags "BwDrag*"]
  91.     Widget::destroy .drag$path
  92.     if { $initcmd != "" } {
  93.         if { $idx != -1 } {
  94.             bindtags $path [lreplace $tags $idx $idx BwDrag$event]
  95.         } else {
  96.             bindtags $path [concat $tags BwDrag$event]
  97.         }
  98.         set drag(initcmd) $initcmd
  99.         set drag(endcmd)  $endcmd
  100.         set drag(evt)     $event
  101.     } elseif { $idx != -1 } {
  102.         bindtags $path [lreplace $tags $idx $idx]
  103.     }
  104. }
  105.  
  106.  
  107. # ------------------------------------------------------------------------------
  108. #  Command DragSite::_begin_drag
  109. # ------------------------------------------------------------------------------
  110. proc DragSite::_begin_drag { event source state X Y } {
  111.     variable _x0
  112.     variable _y0
  113.     variable _state
  114.  
  115.     switch -- $event {
  116.         press {
  117.             set _x0    $X
  118.             set _y0    $Y
  119.             set _state "press"
  120.         }
  121.         motion {
  122.             if { ![info exists _state] } {
  123.                 # This is just extra protection. There seem to be
  124.                 # rare cases where the motion comes before the press.
  125.                 return
  126.             }
  127.             if { ![string compare $_state "press"] } {
  128.                 if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } {
  129.                     set _state "done"
  130.                     _init_drag $source $state $X $Y
  131.                 }
  132.             }
  133.         }
  134.     }
  135. }
  136.  
  137.  
  138. # ------------------------------------------------------------------------------
  139. #  Command DragSite::_init_drag
  140. # ------------------------------------------------------------------------------
  141. proc DragSite::_init_drag { source state X Y } {
  142.     variable _topw
  143.     upvar \#0 DragSite::$source drag
  144.  
  145.     destroy  $_topw
  146.     toplevel $_topw
  147.     wm withdraw $_topw
  148.     wm overrideredirect $_topw 1
  149.  
  150.     set info [uplevel \#0 $drag(initcmd) [list $source $X $Y .drag]]
  151.     if { $info != "" } {
  152.         set type [lindex $info 0]
  153.         set ops  [lindex $info 1]
  154.         set data [lindex $info 2]
  155.  
  156.         if { [winfo children $_topw] == "" } {
  157.             if { ![string compare $type "BITMAP"] || ![string compare $type "IMAGE"] } {
  158.                 label $_topw.l -image [Bitmap::get dragicon] -relief flat -bd 0
  159.             } else {
  160.                 label $_topw.l -image [Bitmap::get dragfile] -relief flat -bd 0
  161.             }
  162.             pack  $_topw.l
  163.         }
  164.         wm geometry $_topw +[expr {$X+1}]+[expr {$Y+1}]
  165.         wm deiconify $_topw
  166.         if {[catch {tkwait visibility $_topw}]} {
  167.             return
  168.         }
  169.         BWidget::grab  set $_topw
  170.         BWidget::focus set $_topw
  171.  
  172.         bindtags $_topw [list $_topw DragTop]
  173.         DropSite::_init_drag $_topw $drag(evt) $source $state $X $Y $type $ops $data
  174.     } else {
  175.         destroy $_topw
  176.     }
  177. }
  178.  
  179.  
  180. # ------------------------------------------------------------------------------
  181. #  Command DragSite::_end_drag
  182. # ------------------------------------------------------------------------------
  183. proc DragSite::_end_drag { source target op type data result } {
  184.     variable _topw
  185.     upvar \#0 DragSite::$source drag
  186.  
  187.     BWidget::grab  release $_topw
  188.     BWidget::focus release $_topw
  189.     destroy $_topw
  190.     if { $drag(endcmd) != "" } {
  191.         uplevel \#0 $drag(endcmd) [list $source $target $op $type $data $result]
  192.     }
  193. }
  194.  
  195.  
  196.