1# ------------------------------------------------------------------------------ 2# titleframe.tcl 3# This file is part of Unifix BWidget Toolkit 4# ------------------------------------------------------------------------------ 5# Index of commands: 6# - TitleFrame::create 7# - TitleFrame::configure 8# - TitleFrame::cget 9# - TitleFrame::getframe 10# - TitleFrame::_place 11# ------------------------------------------------------------------------------ 12 13namespace eval TitleFrame { 14 Widget::define TitleFrame titleframe 15 16 Widget::declare TitleFrame { 17 {-relief TkResource groove 0 frame} 18 {-borderwidth TkResource 2 0 frame} 19 {-font TkResource "" 0 label} 20 {-foreground TkResource "" 0 label} 21 {-state TkResource "" 0 label} 22 {-background TkResource "" 0 frame} 23 {-text String "" 0} 24 {-ipad Int 4 0 "%d >=0"} 25 {-side Enum left 0 {left center right}} 26 {-baseline Enum center 0 {top center bottom}} 27 {-fg Synonym -foreground} 28 {-bg Synonym -background} 29 {-bd Synonym -borderwidth} 30 } 31 32 Widget::addmap TitleFrame "" :cmd {-background {}} 33 Widget::addmap TitleFrame "" .l { 34 -background {} -foreground {} -text {} -font {} 35 } 36 Widget::addmap TitleFrame "" .l {-state {}} 37 Widget::addmap TitleFrame "" .p {-background {}} 38 Widget::addmap TitleFrame "" .b { 39 -background {} -relief {} -borderwidth {} 40 } 41 Widget::addmap TitleFrame "" .b.p {-background {}} 42 Widget::addmap TitleFrame "" .f {-background {}} 43} 44 45 46# ------------------------------------------------------------------------------ 47# Command TitleFrame::create 48# ------------------------------------------------------------------------------ 49proc TitleFrame::create { path args } { 50 Widget::init TitleFrame $path $args 51 52 set frame [eval [list frame $path] [Widget::subcget $path :cmd] \ 53 -class TitleFrame -relief flat -bd 0 -highlightthickness 0] 54 55 set padtop [eval [list frame $path.p] [Widget::subcget $path :cmd] \ 56 -relief flat -borderwidth 0] 57 set border [eval [list frame $path.b] [Widget::subcget $path .b] -highlightthickness 0] 58 set label [eval [list label $path.l] [Widget::subcget $path .l] \ 59 -highlightthickness 0 \ 60 -relief flat \ 61 -bd 0 -padx 2 -pady 0] 62 set padbot [eval [list frame $border.p] [Widget::subcget $path .p] \ 63 -relief flat -bd 0 -highlightthickness 0] 64 set frame [eval [list frame $path.f] [Widget::subcget $path .f] \ 65 -relief flat -bd 0 -highlightthickness 0] 66 set height [winfo reqheight $label] 67 68 switch [Widget::getoption $path -side] { 69 left { set relx 0.0; set x 5; set anchor nw } 70 center { set relx 0.5; set x 0; set anchor n } 71 right { set relx 1.0; set x -5; set anchor ne } 72 } 73 set bd [Widget::getoption $path -borderwidth] 74 switch [Widget::getoption $path -baseline] { 75 top { 76 set y 0 77 set htop $height 78 set hbot 1 79 } 80 center { 81 set y 0 82 set htop [expr {$height/2}] 83 set hbot [expr {$height/2+$height%2+1}] 84 } 85 bottom { 86 set y [expr {$bd+1}] 87 set htop 1 88 set hbot $height 89 } 90 } 91 $padtop configure -height $htop 92 $padbot configure -height $hbot 93 94 set pad [Widget::getoption $path -ipad] 95 pack $padbot -side top -fill x 96 pack $frame -in $border -fill both -expand yes -padx $pad -pady $pad 97 98 pack $padtop -side top -fill x 99 pack $border -fill both -expand yes 100 101 place $label -relx $relx -x $x -anchor $anchor -y $y 102 103 bind $label <Configure> [list TitleFrame::_place $path] 104 bind $path <Destroy> [list Widget::destroy %W] 105 106 return [Widget::create TitleFrame $path] 107} 108 109 110# ------------------------------------------------------------------------------ 111# Command TitleFrame::configure 112# ------------------------------------------------------------------------------ 113proc TitleFrame::configure { path args } { 114 set res [Widget::configure $path $args] 115 116 if { [Widget::hasChanged $path -ipad pad] } { 117 pack configure $path.f -padx $pad -pady $pad 118 } 119 if { [Widget::hasChanged $path -borderwidth val] | 120 [Widget::hasChanged $path -font val] | 121 [Widget::hasChanged $path -side val] | 122 [Widget::hasChanged $path -baseline val] } { 123 _place $path 124 } 125 126 return $res 127} 128 129 130# ------------------------------------------------------------------------------ 131# Command TitleFrame::cget 132# ------------------------------------------------------------------------------ 133proc TitleFrame::cget { path option } { 134 return [Widget::cget $path $option] 135} 136 137 138# ------------------------------------------------------------------------------ 139# Command TitleFrame::getframe 140# ------------------------------------------------------------------------------ 141proc TitleFrame::getframe { path } { 142 return $path.f 143} 144 145 146# ------------------------------------------------------------------------------ 147# Command TitleFrame::_place 148# ------------------------------------------------------------------------------ 149proc TitleFrame::_place { path } { 150 set height [winfo height $path.l] 151 switch [Widget::getoption $path -side] { 152 left { set relx 0.0; set x 10; set anchor nw } 153 center { set relx 0.5; set x 0; set anchor n } 154 right { set relx 1.0; set x -10; set anchor ne } 155 } 156 set bd [Widget::getoption $path -borderwidth] 157 switch [Widget::getoption $path -baseline] { 158 top { set htop $height; set hbot 1; set y 0 } 159 center { set htop [expr {$height/2}]; set hbot [expr {$height/2+$height%2+1}]; set y 0 } 160 bottom { set htop 1; set hbot $height; set y [expr {$bd+1}] } 161 } 162 $path.p configure -height $htop 163 $path.b.p configure -height $hbot 164 165 place $path.l -relx $relx -x $x -anchor $anchor -y $y 166} 167 168 169 170 171