home *** CD-ROM | disk | FTP | other *** search
/ PC World 2000 December / PCWorld_2000-12_cd.bin / Komunikace / Comanche / BWidget-1.2 / scrollw.tcl < prev    next >
Encoding:
Text File  |  2000-11-02  |  9.0 KB  |  255 lines
  1. # ------------------------------------------------------------------------------
  2. #  scrollw.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: scrollw.tcl,v 1.1.1.1 1996/02/22 06:05:56 daniel Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - ScrolledWindow::create
  8. #     - ScrolledWindow::getframe
  9. #     - ScrolledWindow::setwidget
  10. #     - ScrolledWindow::configure
  11. #     - ScrolledWindow::cget
  12. #     - ScrolledWindow::_set_hscroll
  13. #     - ScrolledWindow::_set_vscroll
  14. #     - ScrolledWindow::_realize
  15. # ------------------------------------------------------------------------------
  16.  
  17. namespace eval ScrolledWindow {
  18.     Widget::declare ScrolledWindow {
  19.         {-background  TkResource ""   0 button}
  20.         {-scrollbar   Enum       both 1 {none both vertical horizontal}}
  21.         {-auto        Enum       both 0 {none both vertical horizontal}}
  22.         {-relief      TkResource flat 0 frame}
  23.         {-borderwidth TkResource 0    0 frame}
  24.         {-bg          Synonym    -background}
  25.         {-bd          Synonym    -borderwidth}
  26.     }
  27.  
  28.     Widget::addmap ScrolledWindow "" ._grid.f {-relief {} -borderwidth {}}
  29.  
  30.     proc ::ScrolledWindow { path args } { return [eval ScrolledWindow::create $path $args] }
  31.     proc use {} {}
  32.  
  33.     variable _widget
  34. }
  35.  
  36.  
  37. # ------------------------------------------------------------------------------
  38. #  Command ScrolledWindow::create
  39. # ------------------------------------------------------------------------------
  40. proc ScrolledWindow::create { path args } {
  41.     variable _widget
  42.  
  43.     Widget::init ScrolledWindow $path $args
  44.  
  45.     set bg     [Widget::cget $path -background]
  46.     set sw     [frame $path -relief flat -bd 0 -bg $bg -highlightthickness 0 -takefocus 0]
  47.     set grid   [frame $path._grid -relief flat -bd 0 -bg $bg -highlightthickness 0 -takefocus 0]
  48.  
  49.     set sb    [lsearch {none horizontal vertical both} [Widget::cget $path -scrollbar]]
  50.     set auto  [lsearch {none horizontal vertical both} [Widget::cget $path -auto]]
  51.     set rspan [expr {1 + !($sb & 1)}]
  52.     set cspan [expr {1 + !($sb & 2)}]
  53.  
  54.     set _widget($path,realized) 0
  55.     set _widget($path,sb)       $sb
  56.     set _widget($path,auto)     $auto
  57.     set _widget($path,hpack)    [expr {$rspan == 1}]
  58.     set _widget($path,vpack)    [expr {$cspan == 1}]
  59.  
  60.     # scrollbar horizontale ou les deux
  61.     if { $sb & 1 } {
  62.         scrollbar $grid.hscroll \
  63.             -highlightthickness 0 -takefocus 0 \
  64.             -orient  horiz    \
  65.             -relief  sunken    \
  66.             -bg      $bg
  67.         $grid.hscroll set 0 1
  68.         grid $grid.hscroll -column 0 -row 1 -sticky we -columnspan $cspan -pady 1
  69.     }
  70.  
  71.     # scrollbar verticale ou les deux
  72.     if { $sb & 2 } {
  73.         scrollbar $grid.vscroll \
  74.             -highlightthickness 0 -takefocus 0 \
  75.             -orient  vert      \
  76.             -relief  sunken     \
  77.             -bg      $bg
  78.         $grid.vscroll set 0 1
  79.         grid $grid.vscroll -column 1 -row 0 -sticky ns -rowspan $rspan -padx 1
  80.     }
  81.  
  82.     eval frame $grid.f -bg $bg -highlightthickness 0 [Widget::subcget $path ._grid.f]
  83.     grid $grid.f -column 0 -row 0 -sticky nwse -columnspan $cspan -rowspan $rspan
  84.     grid columnconfigure $grid 0 -weight 1
  85.     grid rowconfigure    $grid 0 -weight 1
  86.     pack $grid -fill both -expand yes
  87.  
  88.     bind $grid <Configure> "ScrolledWindow::_realize $path"
  89.     bind $grid <Destroy>   "ScrolledWindow::_destroy $path"
  90.  
  91.     rename $path ::$path:cmd
  92.     proc ::$path { cmd args } "return \[eval ScrolledWindow::\$cmd $path \$args\]"
  93.  
  94.     return $path
  95. }
  96.  
  97.  
  98. # ------------------------------------------------------------------------------
  99. #  Command ScrolledWindow::getframe
  100. # ------------------------------------------------------------------------------
  101. proc ScrolledWindow::getframe { path } {
  102.     return $path
  103. }
  104.  
  105.  
  106. # ------------------------------------------------------------------------------
  107. #  Command ScrolledWindow::setwidget
  108. # ------------------------------------------------------------------------------
  109. proc ScrolledWindow::setwidget { path widget } {
  110.     variable _widget
  111.  
  112.     set grid   $path._grid
  113.     set sb     $_widget($path,sb)
  114.     set option {}
  115.  
  116.     pack $widget -in $grid.f -fill both -expand yes
  117.  
  118.     # scrollbar horizontale ou les deux
  119.     if { $sb & 1 } {
  120.         $grid.hscroll configure -command "$widget xview"
  121.         lappend option  "-xscrollcommand" "ScrolledWindow::_set_hscroll $path"
  122.     }
  123.  
  124.     # scrollbar verticale ou les deux
  125.     if { $sb & 2 } {
  126.         $grid.vscroll configure -command "$widget yview"
  127.         lappend option  "-yscrollcommand" "ScrolledWindow::_set_vscroll $path"
  128.     }
  129.     if { [llength $option] } {
  130.         eval $widget configure $option
  131.     }
  132. }
  133.  
  134.  
  135. # ------------------------------------------------------------------------------
  136. #  Command ScrolledWindow::configure
  137. # ------------------------------------------------------------------------------
  138. proc ScrolledWindow::configure { path args } {
  139.     variable _widget
  140.  
  141.     set grid $path._grid
  142.     set res [Widget::configure $path $args]
  143.     if { [Widget::hasChanged $path -background bg] } {
  144.         $path configure -background $bg
  145.         $grid configure -background $bg
  146.         $grid.f configure -background $bg
  147.         catch {$grid.hscroll configure -background $bg}
  148.         catch {$grid.vscroll configure -background $bg}
  149.     }
  150.     if { [Widget::hasChanged $path -auto auto] } {
  151.         set _widget($path,auto) [lsearch {none horizontal vertical both} $auto]
  152.         if { $_widget($path,sb) & 1 } {
  153.             eval _set_hscroll $path [$grid.hscroll get]
  154.         }
  155.         if { $_widget($path,sb) & 2 } {
  156.             eval _set_vscroll $path [$grid.vscroll get]
  157.         }
  158.     }
  159.     return $res
  160. }
  161.  
  162.  
  163. # ------------------------------------------------------------------------------
  164. #  Command ScrolledWindow::cget
  165. # ------------------------------------------------------------------------------
  166. proc ScrolledWindow::cget { path option } {
  167.     return [Widget::cget $path $option]
  168. }
  169.  
  170.  
  171. # ------------------------------------------------------------------------------
  172. #  Command ScrolledWindow::_destroy
  173. # ------------------------------------------------------------------------------
  174. proc ScrolledWindow::_destroy { path } {
  175.     variable _widget
  176.  
  177.     unset _widget($path,sb)
  178.     unset _widget($path,auto)
  179.     unset _widget($path,hpack)
  180.     unset _widget($path,vpack)
  181.     Widget::destroy $path
  182.     rename $path {}
  183. }
  184.  
  185.  
  186. # ------------------------------------------------------------------------------
  187. #  Command ScrolledWindow::_set_hscroll
  188. # ------------------------------------------------------------------------------
  189. proc ScrolledWindow::_set_hscroll { path vmin vmax } {
  190.     variable _widget
  191.  
  192.     if { $_widget($path,realized) } {
  193.         set grid $path._grid
  194.         if { $_widget($path,auto) & 1 } {
  195.             if { $_widget($path,hpack) && $vmin == 0 && $vmax == 1 } {
  196.                 grid configure $grid.f -rowspan 2
  197.                 if { $_widget($path,sb) & 2 } {
  198.                     grid configure $grid.vscroll -rowspan 2
  199.                 }
  200.                 set _widget($path,hpack) 0
  201.             } elseif { !$_widget($path,hpack) && ($vmin != 0 || $vmax != 1) } {
  202.                 grid configure $grid.f -rowspan 1
  203.                 if { $_widget($path,sb) & 2 } {
  204.                     grid configure $grid.vscroll -rowspan 1
  205.                 }
  206.                 set _widget($path,hpack) 1
  207.             }
  208.         }
  209.         $grid.hscroll set $vmin $vmax
  210.     }
  211. }
  212.  
  213.  
  214. # ------------------------------------------------------------------------------
  215. #  Command ScrolledWindow::_set_vscroll
  216. # ------------------------------------------------------------------------------
  217. proc ScrolledWindow::_set_vscroll { path vmin vmax } {
  218.     variable _widget
  219.  
  220.     if { $_widget($path,realized) } {
  221.         set grid $path._grid
  222.         if { $_widget($path,auto) & 2 } {
  223.             if { $_widget($path,vpack) && $vmin == 0 && $vmax == 1 } {
  224.                 grid configure $grid.f -columnspan 2
  225.                 if { $_widget($path,sb) & 1 } {
  226.                     grid configure $grid.hscroll -columnspan 2
  227.                 }
  228.                 set _widget($path,vpack) 0
  229.             } elseif { !$_widget($path,vpack) && ($vmin != 0 || $vmax != 1) } {
  230.                 grid configure $grid.f -columnspan 1
  231.                 if { $_widget($path,sb) & 1 } {
  232.                     grid configure $grid.hscroll -columnspan 1
  233.                 }
  234.                 set _widget($path,vpack) 1
  235.             }
  236.         }
  237.         $grid.vscroll set $vmin $vmax
  238.     }
  239. }
  240.  
  241.  
  242. # ------------------------------------------------------------------------------
  243. #  Command ScrolledWindow::_realize
  244. # ------------------------------------------------------------------------------
  245. proc ScrolledWindow::_realize { path } {
  246.     variable _widget
  247.  
  248.     set grid $path._grid
  249.     bind  $grid <Configure> {}
  250.     set _widget($path,realized) 1
  251.     place $grid -anchor nw -x 0 -y 0 -relwidth 1.0 -relheight 1.0
  252. }
  253.  
  254.  
  255.