1# 2# Labeledwidget 3# ---------------------------------------------------------------------- 4# Implements a labeled widget which contains a label and child site. 5# The child site is a frame which can filled with any widget via a 6# derived class or though the use of the childsite method. This class 7# was designed to be a general purpose base class for supporting the 8# combination of label widget and a childsite, where a label may be 9# text, bitmap or image. The options include the ability to position 10# the label around the childsite widget, modify the font and margin, 11# and control the display of the label. 12# 13# ---------------------------------------------------------------------- 14# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com 15# 16# @(#) $Id: labeledwidget.itk,v 1.4 2001/08/20 20:02:53 smithc Exp $ 17# ---------------------------------------------------------------------- 18# Copyright (c) 1995 DSC Technologies Corporation 19# ====================================================================== 20# Permission to use, copy, modify, distribute and license this software 21# and its documentation for any purpose, and without fee or written 22# agreement with DSC, is hereby granted, provided that the above copyright 23# notice appears in all copies and that both the copyright notice and 24# warranty disclaimer below appear in supporting documentation, and that 25# the names of DSC Technologies Corporation or DSC Communications 26# Corporation not be used in advertising or publicity pertaining to the 27# software without specific, written prior permission. 28# 29# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING 30# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON- 31# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE 32# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, 33# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL 34# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR 35# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, 36# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, 37# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS 38# SOFTWARE. 39# ====================================================================== 40 41# 42# Usual options. 43# 44itk::usual Labeledwidget { 45 keep -background -cursor -foreground -labelfont 46} 47 48# ------------------------------------------------------------------ 49# LABELEDWIDGET 50# ------------------------------------------------------------------ 51itcl::class iwidgets::Labeledwidget { 52 inherit itk::Widget 53 54 constructor {args} {} 55 destructor {} 56 57 itk_option define -disabledforeground disabledForeground \ 58 DisabledForeground \#a3a3a3 59 itk_option define -labelpos labelPos Position w 60 itk_option define -labelmargin labelMargin Margin 2 61 itk_option define -labeltext labelText Text {} 62 itk_option define -labelvariable labelVariable Variable {} 63 itk_option define -labelbitmap labelBitmap Bitmap {} 64 itk_option define -labelimage labelImage Image {} 65 itk_option define -state state State normal 66 itk_option define -sticky sticky Sticky nsew 67 68 public method childsite 69 70 private method _positionLabel {{when later}} 71 72 proc alignlabels {args} {} 73 74 protected variable _reposition "" ;# non-null => _positionLabel pending 75} 76 77# 78# Provide a lowercased access method for the Labeledwidget class. 79# 80proc ::iwidgets::labeledwidget {pathName args} { 81 uplevel ::iwidgets::Labeledwidget $pathName $args 82} 83 84# ------------------------------------------------------------------ 85# CONSTRUCTOR 86# ------------------------------------------------------------------ 87itcl::body iwidgets::Labeledwidget::constructor {args} { 88 # 89 # Create a frame for the childsite widget. 90 # 91 itk_component add -protected lwchildsite { 92 frame $itk_interior.lwchildsite 93 } 94 95 # 96 # Create label. 97 # 98 itk_component add label { 99 label $itk_interior.label 100 } { 101 usual 102 103 rename -font -labelfont labelFont Font 104 ignore -highlightcolor -highlightthickness 105 } 106 107 # 108 # Set the interior to be the childsite for derived classes. 109 # 110 set itk_interior $itk_component(lwchildsite) 111 112 # 113 # Initialize the widget based on the command line options. 114 # 115 eval itk_initialize $args 116 117 # 118 # When idle, position the label. 119 # 120 _positionLabel 121} 122 123# ------------------------------------------------------------------ 124# DESTRUCTOR 125# ------------------------------------------------------------------ 126itcl::body iwidgets::Labeledwidget::destructor {} { 127 if {$_reposition != ""} {after cancel $_reposition} 128} 129 130# ------------------------------------------------------------------ 131# OPTIONS 132# ------------------------------------------------------------------ 133 134# ------------------------------------------------------------------ 135# OPTION: -disabledforeground 136# 137# Specified the foreground to be used on the label when disabled. 138# ------------------------------------------------------------------ 139itcl::configbody iwidgets::Labeledwidget::disabledforeground {} 140 141# ------------------------------------------------------------------ 142# OPTION: -labelpos 143# 144# Set the position of the label on the labeled widget. The margin 145# between the label and childsite comes along for the ride. 146# ------------------------------------------------------------------ 147itcl::configbody iwidgets::Labeledwidget::labelpos { 148 _positionLabel 149} 150 151# ------------------------------------------------------------------ 152# OPTION: -labelmargin 153# 154# Specifies the distance between the widget and label. 155# ------------------------------------------------------------------ 156itcl::configbody iwidgets::Labeledwidget::labelmargin { 157 _positionLabel 158} 159 160# ------------------------------------------------------------------ 161# OPTION: -labeltext 162# 163# Specifies the label text. 164# ------------------------------------------------------------------ 165itcl::configbody iwidgets::Labeledwidget::labeltext { 166 $itk_component(label) configure -text $itk_option(-labeltext) 167 168 _positionLabel 169} 170 171# ------------------------------------------------------------------ 172# OPTION: -labelvariable 173# 174# Specifies the label text variable. 175# ------------------------------------------------------------------ 176itcl::configbody iwidgets::Labeledwidget::labelvariable { 177 $itk_component(label) configure -textvariable $itk_option(-labelvariable) 178 179 _positionLabel 180} 181 182# ------------------------------------------------------------------ 183# OPTION: -labelbitmap 184# 185# Specifies the label bitmap. 186# ------------------------------------------------------------------ 187itcl::configbody iwidgets::Labeledwidget::labelbitmap { 188 $itk_component(label) configure -bitmap $itk_option(-labelbitmap) 189 190 _positionLabel 191} 192 193# ------------------------------------------------------------------ 194# OPTION: -labelimage 195# 196# Specifies the label image. 197# ------------------------------------------------------------------ 198itcl::configbody iwidgets::Labeledwidget::labelimage { 199 $itk_component(label) configure -image $itk_option(-labelimage) 200 201 _positionLabel 202} 203 204# ------------------------------------------------------------------ 205# OPTION: -sticky 206# 207# Specifies the stickyness of the child site. This option was added 208# by James Bonfield (committed by Chad Smith 8/20/01). 209# ------------------------------------------------------------------ 210itcl::configbody iwidgets::Labeledwidget::sticky { 211 grid $itk_component(lwchildsite) -sticky $itk_option(-sticky) 212} 213 214# ------------------------------------------------------------------ 215# OPTION: -state 216# 217# Specifies the state of the label. 218# ------------------------------------------------------------------ 219itcl::configbody iwidgets::Labeledwidget::state { 220 _positionLabel 221} 222 223# ------------------------------------------------------------------ 224# METHODS 225# ------------------------------------------------------------------ 226 227# ------------------------------------------------------------------ 228# METHOD: childsite 229# 230# Returns the path name of the child site widget. 231# ------------------------------------------------------------------ 232itcl::body iwidgets::Labeledwidget::childsite {} { 233 return $itk_component(lwchildsite) 234} 235 236# ------------------------------------------------------------------ 237# PROCEDURE: alignlabels widget ?widget ...? 238# 239# The alignlabels procedure takes a list of widgets derived from 240# the Labeledwidget class and adjusts the label margin to align 241# the labels. 242# ------------------------------------------------------------------ 243itcl::body iwidgets::Labeledwidget::alignlabels {args} { 244 update 245 set maxLabelWidth 0 246 247 # 248 # Verify that all the widgets are of type Labeledwidget and 249 # determine the size of the maximum length label string. 250 # 251 foreach iwid $args { 252 set objcmd [itcl::find objects -isa Labeledwidget *::$iwid] 253 254 if {$objcmd == ""} { 255 error "$iwid is not a \"Labeledwidget\"" 256 } 257 258 set csWidth [winfo reqwidth $iwid.lwchildsite] 259 set shellWidth [winfo reqwidth $iwid] 260 261 if {($shellWidth - $csWidth) > $maxLabelWidth} { 262 set maxLabelWidth [expr {$shellWidth - $csWidth}] 263 } 264 } 265 266 # 267 # Adjust the margins for the labels such that the child sites and 268 # labels line up. 269 # 270 foreach iwid $args { 271 set csWidth [winfo reqwidth $iwid.lwchildsite] 272 set shellWidth [winfo reqwidth $iwid] 273 274 set labelSize [expr {$shellWidth - $csWidth}] 275 276 if {$maxLabelWidth > $labelSize} { 277 set objcmd [itcl::find objects -isa Labeledwidget *::$iwid] 278 set dist [expr {$maxLabelWidth - \ 279 ($labelSize - [$objcmd cget -labelmargin])}] 280 281 $objcmd configure -labelmargin $dist 282 } 283 } 284} 285 286# ------------------------------------------------------------------ 287# PROTECTED METHOD: _positionLabel ?when? 288# 289# Packs the label and label margin. If "when" is "now", the 290# change is applied immediately. If it is "later" or it is not 291# specified, then the change is applied later, when the application 292# is idle. 293# ------------------------------------------------------------------ 294itcl::body iwidgets::Labeledwidget::_positionLabel {{when later}} { 295 if {$when == "later"} { 296 if {$_reposition == ""} { 297 set _reposition [after idle [itcl::code $this _positionLabel now]] 298 } 299 return 300 301 } elseif {$when != "now"} { 302 error "bad option \"$when\": should be now or later" 303 } 304 305 # 306 # If we have a label, be it text, bitmap, or image continue. 307 # 308 if {($itk_option(-labeltext) != {}) || \ 309 ($itk_option(-labelbitmap) != {}) || \ 310 ($itk_option(-labelimage) != {}) || \ 311 ($itk_option(-labelvariable) != {})} { 312 313 # 314 # Set the foreground color based on the state. 315 # 316 if {[info exists itk_option(-state)]} { 317 switch -- $itk_option(-state) { 318 disabled { 319 $itk_component(label) configure \ 320 -foreground $itk_option(-disabledforeground) 321 } 322 normal { 323 $itk_component(label) configure \ 324 -foreground $itk_option(-foreground) 325 } 326 } 327 } 328 329 set parent [winfo parent $itk_component(lwchildsite)] 330 331 # 332 # Switch on the label position option. Using the grid, 333 # adjust the row/column setting of the label, margin, and 334 # and childsite. The margin height/width is adjust based 335 # on the orientation as well. Finally, set the weights such 336 # that the childsite takes the heat on expansion and shrinkage. 337 # 338 switch $itk_option(-labelpos) { 339 nw - 340 n - 341 ne { 342 grid $itk_component(label) -row 0 -column 0 \ 343 -sticky $itk_option(-labelpos) 344 grid $itk_component(lwchildsite) -row 2 -column 0 \ 345 -sticky $itk_option(-sticky) 346 347 grid rowconfigure $parent 0 -weight 0 -minsize 0 348 grid rowconfigure $parent 1 -weight 0 -minsize \ 349 [winfo pixels $itk_component(label) \ 350 $itk_option(-labelmargin)] 351 grid rowconfigure $parent 2 -weight 1 -minsize 0 352 353 grid columnconfigure $parent 0 -weight 1 -minsize 0 354 grid columnconfigure $parent 1 -weight 0 -minsize 0 355 grid columnconfigure $parent 2 -weight 0 -minsize 0 356 } 357 358 en - 359 e - 360 es { 361 grid $itk_component(lwchildsite) -row 0 -column 0 \ 362 -sticky $itk_option(-sticky) 363 grid $itk_component(label) -row 0 -column 2 \ 364 -sticky $itk_option(-labelpos) 365 366 grid rowconfigure $parent 0 -weight 1 -minsize 0 367 grid rowconfigure $parent 1 -weight 0 -minsize 0 368 grid rowconfigure $parent 2 -weight 0 -minsize 0 369 370 grid columnconfigure $parent 0 -weight 1 -minsize 0 371 grid columnconfigure $parent 1 -weight 0 -minsize \ 372 [winfo pixels $itk_component(label) \ 373 $itk_option(-labelmargin)] 374 grid columnconfigure $parent 2 -weight 0 -minsize 0 375 } 376 377 se - 378 s - 379 sw { 380 grid $itk_component(lwchildsite) -row 0 -column 0 \ 381 -sticky $itk_option(-sticky) 382 grid $itk_component(label) -row 2 -column 0 \ 383 -sticky $itk_option(-labelpos) 384 385 grid rowconfigure $parent 0 -weight 1 -minsize 0 386 grid rowconfigure $parent 1 -weight 0 -minsize \ 387 [winfo pixels $itk_component(label) \ 388 $itk_option(-labelmargin)] 389 grid rowconfigure $parent 2 -weight 0 -minsize 0 390 391 grid columnconfigure $parent 0 -weight 1 -minsize 0 392 grid columnconfigure $parent 1 -weight 0 -minsize 0 393 grid columnconfigure $parent 2 -weight 0 -minsize 0 394 } 395 396 wn - 397 w - 398 ws { 399 grid $itk_component(lwchildsite) -row 0 -column 2 \ 400 -sticky $itk_option(-sticky) 401 grid $itk_component(label) -row 0 -column 0 \ 402 -sticky $itk_option(-labelpos) 403 404 grid rowconfigure $parent 0 -weight 1 -minsize 0 405 grid rowconfigure $parent 1 -weight 0 -minsize 0 406 grid rowconfigure $parent 2 -weight 0 -minsize 0 407 408 grid columnconfigure $parent 0 -weight 0 -minsize 0 409 grid columnconfigure $parent 1 -weight 0 -minsize \ 410 [winfo pixels $itk_component(label) \ 411 $itk_option(-labelmargin)] 412 grid columnconfigure $parent 2 -weight 1 -minsize 0 413 } 414 415 default { 416 error "bad labelpos option\ 417 \"$itk_option(-labelpos)\": should be\ 418 nw, n, ne, sw, s, se, en, e, es, wn, w, or ws" 419 } 420 } 421 422 # 423 # Else, neither the label text, bitmap, or image have a value, so 424 # forget them so they don't appear and manage only the childsite. 425 # 426 } else { 427 grid forget $itk_component(label) 428 429 grid $itk_component(lwchildsite) -row 0 -column 0 -sticky $itk_option(-sticky) 430 431 set parent [winfo parent $itk_component(lwchildsite)] 432 433 grid rowconfigure $parent 0 -weight 1 -minsize 0 434 grid rowconfigure $parent 1 -weight 0 -minsize 0 435 grid rowconfigure $parent 2 -weight 0 -minsize 0 436 grid columnconfigure $parent 0 -weight 1 -minsize 0 437 grid columnconfigure $parent 1 -weight 0 -minsize 0 438 grid columnconfigure $parent 2 -weight 0 -minsize 0 439 } 440 441 # 442 # Reset the resposition flag. 443 # 444 set _reposition "" 445} 446