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 / panedw.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  11.3 KB  |  336 lines
  1. # ------------------------------------------------------------------------------
  2. #  panedw.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. # ------------------------------------------------------------------------------
  5. #  Index of commands:
  6. #     - PanedWindow::create
  7. #     - PanedWindow::configure
  8. #     - PanedWindow::cget
  9. #     - PanedWindow::add
  10. #     - PanedWindow::getframe
  11. #     - PanedWindow::_destroy
  12. #     - PanedWindow::_beg_move_sash
  13. #     - PanedWindow::_move_sash
  14. #     - PanedWindow::_end_move_sash
  15. #     - PanedWindow::_realize
  16. # ------------------------------------------------------------------------------
  17.  
  18. namespace eval PanedWindow {
  19.     namespace eval Pane {
  20.         Widget::declare PanedWindow::Pane {
  21.             {-minsize Int 0 0 "%d >= 0"}
  22.             {-weight  Int 1 0 "%d >= 0"}
  23.         }
  24.     }
  25.  
  26.     Widget::declare PanedWindow {
  27.         {-side       Enum       top 1 {top left bottom right}}
  28.         {-width      Int        10  1 "%d >=3"}
  29.         {-pad        Int        4   1 "%d >= 0"}
  30.         {-background TkResource ""  0 frame}
  31.         {-bg         Synonym    -background}
  32.         {-activator  Enum       ""  1 {line button}}
  33.     }
  34.  
  35.     variable _panedw
  36.  
  37.     proc ::PanedWindow { path args } { return [eval PanedWindow::create $path $args] }
  38.     proc use {} {}
  39. }
  40.  
  41.  
  42.  
  43. # ------------------------------------------------------------------------------
  44. #  Command PanedWindow::create
  45. # ------------------------------------------------------------------------------
  46. proc PanedWindow::create { path args } {
  47.     variable _panedw
  48.  
  49.     Widget::init PanedWindow $path $args
  50.  
  51.     frame $path -background [Widget::cget $path -background] -class PanedWindow
  52.     set _panedw($path,nbpanes) 0
  53.  
  54.     bind $path <Configure> "PanedWindow::_realize $path %w %h"
  55.     bind $path <Destroy>   "PanedWindow::_destroy $path"
  56.  
  57.     rename $path ::$path:cmd
  58.     proc ::$path { cmd args } "return \[eval PanedWindow::\$cmd $path \$args\]"
  59.  
  60.     return $path
  61. }
  62.  
  63.  
  64. # ------------------------------------------------------------------------------
  65. #  Command PanedWindow::configure
  66. # ------------------------------------------------------------------------------
  67. proc PanedWindow::configure { path args } {
  68.     variable _panedw
  69.  
  70.     set res [Widget::configure $path $args]
  71.  
  72.     if { [Widget::hasChanged $path -background bg] && $_panedw($path,nbpanes) > 0 } {
  73.         $path:cmd configure -background $bg
  74.         $path.f0 configure -background $bg
  75.         for {set i 1} {$i < $_panedw($path,nbpanes)} {incr i} {
  76.             set frame $path.sash$i
  77.             $frame configure -background $bg
  78.             $frame.sep configure -background $bg
  79.             $frame.but configure -background $bg
  80.             $path.f$i configure -background $bg
  81.             $path.f$i.frame configure -background $bg
  82.         }
  83.     }
  84.     return $res
  85. }
  86.  
  87.  
  88. # ------------------------------------------------------------------------------
  89. #  Command PanedWindow::cget
  90. # ------------------------------------------------------------------------------
  91. proc PanedWindow::cget { path option } {
  92.     return [Widget::cget $path $option]
  93. }
  94.  
  95.  
  96. # ------------------------------------------------------------------------------
  97. #  Command PanedWindow::add
  98. # ------------------------------------------------------------------------------
  99. proc PanedWindow::add { path args } {
  100.     variable _panedw
  101.  
  102.     set num $_panedw($path,nbpanes)
  103.     Widget::init PanedWindow::Pane $path.f$num $args
  104.     set bg [Widget::getoption $path -background]
  105.  
  106.     set wbut  [Widget::getoption $path -width]
  107.     set pad   [Widget::getoption $path -pad]
  108.     set width [expr {$wbut+2*$pad}]
  109.     set side  [Widget::getoption $path -side]
  110.     if { $num > 0 } {
  111.         set frame [frame $path.sash$num -relief flat -bd 0 \
  112.         -highlightthickness 0 -width $width -height $width -bg $bg]
  113.         set sep   [frame $frame.sep -bd 5 -relief raised \
  114.         -highlightthickness 0 -bg $bg]
  115.         set but   [frame $frame.but -bd 1 -relief raised \
  116.         -highlightthickness 0 -bg $bg -width $wbut -height $wbut]
  117.     set placeButton 1
  118.     set sepsize     2
  119.  
  120.     set activator [Widget::getoption $path -activator]
  121.     if {$activator == ""} {
  122.         if { $::tcl_platform(platform) != "windows" } {
  123.         set activator button
  124.         } else {
  125.         set activator line
  126.         }
  127.     }
  128.     if {$activator == "button"} {
  129.         set activator $but
  130.     } else {
  131.         set activator $sep
  132.         set sepsize 4
  133.         $sep configure -bd 3
  134.         set placeButton 0
  135.     }
  136.         if { ![string compare $side "top"] || \
  137.         ![string compare $side "bottom"] } {
  138.             place $sep -relx 0.5 -y 0 -width $sepsize -relheight 1.0 -anchor n
  139.         if { $placeButton } {
  140.         if { ![string compare $side "top"] } {
  141.             place $but -relx 0.5 -y [expr {6+$wbut/2}] -anchor c
  142.         } else {
  143.             place $but -relx 0.5 -rely 1.0 -y [expr {-6-$wbut/2}] \
  144.                 -anchor c
  145.         }
  146.         }
  147.             $activator configure -cursor sb_h_double_arrow 
  148.             grid $frame -column [expr {2*$num-1}] -row 0 -sticky ns
  149.             grid columnconfigure $path [expr {2*$num-1}] -weight 0
  150.         } else {
  151.             place $sep -x 0 -rely 0.5 -height $sepsize -relwidth 1.0 -anchor w
  152.         if { $placeButton } {
  153.         if { ![string compare $side "left"] } {
  154.             place $but -rely 0.5 -x [expr {6+$wbut/2}] -anchor c
  155.         } else {
  156.             place $but -rely 0.5 -relx 1.0 -x [expr {-6-$wbut/2}] \
  157.                 -anchor c
  158.         }
  159.         }
  160.             $activator configure -cursor sb_v_double_arrow 
  161.             grid $frame -row [expr {2*$num-1}] -column 0 -sticky ew
  162.             grid rowconfigure $path [expr {2*$num-1}] -weight 0
  163.         }
  164.         bind $activator <ButtonPress-1> \
  165.         "PanedWindow::_beg_move_sash $path $num %X %Y"
  166.     } else {
  167.         if { ![string compare $side "top"] || \
  168.         ![string compare $side "bottom"] } {
  169.             grid rowconfigure $path 0 -weight 1
  170.         } else {
  171.             grid columnconfigure $path 0 -weight 1
  172.         }
  173.     }
  174.  
  175.     set pane [frame $path.f$num -bd 0 -relief flat \
  176.         -highlightthickness 0 -bg $bg]
  177.     set user [frame $path.f$num.frame  -bd 0 -relief flat \
  178.         -highlightthickness 0 -bg $bg]
  179.     if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
  180.         grid $pane -column [expr {2*$num}] -row 0 -sticky nsew
  181.         grid columnconfigure $path [expr {2*$num}] \
  182.             -weight  [Widget::getoption $path.f$num -weight]
  183.     } else {
  184.         grid $pane -row [expr {2*$num}] -column 0 -sticky nsew
  185.         grid rowconfigure $path [expr {2*$num}] \
  186.             -weight  [Widget::getoption $path.f$num -weight]
  187.     }
  188.     pack $user -fill both -expand yes
  189.     incr _panedw($path,nbpanes)
  190.  
  191.     return $user
  192. }
  193.  
  194.  
  195. # ------------------------------------------------------------------------------
  196. #  Command PanedWindow::getframe
  197. # ------------------------------------------------------------------------------
  198. proc PanedWindow::getframe { path index } {
  199.     if { [winfo exists $path.f$index.frame] } {
  200.         return $path.f$index.frame
  201.     }
  202. }
  203.  
  204.  
  205. # ------------------------------------------------------------------------------
  206. #  Command PanedWindow::_destroy
  207. # ------------------------------------------------------------------------------
  208. proc PanedWindow::_destroy { path } {
  209.     variable _panedw
  210.  
  211.     for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
  212.         Widget::destroy $path.f$i
  213.     }
  214.     unset _panedw($path,nbpanes)
  215.     Widget::destroy $path
  216.     rename $path {}
  217. }
  218.     
  219.  
  220. # ------------------------------------------------------------------------------
  221. #  Command PanedWindow::_beg_move_sash
  222. # ------------------------------------------------------------------------------
  223. proc PanedWindow::_beg_move_sash { path num x y } {
  224.     variable _panedw
  225.  
  226.     set fprev $path.f[expr {$num-1}]
  227.     set fnext $path.f$num
  228.     set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
  229.  
  230.     $path.sash$num.but configure -relief sunken
  231.     set top  [toplevel $path.sash -borderwidth 1 -relief raised]
  232.  
  233.     set minszg [Widget::getoption $fprev -minsize]
  234.     set minszd [Widget::getoption $fnext -minsize]
  235.     set side   [Widget::getoption $path -side]
  236.  
  237.     if { ![string compare $side "top"] || ![string compare $side "bottom"] } {
  238.         $top configure -cursor sb_h_double_arrow
  239.         set h    [winfo height $path]
  240.         set yr   [winfo rooty $path.sash$num]
  241.         set xmin [expr {$wsash/2+[winfo rootx $fprev]+$minszg}]
  242.         set xmax [expr {-$wsash/2-1+[winfo rootx $fnext]+[winfo width $fnext]-$minszd}]
  243.         wm overrideredirect $top 1
  244.         wm geom $top "2x${h}+$x+$yr"
  245.  
  246.         update idletasks
  247.         grab set $top
  248.         bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $xmin $xmax %X rootx width"
  249.         bind $top <Motion>          "PanedWindow::_move_sash $top $xmin $xmax %X +%%d+$yr"
  250.         _move_sash $top $xmin $xmax $x "+%d+$yr"
  251.     } else {
  252.         $top configure -cursor sb_v_double_arrow
  253.         set w    [winfo width $path]
  254.         set xr   [winfo rootx $path.sash$num]
  255.         set ymin [expr {$wsash/2+[winfo rooty $fprev]+$minszg}]
  256.         set ymax [expr {-$wsash/2-1+[winfo rooty $fnext]+[winfo height $fnext]-$minszd}]
  257.         wm overrideredirect $top 1
  258.         wm geom $top "${w}x2+$xr+$y"
  259.  
  260.         update idletasks
  261.         grab set $top
  262.         bind $top <ButtonRelease-1> "PanedWindow::_end_move_sash $path $top $num $ymin $ymax %Y rooty height"
  263.         bind $top <Motion>          "PanedWindow::_move_sash $top $ymin $ymax %Y +$xr+%%d"
  264.         _move_sash $top $ymin $ymax $y "+$xr+%d"
  265.     }
  266. }
  267.  
  268.  
  269. # ------------------------------------------------------------------------------
  270. #  Command PanedWindow::_move_sash
  271. # ------------------------------------------------------------------------------
  272. proc PanedWindow::_move_sash { top min max v form } {
  273.  
  274.     if { $v < $min } {
  275.     set v $min
  276.     } elseif { $v > $max } {
  277.     set v $max
  278.     }
  279.     wm geom $top [format $form $v]
  280. }
  281.  
  282.  
  283. # ------------------------------------------------------------------------------
  284. #  Command PanedWindow::_end_move_sash
  285. # ------------------------------------------------------------------------------
  286. proc PanedWindow::_end_move_sash { path top num min max v rootv size } {
  287.     variable _panedw
  288.  
  289.     destroy $top
  290.     if { $v < $min } {
  291.     set v $min
  292.     } elseif { $v > $max } {
  293.     set v $max
  294.     }
  295.     set fprev $path.f[expr {$num-1}]
  296.     set fnext $path.f$num
  297.  
  298.     $path.sash$num.but configure -relief raised
  299.  
  300.     set wsash [expr {[Widget::getoption $path -width] + 2*[Widget::getoption $path -pad]}]
  301.     set dv    [expr {$v-[winfo $rootv $path.sash$num]-$wsash/2}]
  302.     set w1    [winfo $size $fprev]
  303.     set w2    [winfo $size $fnext]
  304.  
  305.     for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
  306.         if { $i == $num-1} {
  307.             $fprev configure -$size [expr {[winfo $size $fprev]+$dv}]
  308.         } elseif { $i == $num } {
  309.             $fnext configure -$size [expr {[winfo $size $fnext]-$dv}]
  310.         } else {
  311.             $path.f$i configure -$size [winfo $size $path.f$i]
  312.         }
  313.     }
  314. }
  315.  
  316.  
  317. # ------------------------------------------------------------------------------
  318. #  Command PanedWindow::_realize
  319. # ------------------------------------------------------------------------------
  320. proc PanedWindow::_realize { path width height } {
  321.     variable _panedw
  322.  
  323.     set x    0
  324.     set y    0
  325.     set hc   [winfo reqheight $path]
  326.     set hmax 0
  327.     for {set i 0} {$i < $_panedw($path,nbpanes)} {incr i} {
  328.         $path.f$i configure \
  329.             -width  [winfo reqwidth  $path.f$i.frame] \
  330.             -height [winfo reqheight $path.f$i.frame]
  331.         place $path.f$i.frame -x 0 -y 0 -relwidth 1 -relheight 1
  332.     }
  333.  
  334.     bind $path <Configure> {}
  335. }
  336.