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 / scrollframe.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  6.8 KB  |  210 lines
  1. # ------------------------------------------------------------------------------
  2. #  scrollframe.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: scrollframe.tcl,v 1.2 1999/10/14 20:23:21 sven Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - ScrollableFrame::create
  8. #     - ScrollableFrame::configure
  9. #     - ScrollableFrame::cget
  10. #     - ScrollableFrame::getframe
  11. #     - ScrollableFrame::see
  12. #     - ScrollableFrame::xview
  13. #     - ScrollableFrame::yview
  14. #     - ScrollableFrame::_resize
  15. # ------------------------------------------------------------------------------
  16.  
  17. namespace eval ScrollableFrame {
  18.     Widget::declare ScrollableFrame {
  19.         {-background        TkResource "" 0 frame}
  20.         {-width             Int        0  0 {}}
  21.         {-height            Int        0  0 {}}
  22.         {-areawidth         Int        0  0 {}}
  23.         {-areaheight        Int        0  0 {}}
  24.         {-constrainedwidth  Boolean    0 0}
  25.         {-constrainedheight Boolean    0 0}
  26.         {-xscrollcommand    TkResource "" 0 canvas}
  27.         {-yscrollcommand    TkResource "" 0 canvas}
  28.         {-xscrollincrement  TkResource "" 0 canvas}
  29.         {-yscrollincrement  TkResource "" 0 canvas}
  30.         {-bg                Synonym    -background}
  31.     }
  32.  
  33.     Widget::addmap ScrollableFrame "" :cmd {
  34.         -background {} -width {} -height {} 
  35.         -xscrollcommand {} -yscrollcommand {}
  36.         -xscrollincrement {} -yscrollincrement {}
  37.     }
  38.     Widget::addmap ScrollableFrame "" .frame {-background {}}
  39.  
  40.     variable _widget
  41.  
  42.     bind BwScrollableFrame <Configure> {ScrollableFrame::_resize %W}
  43.     bind BwScrollableFrame <Destroy>   {Widget::destroy %W; rename %W {}}
  44.  
  45.     proc ::ScrollableFrame { path args } { return [eval ScrollableFrame::create $path $args] }
  46.     proc use {} {}
  47. }
  48.  
  49.  
  50. # ------------------------------------------------------------------------------
  51. #  Command ScrollableFrame::create
  52. # ------------------------------------------------------------------------------
  53. proc ScrollableFrame::create { path args } {
  54.     Widget::init ScrollableFrame $path $args
  55.  
  56.     set canvas [eval canvas $path [Widget::subcget $path :cmd] \
  57.                     -highlightthickness 0 -borderwidth 0 -relief flat]
  58.  
  59.     set frame  [eval frame $path.frame [Widget::subcget $path .frame] \
  60.                     -highlightthickness 0 -borderwidth 0 -relief flat]
  61.  
  62.     $canvas create window 0 0 -anchor nw -window $frame -tags win \
  63.         -width  [Widget::cget $path -areawidth] \
  64.         -height [Widget::cget $path -areaheight]
  65.  
  66.     bind $frame <Configure> "$canvas:cmd configure -scrollregion {0 0 %w %h}"
  67.     bindtags $path [list $path BwScrollableFrame [winfo toplevel $path] all]
  68.  
  69.     rename $path ::$path:cmd
  70.     proc ::$path { cmd args } "return \[eval ScrollableFrame::\$cmd $path \$args\]"
  71.  
  72.     return $canvas
  73. }
  74.  
  75.  
  76. # ------------------------------------------------------------------------------
  77. #  Command ScrollableFrame::configure
  78. # ------------------------------------------------------------------------------
  79. proc ScrollableFrame::configure { path args } {
  80.     set res [Widget::configure $path $args]
  81.     set upd 0
  82.  
  83.     set modcw [Widget::hasChanged $path -constrainedwidth cw]
  84.     set modw  [Widget::hasChanged $path -areawidth w]
  85.     if { $modcw || (!$cw && $modw) } {
  86.         if { $cw } {
  87.             set w [winfo width $path]
  88.         }
  89.         set upd 1
  90.     }
  91.  
  92.     set modch [Widget::hasChanged $path -constrainedheight ch]
  93.     set modh  [Widget::hasChanged $path -areaheight h]
  94.     if { $modch || (!$ch && $modh) } {
  95.         if { $ch } {
  96.             set h [winfo height $path]
  97.         }
  98.         set upd 1
  99.     }
  100.  
  101.     if { $upd } {
  102.         $path:cmd itemconfigure win -width $w -height $h
  103.     }
  104.     return $res
  105. }
  106.  
  107.  
  108. # ------------------------------------------------------------------------------
  109. #  Command ScrollableFrame::cget
  110. # ------------------------------------------------------------------------------
  111. proc ScrollableFrame::cget { path option } {
  112.     return [Widget::cget $path $option]
  113. }
  114.  
  115.  
  116. # ------------------------------------------------------------------------------
  117. #  Command ScrollableFrame::getframe
  118. # ------------------------------------------------------------------------------
  119. proc ScrollableFrame::getframe { path } {
  120.     return $path.frame
  121. }
  122.  
  123. # ------------------------------------------------------------------------------
  124. #  Command ScrollableFrame::see
  125. # ------------------------------------------------------------------------------
  126. proc ScrollableFrame::see { path widget {vert top} {horz left} {xOffset 0} {yOffset 0}} {
  127.     set x0  [winfo x $widget]
  128.     set y0  [winfo y $widget]
  129.     set x1  [expr {$x0+[winfo width  $widget]}]
  130.     set y1  [expr {$y0+[winfo height $widget]}]
  131.     set xb0 [$path:cmd canvasx 0]
  132.     set yb0 [$path:cmd canvasy 0]
  133.     set xb1 [$path:cmd canvasx [winfo width  $path]]
  134.     set yb1 [$path:cmd canvasy [winfo height $path]]
  135.     set dx  0
  136.     set dy  0
  137.     
  138.     if { ![string compare $horz "left"] } {
  139.     if { $x1 > $xb1 } {
  140.         set dx [expr {$x1-$xb1}]
  141.     }
  142.     if { $x0 < $xb0+$dx } {
  143.         set dx [expr {$x0-$xb0}]
  144.     }
  145.     } elseif { ![string compare $horz "right"] } {
  146.     if { $x0 < $xb0 } {
  147.         set dx [expr {$x0-$xb0}]
  148.     }
  149.     if { $x1 > $xb1+$dx } {
  150.         set dx [expr {$x1-$xb1}]
  151.     }
  152.     }
  153.  
  154.     if { ![string compare $vert "top"] } {
  155.     if { $y1 > $yb1 } {
  156.         set dy [expr {$y1-$yb1}]
  157.     }
  158.     if { $y0 < $yb0+$dy } {
  159.         set dy [expr {$y0-$yb0}]
  160.     }
  161.     } elseif { ![string compare $vert "bottom"] } {
  162.     if { $y0 < $yb0 } {
  163.         set dy [expr {$y0-$yb0}]
  164.     }
  165.     if { $y1 > $yb1+$dy } {
  166.         set dy [expr {$y1-$yb1}]
  167.     }
  168.     }
  169.  
  170.     if { [expr {$dx + $xOffset}] != 0 } {
  171.     set x [expr {($xb0+$dx+$xOffset)/[winfo width $path.frame]}]
  172.     $path:cmd xview moveto $x
  173.     }
  174.     if { [expr {$dy + $yOffset}] != 0 } {
  175.     set y [expr {($yb0+$dy+$yOffset)/[winfo height $path.frame]}]
  176.     $path:cmd yview moveto $y
  177.     }
  178. }
  179.  
  180.  
  181. # ------------------------------------------------------------------------------
  182. #  Command ScrollableFrame::xview
  183. # ------------------------------------------------------------------------------
  184. proc ScrollableFrame::xview { path args } {
  185.     return [eval $path:cmd xview $args]
  186. }
  187.  
  188.  
  189. # ------------------------------------------------------------------------------
  190. #  Command ScrollableFrame::yview
  191. # ------------------------------------------------------------------------------
  192. proc ScrollableFrame::yview { path args } {
  193.     return [eval $path:cmd yview $args]
  194. }
  195.  
  196.  
  197. # ------------------------------------------------------------------------------
  198. #  Command ScrollableFrame::_resize
  199. # ------------------------------------------------------------------------------
  200. proc ScrollableFrame::_resize { path } {
  201.     if { [Widget::getoption $path -constrainedwidth] } {
  202.         $path:cmd itemconfigure win -width [winfo width $path]
  203.     }
  204.     if { [Widget::getoption $path -constrainedheight] } {
  205.         $path:cmd itemconfigure win -height [winfo height $path]
  206.     }
  207. }
  208.  
  209.  
  210.