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 / labelframe.tcl < prev    next >
Encoding:
Text File  |  2001-10-22  |  5.7 KB  |  162 lines
  1. # ------------------------------------------------------------------------------
  2. #  labelframe.tcl
  3. #  This file is part of Unifix BWidget Toolkit
  4. #  $Id: labelframe.tcl,v 1.3 2000/03/01 02:12:39 ericm Exp $
  5. # ------------------------------------------------------------------------------
  6. #  Index of commands:
  7. #     - LabelFrame::create
  8. #     - LabelFrame::getframe
  9. #     - LabelFrame::configure
  10. #     - LabelFrame::cget
  11. #     - LabelFrame::align
  12. # ------------------------------------------------------------------------------
  13.  
  14. namespace eval LabelFrame {
  15.     BWLabel::use
  16.  
  17.     Widget::bwinclude LabelFrame BWLabel .l \
  18.         remove     {
  19.             -highlightthickness -highlightcolor -highlightbackground
  20.             -takefocus -relief -borderwidth
  21.             -bitmap -image -cursor -textvariable
  22.             -dragenabled -draginitcmd -dragendcmd -dragevent -dragtype
  23.             -dropenabled -droptypes -dropovercmd  -dropcmd} \
  24.         initialize {-anchor w}
  25.  
  26.     Widget::declare LabelFrame {
  27.         {-relief      TkResource flat 0 frame}
  28.         {-borderwidth TkResource 0    0 frame}
  29.         {-side        Enum       left 1 {left right top bottom}}
  30.         {-bd          Synonym    -borderwidth}
  31.     }
  32.  
  33.     Widget::addmap LabelFrame "" :cmd {-background {}}
  34.     Widget::addmap LabelFrame "" .f   {-background {} -relief {} -borderwidth {}}
  35.  
  36.     Widget::syncoptions LabelFrame Label .l {-text {} -underline {}}
  37.  
  38.     bind BwLabelFrame <FocusIn> {BWLabel::setfocus %W.l}
  39.     bind BwLabelFrame <Destroy> {Widget::destroy %W; rename %W {}}
  40.  
  41.     proc ::LabelFrame { path args } { return [eval LabelFrame::create $path $args] }
  42.     proc use {} {}
  43. }
  44.  
  45.  
  46. # ------------------------------------------------------------------------------
  47. #  Command LabelFrame::create
  48. # ------------------------------------------------------------------------------
  49. proc LabelFrame::create { path args } {
  50.     Widget::init LabelFrame $path $args
  51.  
  52.     set path  [eval frame $path [Widget::subcget $path :cmd] \
  53.         -relief flat -bd 0 -takefocus 0 -highlightthickness 0 \
  54.         -class LabelFrame]
  55.  
  56.     set label [eval BWLabel::create $path.l [Widget::subcget $path .l] \
  57.                    -takefocus 0 -highlightthickness 0 -relief flat -borderwidth 0 \
  58.                    -dropenabled 0 -dragenabled 0]
  59.     set frame [eval frame $path.f [Widget::subcget $path .f] \
  60.                    -highlightthickness 0 -takefocus 0]
  61.  
  62.     switch  [Widget::getoption $path -side] {
  63.         left   {set packopt "-side left"}
  64.         right  {set packopt "-side right"}
  65.         top    {set packopt "-side top -fill x"}
  66.         bottom {set packopt "-side bottom -fill x"}
  67.     }
  68.  
  69.     eval pack $label $packopt
  70.     pack $frame -fill both -expand yes
  71.  
  72.     bindtags $path [list $path BwLabelFrame [winfo toplevel $path] all]
  73.  
  74.     rename $path ::$path:cmd
  75.     proc ::$path { cmd args } "return \[eval LabelFrame::\$cmd $path \$args\]"
  76.  
  77.     return $path
  78. }
  79.  
  80.  
  81. # ------------------------------------------------------------------------------
  82. #  Command LabelFrame::getframe
  83. # ------------------------------------------------------------------------------
  84. proc LabelFrame::getframe { path } {
  85.     return $path.f
  86. }
  87.  
  88.  
  89. # ------------------------------------------------------------------------------
  90. #  Command LabelFrame::configure
  91. # ------------------------------------------------------------------------------
  92. proc LabelFrame::configure { path args } {
  93.     return [Widget::configure $path $args]
  94. }
  95.  
  96.  
  97. # ------------------------------------------------------------------------------
  98. #  Command LabelFrame::cget
  99. # ------------------------------------------------------------------------------
  100. proc LabelFrame::cget { path option } {
  101.     return [Widget::cget $path $option]
  102. }
  103.  
  104.  
  105. # ------------------------------------------------------------------------------
  106. #  Command LabelFrame::align
  107. #  This command align label of all widget given by args of class LabelFrame
  108. #  (or "derived") by setting their width to the max one +1
  109. # ------------------------------------------------------------------------------
  110. proc LabelFrame::align { args } {
  111.     set maxlen 0
  112.     set wlist  {}
  113.     foreach wl $args {
  114.         foreach w $wl {
  115.             if { ![info exists Widget::_class($w)] } {
  116.                 continue
  117.             }
  118.             set class $Widget::_class($w)
  119.             if { ![string compare $class "LabelFrame"] } {
  120.                 set textopt  -text
  121.                 set widthopt -width
  122.             } else {
  123.                 upvar 0 Widget::${class}::map classmap
  124.                 set textopt  ""
  125.                 set widthopt ""
  126.                 set notdone  2
  127.                 foreach {option lmap} [array get classmap] {
  128.                     foreach {subpath subclass realopt} $lmap {
  129.                         if { ![string compare $subclass "LabelFrame"] } {
  130.                             if { ![string compare $realopt "-text"] } {
  131.                                 set textopt $option
  132.                                 incr notdone -1
  133.                                 break
  134.                             }
  135.                             if { ![string compare $realopt "-width"] } {
  136.                                 set widthopt $option
  137.                                 incr notdone -1
  138.                                 break
  139.                             }
  140.                         }
  141.                     }
  142.                     if { !$notdone } {
  143.                         break
  144.                     }
  145.                 }
  146.                 if { $notdone } {
  147.                     continue
  148.                 }
  149.             }
  150.             set len [string length [$w cget $textopt]]
  151.             if { $len > $maxlen } {
  152.                 set maxlen $len
  153.             }
  154.             lappend wlist $w $widthopt
  155.         }
  156.     }
  157.     incr maxlen
  158.     foreach {w widthopt} $wlist {
  159.         $w configure $widthopt $maxlen
  160.     }
  161. }
  162.