1# 2# Labeledframe 3# ---------------------------------------------------------------------- 4# Implements a hull frame with a grooved relief, a label, and a 5# frame childsite. 6# 7# The frame childsite can be filled with any widget via a derived class 8# or though the use of the childsite method. This class was designed 9# to be a general purpose base class for supporting the combination of 10# a labeled frame and a childsite. The options include the ability to 11# position the label at configurable locations within the grooved relief 12# of the hull frame, and control the display of the label. 13# 14# To following demonstrates the different values which the "-labelpos" 15# option may be set to and the resulting layout of the label when 16# one executes the following command with "-labeltext" set to "LABEL": 17# 18# example: 19# labeledframe .w -labeltext LABEL -labelpos <ne,n,nw,se,s,sw,en,e,es,wn,s,ws> 20# 21# ne n nw se s sw 22# 23# *LABEL**** **LABEL** ****LABEL* ********** ********* ********** 24# * * * * * * * * * * * * 25# * * * * * * * * * * * * 26# * * * * * * * * * * * * 27# ********** ********* ********** *LABEL**** **LABEL** ****LABEL* 28# 29# en e es wn s ws 30# 31# ********** ********* ********* ********* ********* ********** 32# * * * * * * * * * * * * 33# L * * * * * * L * * * * 34# A * L * * * * A * L * L 35# B * A * L * * B * A * A 36# E * B * A * * E * B * B 37# L * E * B * * L * E * E 38# * * L * E * * * * L * L 39# * * * * L * * * * * * * 40# ********** ********** ********* ********** ********* ********** 41# 42# ---------------------------------------------------------------------- 43# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com 44# 45# ====================================================================== 46# Copyright (c) 1997 DSC Technologies Corporation 47# ====================================================================== 48# Permission to use, copy, modify, distribute and license this software 49# and its documentation for any purpose, and without fee or written 50# agreement with DSC, is hereby granted, provided that the above copyright 51# notice appears in all copies and that both the copyright notice and 52# warranty disclaimer below appear in supporting documentation, and that 53# the names of DSC Technologies Corporation or DSC Communications 54# Corporation not be used in advertising or publicity pertaining to the 55# software without specific, written prior permission. 56# 57# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 58# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 59# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 60# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 61# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 62# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 63# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 64# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 65# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 66# SOFTWARE. 67# ====================================================================== 68 69# 70# Default resources. 71# 72option add *Labeledframe.labelMargin 10 widgetDefault 73option add *Labeledframe.labelFont \ 74 "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault 75option add *Labeledframe.labelPos n widgetDefault 76option add *Labeledframe.borderWidth 2 widgetDefault 77option add *Labeledframe.relief groove widgetDefault 78 79 80# 81# Usual options. 82# 83itk::usual Labeledframe { 84 keep -background -cursor -labelfont -foreground 85} 86 87itcl::class iwidgets::Labeledframe { 88 89 inherit itk::Archetype 90 91 itk_option define -ipadx iPadX IPad 0 92 itk_option define -ipady iPadY IPad 0 93 94 itk_option define -labelmargin labelMargin LabelMargin 10 95 itk_option define -labelpos labelPos LabelPos n 96 97 constructor {args} {} 98 destructor {} 99 100 # 101 # Public methods 102 # 103 public method childsite {} 104 105 # 106 # Protected methods 107 # 108 protected { 109 method _positionLabel {{when later}} 110 method _collapseMargin {} 111 method _setMarginThickness {value} 112 method smt {value} { _setMarginThickness $value } 113 } 114 115 # 116 # Private methods/data 117 # 118 private { 119 proc _initTable {} 120 121 variable _reposition "" ;# non-null => _positionLabel pending 122 variable itk_hull "" 123 124 common _LAYOUT_TABLE 125 } 126} 127 128# 129# Provide a lowercased access method for the Labeledframe class. 130# 131proc ::iwidgets::labeledframe {pathName args} { 132 uplevel ::iwidgets::Labeledframe $pathName $args 133} 134 135# ----------------------------------------------------------------------------- 136# CONSTRUCTOR 137# ----------------------------------------------------------------------------- 138itcl::body iwidgets::Labeledframe::constructor { args } { 139 # 140 # Create a window with the same name as this object 141 # 142 set itk_hull [namespace tail $this] 143 set itk_interior $itk_hull 144 145 itk_component add hull { 146 frame $itk_hull \ 147 -relief groove \ 148 -class [namespace tail [info class]] 149 } { 150 keep -background -cursor -relief -borderwidth 151 rename -highlightbackground -background background Background 152 rename -highlightcolor -background background Background 153 } 154 bind itk-delete-$itk_hull <Destroy> "itcl::delete object $this" 155 156 set tags [bindtags $itk_hull] 157 bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull] 158 159 # 160 # Create the childsite frame window 161 # _______ 162 # |_____| 163 # |_|X|_| 164 # |_____| 165 # 166 itk_component add childsite { 167 frame $itk_interior.childsite -highlightthickness 0 -bd 0 168 } 169 170 # 171 # Create the label to be positioned within the grooved relief 172 # of the hull frame. 173 # 174 itk_component add label { 175 label $itk_interior.label -highlightthickness 0 -bd 0 176 } { 177 usual 178 rename -bitmap -labelbitmap labelBitmap Bitmap 179 rename -font -labelfont labelFont Font 180 rename -image -labelimage labelImage Image 181 rename -text -labeltext labelText Text 182 rename -textvariable -labelvariable labelVariable Variable 183 ignore -highlightthickness -highlightcolor 184 } 185 186 grid $itk_component(childsite) -row 1 -column 1 -sticky nsew 187 grid columnconfigure $itk_interior 1 -weight 1 188 grid rowconfigure $itk_interior 1 -weight 1 189 190 bind $itk_component(label) <Configure> +[itcl::code $this _positionLabel] 191 192 # 193 # Initialize the class array of layout configuration options. Since 194 # this is a one time only thing. 195 # 196 _initTable 197 198 eval itk_initialize $args 199 200 # 201 # When idle, position the label. 202 # 203 _positionLabel 204} 205 206# ----------------------------------------------------------------------------- 207# DESTRUCTOR 208# ----------------------------------------------------------------------------- 209itcl::body iwidgets::Labeledframe::destructor {} { 210 211 if {$_reposition != ""} { 212 after cancel $_reposition 213 } 214 215 if {[winfo exists $itk_hull]} { 216 set tags [bindtags $itk_hull] 217 set i [lsearch $tags itk-delete-$itk_hull] 218 if {$i >= 0} { 219 bindtags $itk_hull [lreplace $tags $i $i] 220 } 221 destroy $itk_hull 222 } 223} 224 225# ----------------------------------------------------------------------------- 226# OPTIONS 227# ----------------------------------------------------------------------------- 228 229# ------------------------------------------------------------------ 230# OPTION: -ipadx 231# 232# Specifies the width of the horizontal gap from the border to the 233# the child site. 234# ------------------------------------------------------------------ 235itcl::configbody iwidgets::Labeledframe::ipadx { 236 grid configure $itk_component(childsite) -padx $itk_option(-ipadx) 237 _positionLabel 238} 239 240# ------------------------------------------------------------------ 241# OPTION: -ipady 242# 243# Specifies the width of the vertical gap from the border to the 244# the child site. 245# ------------------------------------------------------------------ 246itcl::configbody iwidgets::Labeledframe::ipady { 247 grid configure $itk_component(childsite) -pady $itk_option(-ipady) 248 _positionLabel 249} 250 251# ----------------------------------------------------------------------------- 252# OPTION: -labelmargin 253# 254# Set the margin of the most adjacent side of the label to the hull 255# relief. 256# ---------------------------------------------------------------------------- 257itcl::configbody iwidgets::Labeledframe::labelmargin { 258 _positionLabel 259} 260 261# ----------------------------------------------------------------------------- 262# OPTION: -labelpos 263# 264# Set the position of the label within the relief of the hull frame 265# widget. 266# ---------------------------------------------------------------------------- 267itcl::configbody iwidgets::Labeledframe::labelpos { 268 _positionLabel 269} 270 271# ----------------------------------------------------------------------------- 272# PROCS 273# ----------------------------------------------------------------------------- 274 275# ----------------------------------------------------------------------------- 276# PRIVATE PROC: _initTable 277# 278# Initializes the _LAYOUT_TABLE common variable of the Labeledframe 279# class. The initialization is performed in its own proc ( as opposed 280# to in the class definition ) so that the initialization occurs only 281# once. 282# 283# _LAYOUT_TABLE common array description: 284# Provides a table of the configuration option values 285# used to place the label widget within the grooved relief of the hull 286# frame for each of the 12 possible "-labelpos" values. 287# 288# Each of the 12 rows is layed out as follows: 289# {"-relx" "-rely" <rowconfigure|columnconfigure> <row/column number>} 290# ----------------------------------------------------------------------------- 291itcl::body iwidgets::Labeledframe::_initTable {} { 292 array set _LAYOUT_TABLE { 293 nw-relx 0.0 nw-rely 0.0 nw-wrap 0 nw-conf rowconfigure nw-num 0 294 n-relx 0.5 n-rely 0.0 n-wrap 0 n-conf rowconfigure n-num 0 295 ne-relx 1.0 ne-rely 0.0 ne-wrap 0 ne-conf rowconfigure ne-num 0 296 297 sw-relx 0.0 sw-rely 1.0 sw-wrap 0 sw-conf rowconfigure sw-num 2 298 s-relx 0.5 s-rely 1.0 s-wrap 0 s-conf rowconfigure s-num 2 299 se-relx 1.0 se-rely 1.0 se-wrap 0 se-conf rowconfigure se-num 2 300 301 en-relx 1.0 en-rely 0.0 en-wrap 1 en-conf columnconfigure en-num 2 302 e-relx 1.0 e-rely 0.5 e-wrap 1 e-conf columnconfigure e-num 2 303 es-relx 1.0 es-rely 1.0 es-wrap 1 es-conf columnconfigure es-num 2 304 305 wn-relx 0.0 wn-rely 0.0 wn-wrap 1 wn-conf columnconfigure wn-num 0 306 w-relx 0.0 w-rely 0.5 w-wrap 1 w-conf columnconfigure w-num 0 307 ws-relx 0.0 ws-rely 1.0 ws-wrap 1 ws-conf columnconfigure ws-num 0 308 } 309 310 # 311 # Since this is a one time only thing, we'll redefine the proc to be empty 312 # afterwards so it only happens once. 313 # 314 # NOTE: Be careful to use the "body" command, or the proc will get lost! 315 # 316 itcl::body ::iwidgets::Labeledframe::_initTable {} {} 317} 318 319# ----------------------------------------------------------------------------- 320# METHODS 321# ----------------------------------------------------------------------------- 322 323# ----------------------------------------------------------------------------- 324# PUBLIC METHOD:: childsite 325# 326# ----------------------------------------------------------------------------- 327itcl::body iwidgets::Labeledframe::childsite {} { 328 return $itk_component(childsite) 329} 330 331# ----------------------------------------------------------------------------- 332# PROTECTED METHOD: _positionLabel ?when? 333# 334# Places the label in the relief of the hull. If "when" is "now", the 335# change is applied immediately. If it is "later" or it is not 336# specified, then the change is applied later, when the application 337# is idle. 338# ----------------------------------------------------------------------------- 339itcl::body iwidgets::Labeledframe::_positionLabel {{when later}} { 340 341 if {$when == "later"} { 342 if {$_reposition == ""} { 343 set _reposition [after idle [itcl::code $this _positionLabel now]] 344 } 345 return 346 } 347 348 set pos $itk_option(-labelpos) 349 350 # 351 # If there is not an entry for the "relx" value associated with 352 # the given "-labelpos" option value, then it invalid. 353 # 354 if { [catch {set relx $_LAYOUT_TABLE($pos-relx)}] } { 355 error "bad labelpos option\"$itk_option(-labelpos)\": should be\ 356 nw, n, ne, sw, s, se, en, e, es, wn, w, or ws" 357 } 358 359 update idletasks 360 $itk_component(label) configure -wraplength $_LAYOUT_TABLE($pos-wrap) 361 set labelWidth [winfo reqwidth $itk_component(label)] 362 set labelHeight [winfo reqheight $itk_component(label)] 363 set borderwidth $itk_option(-borderwidth) 364 set margin $itk_option(-labelmargin) 365 366 switch $pos { 367 nw { 368 set labelThickness $labelHeight 369 set minsize [expr {$labelThickness/2.0}] 370 set xPos [expr {$minsize+$borderwidth+$margin}] 371 set yPos -$minsize 372 } 373 n { 374 set labelThickness $labelHeight 375 set minsize [expr {$labelThickness/2.0}] 376 set xPos [expr {-$labelWidth/2.0}] 377 set yPos -$minsize 378 } 379 ne { 380 set labelThickness $labelHeight 381 set minsize [expr {$labelThickness/2.0}] 382 set xPos [expr {-($minsize+$borderwidth+$margin+$labelWidth)}] 383 set yPos -$minsize 384 } 385 386 sw { 387 set labelThickness $labelHeight 388 set minsize [expr {$labelThickness/2.0}] 389 set xPos [expr {$minsize+$borderwidth+$margin}] 390 set yPos -$minsize 391 } 392 s { 393 set labelThickness $labelHeight 394 set minsize [expr {$labelThickness/2.0}] 395 set xPos [expr {-$labelWidth/2.0}] 396 set yPos [expr {-$labelHeight/2.0}] 397 } 398 se { 399 set labelThickness $labelHeight 400 set minsize [expr {$labelThickness/2.0}] 401 set xPos [expr {-($minsize+$borderwidth+$margin+$labelWidth)}] 402 set yPos [expr {-$labelHeight/2.0}] 403 } 404 405 wn { 406 set labelThickness $labelWidth 407 set minsize [expr {$labelThickness/2.0}] 408 set xPos -$minsize 409 set yPos [expr {$minsize+$margin+$borderwidth}] 410 } 411 w { 412 set labelThickness $labelWidth 413 set minsize [expr {$labelThickness/2.0}] 414 set xPos -$minsize 415 set yPos [expr {-($labelHeight/2.0)}] 416 } 417 ws { 418 set labelThickness $labelWidth 419 set minsize [expr {$labelThickness/2.0}] 420 set xPos -$minsize 421 set yPos [expr {-($minsize+$borderwidth+$margin+$labelHeight)}] 422 } 423 424 en { 425 set labelThickness $labelWidth 426 set minsize [expr {$labelThickness/2.0}] 427 set xPos -$minsize 428 set yPos [expr {$minsize+$borderwidth+$margin}] 429 } 430 e { 431 set labelThickness $labelWidth 432 set minsize [expr {$labelThickness/2.0}] 433 set xPos -$minsize 434 set yPos [expr {-($labelHeight/2.0)}] 435 } 436 es { 437 set labelThickness $labelWidth 438 set minsize [expr {$labelThickness/2.0}] 439 set xPos -$minsize 440 set yPos [expr {-($minsize+$borderwidth+$margin+$labelHeight)}] 441 } 442 } 443 _setMarginThickness $minsize 444 445 place $itk_component(label) \ 446 -relx $_LAYOUT_TABLE($pos-relx) -x $xPos \ 447 -rely $_LAYOUT_TABLE($pos-rely) -y $yPos \ 448 -anchor nw 449 450 set what $_LAYOUT_TABLE($pos-conf) 451 set number $_LAYOUT_TABLE($pos-num) 452 453 grid $what $itk_interior $number -minsize $minsize 454 455 set _reposition "" 456} 457 458# ----------------------------------------------------------------------------- 459# PROTECTED METHOD: _collapseMargin 460# 461# Resets the "-minsize" of all rows and columns of the hull's grid 462# used to set the label margin to 0 463# ----------------------------------------------------------------------------- 464itcl::body iwidgets::Labeledframe::_collapseMargin {} { 465 grid columnconfigure $itk_interior 0 -minsize 0 466 grid columnconfigure $itk_interior 2 -minsize 0 467 grid rowconfigure $itk_interior 0 -minsize 0 468 grid rowconfigure $itk_interior 2 -minsize 0 469} 470 471# ----------------------------------------------------------------------------- 472# PROTECTED METHOD: _setMarginThickness 473# 474# Set the margin thickness ( i.e. the hidden "-highlightthickness" 475# of the hull ) to the input value. 476# 477# The "-highlightthickness" option of the hull frame is not intended to be 478# configured by users of this class, but does need to be configured to properly 479# place the label whenever the label is configured. 480# 481# Therefore, since I can't find a better way at this time, I achieve this 482# configuration by: adding the "-highlightthickness" option back into 483# the hull frame; configuring the "-highlightthickness" option to properly 484# place the label; and then remove the "-highlightthickness" option from the 485# hull. 486# 487# This way the option is not visible or configurable without some hacking. 488# 489# ----------------------------------------------------------------------------- 490itcl::body iwidgets::Labeledframe::_setMarginThickness {value} { 491 itk_option add hull.highlightthickness 492 $itk_component(hull) configure -highlightthickness $value 493 itk_option remove hull.highlightthickness 494} 495 496 497