summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/labelframe.pl
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 15:05:13 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2011-02-17 15:05:13 +0000
commit9fc19ef8e2dcd8bcf6a1d034b95c1de2b88e485c (patch)
treeee28de37fe0de6137d535fee2e64ecafaffefb91 /Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/labelframe.pl
parent73b942cfb4ccf168f9c2b7f20a289b06f1f54a4b (diff)
New tlperl part II
git-svn-id: svn://tug.org/texlive/trunk@21424 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/labelframe.pl')
-rw-r--r--Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/labelframe.pl74
1 files changed, 74 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/labelframe.pl b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/labelframe.pl
new file mode 100644
index 00000000000..17d191a7c9b
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Tk/demos/widget_lib/labelframe.pl
@@ -0,0 +1,74 @@
+# labelframe.pl
+
+use vars qw/$TOP/;
+
+sub labelframe {
+
+ # Create a top-level window that displays several Labelframe widgets.
+
+ my($demo) = @_;
+ $TOP = $MW->WidgetDemo(
+ -geometry_manager => 'grid',
+ -name => $demo,
+ -text => 'Labelframes are used to group related widgets together. The label maybe either plain text or another widget.',
+ -title => 'Labelframe Demonstration',
+ -iconname => 'labelframe',
+ );
+
+ # A group of radiobuttons in a labelframe
+
+ my $lf1 = $TOP->Labelframe(qw/-text Value -padx 2 -pady 2/);
+ $lf1->grid(qw/-row 0 -column 0 -pady 2m -padx 2m/);
+
+ my $lfdummy;
+ foreach my $value (1 .. 4) {
+ $lf1->Radiobutton(
+ -text => "This is value $value" ,
+ -variable => \$lfdummy,
+ -value => $value,
+ )->pack(qw/-side top -fill x -pady 2/);
+ }
+
+ # A label window controlling a group of options.
+
+ my $lf2 = $TOP->Labelframe(qw/-pady 2 -padx 2/);
+ $lf2->grid(qw/-row 0 -column 1 -pady 2m -padx 2m/);
+ my $lfdummy2;
+ my $cb;
+ $cb = $lf2->Checkbutton(
+ -text => 'Use this option',
+ -variable => \$lfdummy2,
+ -command => sub {&labelframe_buttons($lf2, $cb, \$lfdummy2)},
+ -padx => 0,
+ );
+ $lf2->configure(-labelwidget => $cb);
+
+ foreach my $str (qw/Option1 Option2 Option3/) {
+ $lf2->Checkbutton(-text => $str)->pack(qw/-side top -fill x -pady 2/);
+ }
+
+ &labelframe_buttons($lf2, $cb, \$lfdummy2);
+
+ $TOP->gridColumnconfigure([0, 1], -weight => 1);
+
+} # end labelframe
+
+sub labelframe_buttons {
+
+ # The state of the sub-Checkbuttons is dependent upon the state of
+ # the master -labelwidget Checkbutton.
+
+ my ($lf, $cb, $var_ref) = @_;
+
+ foreach my $child ($lf->children) {
+ next if $child == $cb;
+ if ($$var_ref) {
+ $child->configure(qw/-state normal/);
+ } else {
+ $child->configure(qw/-state disabled/);
+ }
+ }
+
+} # end labelframe_buttons
+
+1;