home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / dragsite.tcl < prev    next >
Text File  |  2000-11-02  |  6KB  |  190 lines
  1. # ------------------------------------------------------------------------------
  2. #  dragsite.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: dragsite.tcl,v 1.1.1.1 1996/02/22 06:05:55 daniel 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 {
  18.         {-dragevent     Enum   1  0 {1 2 3}}
  19.         {-draginitcmd   String "" 0}
  20.         {-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 {
  45.         {-dragenabled Boolean 0  0}
  46.         {-draginitcmd String  "" 0}
  47.         {-dragendcmd  String  "" 0}
  48.     }
  49.     lappend dragoptions \
  50.         [list -dragtype  String $type  0] \
  51.         [list -dragevent Enum   $event 0 {1 2 3}]
  52.     Widget::declare $class $dragoptions
  53. }
  54.  
  55.  
  56. # ------------------------------------------------------------------------------
  57. #  Command DragSite::setdrag
  58. #  Widget interface to register
  59. # ------------------------------------------------------------------------------
  60. proc DragSite::setdrag { path subpath initcmd endcmd {force 0}} {
  61.     set cen       [Widget::hasChanged $path -dragenabled en]
  62.     set cdragevt  [Widget::hasChanged $path -dragevent   dragevt]
  63.     if { $en } {
  64.         if { $force || $cen || $cdragevt } {
  65.             register $subpath \
  66.                 -draginitcmd $initcmd \
  67.                 -dragendcmd  $endcmd  \
  68.                 -dragevent   $dragevt
  69.         }
  70.     } else {
  71.         register $subpath
  72.     }
  73. }
  74.  
  75.  
  76. # ------------------------------------------------------------------------------
  77. #  Command DragSite::register
  78. # ------------------------------------------------------------------------------
  79. proc DragSite::register { path args } {
  80.     upvar \#0 DragSite::$path drag
  81.  
  82.     if { [info exists drag] } {
  83.         bind $path $drag(evt) {}
  84.         unset drag
  85.     }
  86.     Widget::init DragSite .drag$path $args
  87.     set event   [Widget::getoption .drag$path -dragevent]
  88.     set initcmd [Widget::getoption .drag$path -draginitcmd]
  89.     set endcmd  [Widget::getoption .drag$path -dragendcmd]
  90.     set tags    [bindtags $path]
  91.     set idx     [lsearch $tags "BwDrag*"]
  92.     Widget::destroy .drag$path
  93.     if { $initcmd != "" } {
  94.         if { $idx != -1 } {
  95.             bindtags $path [lreplace $tags $idx $idx BwDrag$event]
  96.         } else {
  97.             bindtags $path [concat $tags BwDrag$event]
  98.         }
  99.         set drag(initcmd) $initcmd
  100.         set drag(endcmd)  $endcmd
  101.         set drag(evt)     $event
  102.     } elseif { $idx != -1 } {
  103.         bindtags $path [lreplace $tags $idx $idx]
  104.     }
  105. }
  106.  
  107.  
  108. # ------------------------------------------------------------------------------
  109. #  Command DragSite::_begin_drag
  110. # ------------------------------------------------------------------------------
  111. proc DragSite::_begin_drag { event source state X Y } {
  112.     variable _x0
  113.     variable _y0
  114.     variable _state
  115.  
  116.     switch -- $event {
  117.         press {
  118.             set _x0    $X
  119.             set _y0    $Y
  120.             set _state "press"
  121.         }
  122.         motion {
  123.             if { ![string compare $_state "press"] } {
  124.                 if { abs($_x0-$X) > 3 || abs($_y0-$Y) > 3 } {
  125.                     set _state "done"
  126.                     _init_drag $source $state $X $Y
  127.                 }
  128.             }
  129.         }
  130.     }
  131. }
  132.  
  133.  
  134. # ------------------------------------------------------------------------------
  135. #  Command DragSite::_init_drag
  136. # ------------------------------------------------------------------------------
  137. proc DragSite::_init_drag { source state X Y } {
  138.     variable _topw
  139.     upvar \#0 DragSite::$source drag
  140.  
  141.     destroy  $_topw
  142.     toplevel $_topw
  143.     wm withdraw $_topw
  144.     wm overrideredirect $_topw 1
  145.  
  146.     set info [uplevel \#0 $drag(initcmd) [list $source $X $Y .drag]]
  147.     if { $info != "" } {
  148.         set type [lindex $info 0]
  149.         set ops  [lindex $info 1]
  150.         set data [lindex $info 2]
  151.  
  152.         if { [winfo children $_topw] == "" } {
  153.             if { ![string compare $type "BITMAP"] || ![string compare $type "IMAGE"] } {
  154.                 label $_topw.l -image [Bitmap::get dragicon] -relief flat -bd 0
  155.             } else {
  156.                 label $_topw.l -image [Bitmap::get dragfile] -relief flat -bd 0
  157.             }
  158.             pack  $_topw.l
  159.         }
  160.         wm geometry $_topw +[expr $X+1]+[expr $Y+1]
  161.         wm deiconify $_topw
  162.         tkwait visibility $_topw
  163.         BWidget::grab  set $_topw
  164.         BWidget::focus set $_topw
  165.  
  166.         bindtags $_topw [list $_topw DragTop]
  167.         DropSite::_init_drag $_topw $source $state $X $Y $type $ops $data
  168.     } else {
  169.         destroy $_topw
  170.     }
  171. }
  172.  
  173.  
  174. # ------------------------------------------------------------------------------
  175. #  Command DragSite::_end_drag
  176. # ------------------------------------------------------------------------------
  177. proc DragSite::_end_drag { source target op type data result } {
  178.     variable _topw
  179.     upvar \#0 DragSite::$source drag
  180.  
  181.     BWidget::grab  release $_topw
  182.     BWidget::focus release $_topw
  183.     destroy $_topw
  184.     if { $drag(endcmd) != "" } {
  185.         uplevel \#0 $drag(endcmd) [list $source $target $op $type $data $result]
  186.     }
  187. }
  188.  
  189.  
  190.