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