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