source: trunk/BWidget-1.2.1/titleframe.tcl

Last change on this file was 931, checked in by toby, 11 years ago

include rest of files

File size: 5.7 KB
Line 
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::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# ------------------------------------------------------------------------------
44proc 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# ------------------------------------------------------------------------------
95proc 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# ------------------------------------------------------------------------------
115proc TitleFrame::cget { path option } {
116    return [Widget::cget $path $option]
117}
118
119
120# ------------------------------------------------------------------------------
121#  Command TitleFrame::getframe
122# ------------------------------------------------------------------------------
123proc TitleFrame::getframe { path } {
124    return $path.f
125}
126
127
128# ------------------------------------------------------------------------------
129#  Command TitleFrame::_place
130# ------------------------------------------------------------------------------
131proc 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
Note: See TracBrowser for help on using the repository browser.