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