home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / scrollframe.tcl < prev    next >
Text File  |  2000-11-02  |  7KB  |  212 lines
  1. # ------------------------------------------------------------------------------
  2. #  scrollframe.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: scrollframe.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel 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. # ------------------------------------------------------------------------------
  125. #  Command ScrollableFrame::see
  126. # ------------------------------------------------------------------------------
  127. proc ScrollableFrame::see { path widget {vert top} {horz left}} {
  128.     set x0  [winfo x $widget]
  129.     set y0  [winfo y $widget]
  130.     set x1  [expr {$x0+[winfo width  $widget]}]
  131.     set y1  [expr {$y0+[winfo height $widget]}]
  132.     set xb0 [$path:cmd canvasx 0]
  133.     set yb0 [$path:cmd canvasy 0]
  134.     set xb1 [$path:cmd canvasx [winfo width  $path]]
  135.     set yb1 [$path:cmd canvasy [winfo height $path]]
  136.     set dx  0
  137.     set dy  0
  138.  
  139.     if { ![string compare $horz "left"] } {
  140.     if { $x1 > $xb1 } {
  141.         set dx [expr {$x1-$xb1}]
  142.     }
  143.     if { $x0 < $xb0+$dx } {
  144.         set dx [expr {$x0-$xb0}]
  145.     }
  146.     } elseif { ![string compare $horz "right"] } {
  147.     if { $x0 < $xb0 } {
  148.         set dx [expr {$x0-$xb0}]
  149.     }
  150.     if { $x1 > $xb1+$dx } {
  151.         set dx [expr {$x1-$xb1}]
  152.     }
  153.     }
  154.  
  155.     if { ![string compare $vert "top"] } {
  156.     if { $y1 > $yb1 } {
  157.         set dy [expr {$y1-$yb1}]
  158.     }
  159.     if { $y0 < $yb0+$dy } {
  160.         set dy [expr {$y0-$yb0}]
  161.     }
  162.     } elseif { ![string compare $vert"bottom"] } {
  163.     if { $y0 < $yb0 } {
  164.         set dy [expr {$y0-$yb0}]
  165.     }
  166.     if { $y1 > $yb1+$dy } {
  167.         set dy [expr {$y1-$yb1}]
  168.     }
  169.     }
  170.  
  171.  
  172.     if { $dx != 0 } {
  173.     set x [expr {($xb0+$dx)/[winfo width $path.frame]}]
  174.     $path:cmd xview moveto $x
  175.     }
  176.     if { $dy != 0 } {
  177.     set y [expr {($yb0+$dy)/[winfo height $path.frame]}]
  178.     $path:cmd yview moveto $y
  179.     }
  180. }
  181.  
  182.  
  183. # ------------------------------------------------------------------------------
  184. #  Command ScrollableFrame::xview
  185. # ------------------------------------------------------------------------------
  186. proc ScrollableFrame::xview { path args } {
  187.     return [eval $path:cmd xview $args]
  188. }
  189.  
  190.  
  191. # ------------------------------------------------------------------------------
  192. #  Command ScrollableFrame::yview
  193. # ------------------------------------------------------------------------------
  194. proc ScrollableFrame::yview { path args } {
  195.     return [eval $path:cmd yview $args]
  196. }
  197.  
  198.  
  199. # ------------------------------------------------------------------------------
  200. #  Command ScrollableFrame::_resize
  201. # ------------------------------------------------------------------------------
  202. proc ScrollableFrame::_resize { path } {
  203.     if { [Widget::getoption $path -constrainedwidth] } {
  204.         $path:cmd itemconfigure win -width [winfo width $path]
  205.     }
  206.     if { [Widget::getoption $path -constrainedheight] } {
  207.         $path:cmd itemconfigure win -height [winfo height $path]
  208.     }
  209. }
  210.  
  211.  
  212.