转自:http://bbs.chinaunix.net/thread-3591026-1-1.html
#!perl -w
use Tk;
$mw = MainWindow->new;
$mw->title( 'Tk' );
$FRAME_L = $mw->Frame->pack(qw/-side left -fill both/);
$WIDGET_F = $FRAME_L->Labelframe()->pack(qw/-side top -fill both -expand 1/);
my %section = (
A => [1,2,3],
B => [4,5,6],
C => [7,8,9],
);
my (@frames,@button);
for my $sect_name (sort keys %section) {
my $b;
my $f = $WIDGET_F->Frame(
-bg => 'green',
-relief => 'sunken',
-borderwidth => 1
);
$b = $WIDGET_F->Radiobutton(
-text => $sect_name,
-indicatoron => 0,
-value => $sect_name,
-width => 25,
-bg => '#af1a3c6a6872',
-fg => 'white',
-command => sub {
$_->packForget for @frames;
$f->pack(
-after => $b,
qw/-side top -fill both -expand 1 -padx 1 -pady 1/
);
}
)->pack(qw/-fill x -side top -padx 1 -pady 1/);
for my $par_tmp (@{ $section{$sect_name} }) {
$f->Button(
-text => "$par_tmp",
-relief => 'ridge',
-bg => '#8189ce14cf5b',
-fg => 'black',
)->pack(qw/-side top -fill x -padx 4 /);
}
push @frames,$f;
push @button,$b;
}
$FRAME_L->Button(
-text => "CLOSE",
-relief => 'sunken',
-borderwidth => 1,
-bg => "white",
-fg => "black",
-command => sub { exit; },
)->pack(qw/-side bottom -fill x -padx 1 -pady 2 /);
MainLoop;
Perl TK 抽屉式组件
最新推荐文章于 2024-03-13 18:55:02 发布