source: trunk/BWidget-1.2.1/labelframe.tcl @ 931

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

include rest of files

File size: 5.7 KB
RevLine 
[931]1# ------------------------------------------------------------------------------
2#  labelframe.tcl
3#  This file is part of Unifix BWidget Toolkit
4#  $Id: labelframe.tcl,v 1.4 1999/07/09 11:49:17 eric Exp $
5# ------------------------------------------------------------------------------
6#  Index of commands:
7#     - LabelFrame::create
8#     - LabelFrame::getframe
9#     - LabelFrame::configure
10#     - LabelFrame::cget
11#     - LabelFrame::align
12# ------------------------------------------------------------------------------
13
14namespace eval LabelFrame {
15    Label::use
16
17    Widget::bwinclude LabelFrame Label .l \
18        remove     {
19            -highlightthickness -highlightcolor -highlightbackground
20            -takefocus -relief -borderwidth
21            -bitmap -image -cursor -textvariable
22            -dragenabled -draginitcmd -dragendcmd -dragevent -dragtype
23            -dropenabled -droptypes -dropovercmd  -dropcmd} \
24        initialize {-anchor w}
25
26    Widget::declare LabelFrame {
27        {-relief      TkResource flat 0 frame}
28        {-borderwidth TkResource 0    0 frame}
29        {-side        Enum       left 1 {left right top bottom}}
30        {-bd          Synonym    -borderwidth}
31    }
32
33    Widget::addmap LabelFrame "" :cmd {-background {}}
34    Widget::addmap LabelFrame "" .f   {-background {} -relief {} -borderwidth {}}
35
36    Widget::syncoptions LabelFrame Label .l {-text {} -underline {}}
37
38    bind BwLabelFrame <FocusIn> {Label::setfocus %W.l}
39    bind BwLabelFrame <Destroy> {Widget::destroy %W; rename %W {}}
40
41    proc ::LabelFrame { path args } { return [eval LabelFrame::create $path $args] }
42    proc use {} {}
43}
44
45
46# ------------------------------------------------------------------------------
47#  Command LabelFrame::create
48# ------------------------------------------------------------------------------
49proc LabelFrame::create { path args } {
50    Widget::init LabelFrame $path $args
51
52    set path  [frame $path -background [Widget::getoption $path -background] \
53                   -relief flat -bd 0 -takefocus 0 -highlightthickness 0]
54
55    set label [eval Label::create $path.l [Widget::subcget $path .l] \
56                   -takefocus 0 -highlightthickness 0 -relief flat -borderwidth 0 \
57                   -dropenabled 0 -dragenabled 0]
58    set frame [eval frame $path.f [Widget::subcget $path .f] \
59                   -highlightthickness 0 -takefocus 0]
60
61    switch  [Widget::getoption $path -side] {
62        left   {set packopt "-side left"}
63        right  {set packopt "-side right"}
64        top    {set packopt "-side top -fill x"}
65        bottom {set packopt "-side bottom -fill x"}
66    }
67
68    eval pack $label $packopt
69    pack $frame -fill both -expand yes
70
71    bindtags $path [list $path BwLabelFrame [winfo toplevel $path] all]
72
73    rename $path ::$path:cmd
74    proc ::$path { cmd args } "return \[eval LabelFrame::\$cmd $path \$args\]"
75
76    return $path
77}
78
79
80# ------------------------------------------------------------------------------
81#  Command LabelFrame::getframe
82# ------------------------------------------------------------------------------
83proc LabelFrame::getframe { path } {
84    return $path.f
85}
86
87
88# ------------------------------------------------------------------------------
89#  Command LabelFrame::configure
90# ------------------------------------------------------------------------------
91proc LabelFrame::configure { path args } {
92    return [Widget::configure $path $args]
93}
94
95
96# ------------------------------------------------------------------------------
97#  Command LabelFrame::cget
98# ------------------------------------------------------------------------------
99proc LabelFrame::cget { path option } {
100    return [Widget::cget $path $option]
101}
102
103
104# ------------------------------------------------------------------------------
105#  Command LabelFrame::align
106#  This command align label of all widget given by args of class LabelFrame
107#  (or "derived") by setting their width to the max one +1
108# ------------------------------------------------------------------------------
109proc LabelFrame::align { args } {
110    set maxlen 0
111    set wlist  {}
112    foreach wl $args {
113        foreach w $wl {
114            if { ![info exists Widget::_class($w)] } {
115                continue
116            }
117            set class $Widget::_class($w)
118            if { ![string compare $class "LabelFrame"] } {
119                set textopt  -text
120                set widthopt -width
121            } else {
122                upvar 0 Widget::${class}::map classmap
123                set textopt  ""
124                set widthopt ""
125                set notdone  2
126                foreach {option lmap} [array get classmap] {
127                    foreach {subpath subclass realopt} $lmap {
128                        if { ![string compare $subclass "LabelFrame"] } {
129                            if { ![string compare $realopt "-text"] } {
130                                set textopt $option
131                                incr notdone -1
132                                break
133                            }
134                            if { ![string compare $realopt "-width"] } {
135                                set widthopt $option
136                                incr notdone -1
137                                break
138                            }
139                        }
140                    }
141                    if { !$notdone } {
142                        break
143                    }
144                }
145                if { $notdone } {
146                    continue
147                }
148            }
149            set len [string length [$w cget $textopt]]
150            if { $len > $maxlen } {
151                set maxlen $len
152            }
153            lappend wlist $w $widthopt
154        }
155    }
156    incr maxlen
157    foreach {w widthopt} $wlist {
158        $w configure $widthopt $maxlen
159    }
160}
Note: See TracBrowser for help on using the repository browser.