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