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