home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / scrollview.tcl < prev    next >
Text File  |  2000-11-02  |  10KB  |  258 lines
  1. # ------------------------------------------------------------------------------
  2. #  scrollview.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: scrollview.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - ScrolledWindow::create
  8. #     - ScrolledWindow::configure
  9. #     - ScrolledWindow::cget
  10. #     - ScrolledWindow::_set_hscroll
  11. #     - ScrolledWindow::_set_vscroll
  12. #     - ScrolledWindow::_update_scroll
  13. #     - ScrolledWindow::_set_view
  14. #     - ScrolledWindow::_resize
  15. # ------------------------------------------------------------------------------
  16.  
  17. namespace eval ScrollView {
  18.     Widget::declare ScrollView {
  19.         {-width       TkResource 30        0 canvas}
  20.         {-height      TkResource 30        0 canvas}
  21.         {-background  TkResource ""        0 canvas}
  22.         {-foreground  String     black     0}
  23.         {-fill        String     ""        0}
  24.         {-relief      TkResource flat      0 canvas}
  25.         {-borderwidth TkResource 0         0 canvas}
  26.         {-cursor      TkResource crosshair 0 canvas}
  27.         {-window      String     ""        0}
  28.         {-fg          Synonym    -foreground}
  29.         {-bg          Synonym    -background}
  30.         {-bd          Synonym    -borderwidth}
  31.     }
  32.  
  33.     Widget::addmap ScrollView "" :cmd \
  34.         {-relief {} -borderwidth {} -background {} -width {} -height {} -cursor {}}
  35.  
  36.     bind BwScrollView <ButtonPress-3> {ScrollView::_set_view %W set %x %y}
  37.     bind BwScrollView <ButtonPress-1> {ScrollView::_set_view %W start %x %y}
  38.     bind BwScrollView <B1-Motion>     {ScrollView::_set_view %W motion %x %y}
  39.     bind BwScrollView <Configure>     {ScrollView::_resize %W}
  40.     bind BwScrollView <Destroy>       {ScrollView::_destroy %W}
  41.  
  42.     proc ::ScrollView { path args } { return [eval ScrollView::create $path $args] }
  43.     proc use {} {}
  44.  
  45.     variable _widget
  46. }
  47.  
  48.  
  49. # ------------------------------------------------------------------------------
  50. #  Command ScrollView::create
  51. # ------------------------------------------------------------------------------
  52. proc ScrollView::create { path args } {
  53.     variable _widget
  54.  
  55.     Widget::init ScrollView $path $args
  56.  
  57.     set w                     [Widget::getoption $path -window]
  58.     set _widget($path,bd)     [Widget::getoption $path -borderwidth]
  59.     set _widget($path,width)  [Widget::getoption $path -width]
  60.     set _widget($path,height) [Widget::getoption $path -height]
  61.  
  62.     if { [winfo exists $w] } {
  63.         set _widget($path,oldxscroll) [$w cget -xscrollcommand]
  64.         set _widget($path,oldyscroll) [$w cget -yscrollcommand]
  65.         $w configure \
  66.             -xscrollcommand "ScrollView::_set_hscroll $path" \
  67.             -yscrollcommand "ScrollView::_set_vscroll $path"
  68.     }
  69.     eval canvas $path [Widget::subcget $path :cmd] -highlightthickness 0
  70.     $path create rectangle -2 -2 -2 -2 \
  71.         -fill    [Widget::getoption $path -fill]       \
  72.         -outline [Widget::getoption $path -foreground] \
  73.         -tags    view
  74.  
  75.     bindtags $path [list $path BwScrollView [winfo toplevel $path] all]
  76.  
  77.     rename $path ::$path:cmd
  78.     proc ::$path { cmd args } "return \[eval ScrollView::\$cmd $path \$args\]"
  79.  
  80.     return $path
  81. }
  82.  
  83.  
  84. # ------------------------------------------------------------------------------
  85. #  Command ScrollView::configure
  86. # ------------------------------------------------------------------------------
  87. proc ScrollView::configure { path args } {
  88.     variable _widget
  89.  
  90.     set oldw [Widget::getoption $path -window] 
  91.     set res  [Widget::configure $path $args]
  92.  
  93.     if { [Widget::hasChanged $path -window w] } {
  94.         if { [winfo exists $oldw] } {
  95.             $oldw configure \
  96.                 -xscrollcommand $_widget($path,oldxscroll) \
  97.                 -yscrollcommand $_widget($path,oldyscroll)
  98.         }
  99.         if { [winfo exists $w] } {
  100.             set _widget($path,oldxscroll) [$w cget -xscrollcommand]
  101.             set _widget($path,oldyscroll) [$w cget -yscrollcommand]
  102.             $w configure \
  103.                 -xscrollcommand "ScrollView::_set_hscroll $path" \
  104.                 -yscrollcommand "ScrollView::_set_vscroll $path"
  105.         } else {
  106.             $path:cmd coords view -2 -2 -2 -2
  107.             set _widget($path,oldxscroll) {}
  108.             set _widget($path,oldyscroll) {}
  109.         }
  110.     }
  111.  
  112.     if { [Widget::hasChanged $path -fill fill] |
  113.          [Widget::hasChanged $path -foreground fg] } {
  114.         $path:cmd itemconfigure view \
  115.             -fill    $fill \
  116.             -outline $fg
  117.     }
  118.  
  119.     return $res
  120. }
  121.  
  122.  
  123. # ------------------------------------------------------------------------------
  124. #  Command ScrollView::cget
  125. # ------------------------------------------------------------------------------
  126. proc ScrollView::cget { path option } {
  127.     return [Widget::cget $path $option]
  128. }
  129.  
  130.  
  131. # ------------------------------------------------------------------------------
  132. #  Command ScrollView::_destroy
  133. # ------------------------------------------------------------------------------
  134. proc ScrollView::_destroy { path } {
  135.     variable _widget
  136.  
  137.     set w [Widget::getoption $path -window] 
  138.     if { [winfo exists $w] } {
  139.         $w configure \
  140.             -xscrollcommand $_widget($path,oldxscroll) \
  141.             -yscrollcommand $_widget($path,oldyscroll)
  142.     }
  143.     unset _widget($path,oldxscroll)
  144.     unset _widget($path,oldyscroll)
  145.     unset _widget($path,bd)
  146.     unset _widget($path,width)
  147.     unset _widget($path,height)
  148.     catch {unset _widget($path,dx)}
  149.     catch {unset _widget($path,dy)}
  150.     Widget::destroy $path
  151.     rename $path {}
  152. }
  153.  
  154.  
  155. # ------------------------------------------------------------------------------
  156. #  Command ScrollView::_set_hscroll
  157. # ------------------------------------------------------------------------------
  158. proc ScrollView::_set_hscroll { path vmin vmax } {
  159.     variable _widget
  160.  
  161.     set c  [$path:cmd coords view]
  162.     set x0 [expr {$vmin*$_widget($path,width)+$_widget($path,bd)}]
  163.     set x1 [expr {$vmax*$_widget($path,width)+$_widget($path,bd)-1}]
  164.     $path:cmd coords view $x0 [lindex $c 1] $x1 [lindex $c 3]
  165.     if { $_widget($path,oldxscroll) != "" } {
  166.         uplevel \#0 $_widget($path,oldxscroll) $vmin $vmax
  167.     }
  168. }
  169.  
  170.  
  171. # ------------------------------------------------------------------------------
  172. #  Command ScrollView::_set_vscroll
  173. # ------------------------------------------------------------------------------
  174. proc ScrollView::_set_vscroll { path vmin vmax } {
  175.     variable _widget
  176.  
  177.     set c  [$path:cmd coords view]
  178.     set y0 [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}]
  179.     set y1 [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}]
  180.     $path:cmd coords view [lindex $c 0] $y0 [lindex $c 2] $y1
  181.     if { $_widget($path,oldyscroll) != "" } {
  182.         uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax
  183.     }
  184. }
  185.  
  186.  
  187. # ------------------------------------------------------------------------------
  188. #  Command ScrollView::_update_scroll
  189. # ------------------------------------------------------------------------------
  190. proc ScrollView::_update_scroll { path callscroll hminmax vminmax } {
  191.     variable _widget
  192.  
  193.     set c    [$path:cmd coords view]
  194.     set hmin [lindex $hminmax 0]
  195.     set hmax [lindex $hminmax 1]
  196.     set vmin [lindex $vminmax 0]
  197.     set vmax [lindex $vminmax 1]
  198.     set x0   [expr {$hmin*$_widget($path,width)+$_widget($path,bd)}]
  199.     set x1   [expr {$hmax*$_widget($path,width)+$_widget($path,bd)-1}]
  200.     set y0   [expr {$vmin*$_widget($path,height)+$_widget($path,bd)}]
  201.     set y1   [expr {$vmax*$_widget($path,height)+$_widget($path,bd)-1}]
  202.     $path:cmd coords view $x0 $y0 $x1 $y1
  203.     if { $callscroll } {
  204.         if { $_widget($path,oldxscroll) != "" } {
  205.             uplevel \#0 $_widget($path,oldxscroll) $hmin $hmax
  206.         }
  207.         if { $_widget($path,oldyscroll) != "" } {
  208.             uplevel \#0 $_widget($path,oldyscroll) $vmin $vmax
  209.         }
  210.     }
  211. }
  212.  
  213.  
  214. # ------------------------------------------------------------------------------
  215. #  Command ScrollView::_set_view
  216. # ------------------------------------------------------------------------------
  217. proc ScrollView::_set_view { path cmd x y } {
  218.     variable _widget
  219.  
  220.     set w [Widget::getoption $path -window]
  221.     if { [winfo exists $w] } {
  222.         if { ![string compare $cmd "start"] } {
  223.             set c  [$path:cmd coords view]
  224.             set x0 [lindex $c 0]
  225.             set y0 [lindex $c 1]
  226.             set _widget($path,dx) [expr {$x-$x0}]
  227.             set _widget($path,dy) [expr {$y-$y0}]
  228.         } else {
  229.             if { ![string compare $cmd "motion"] } {
  230.                 set vh [expr {double($x-$_widget($path,dx)-$_widget($path,bd))/$_widget($path,width)}]
  231.                 set vv [expr {double($y-$_widget($path,dy)-$_widget($path,bd))/$_widget($path,height)}]
  232.             } else {
  233.                 set vh [expr {double($x-$_widget($path,bd))/$_widget($path,width)}]
  234.                 set vv [expr {double($y-$_widget($path,bd))/$_widget($path,height)}]
  235.             }
  236.             $w xview moveto $vh
  237.             $w yview moveto $vv
  238.             _update_scroll $path 1 [$w xview] [$w yview]
  239.         }
  240.     }
  241. }
  242.  
  243.  
  244. # ------------------------------------------------------------------------------
  245. #  Command ScrollView::_resize
  246. # ------------------------------------------------------------------------------
  247. proc ScrollView::_resize { path } {
  248.     variable _widget
  249.  
  250.     set _widget($path,bd)     [Widget::getoption $path -borderwidth]
  251.     set _widget($path,width)  [expr {[winfo width  $path]-2*$_widget($path,bd)}]
  252.     set _widget($path,height) [expr {[winfo height $path]-2*$_widget($path,bd)}]
  253.     set w [Widget::getoption $path -window]
  254.     if { [winfo exists $w] } {
  255.         _update_scroll $path 0 [$w xview] [$w yview]
  256.     }
  257. }
  258.