Как напечатать выбранное значение с помощью флажка в Tkx - PullRequest
0 голосов
/ 04 декабря 2011

Я использую модуль Tkx для создания окна, заполненного текстовыми значениями из @list. Затем я выбираю один или более чем один с помощью кнопки. Я хочу напечатать уже выбранные после нажатия кнопки «ОК», но не знаю, как передать переменные в «ОК» -команду => sub {}. Спасибо.

use autodie;
use strict;
use warnings;
use Tkx;

my $mw = Tkx::widget->new( "." );
$mw->g_wm_title( "Listbox" );
$mw->m_configure( -background => "#191919" );

my $width = '700';
my $height = '500';

Tkx::update('idletasks'); 
$width  ||= Tkx::winfo('reqwidth',  $mw); 
$height ||= Tkx::winfo('reqheight', $mw); 

my $x = int((Tkx::winfo('screenwidth',  $mw) / 2) - ($width / 2)); 
my $y = int((Tkx::winfo('screenheight', $mw) / 2) - ($height / 2)); 

$mw->g_wm_geometry($width . "x" . $height . "+" . $x . "+" . $y);

my @list = ('TEXT1', 'TEXT2', 'TEXT3', 'TEXT4', 'TEXT5');

for my $list (@list) {
    my $cb = $mw->new_ttk__checkbutton(
        -text => $list,
        -onvalue => 1,
        -offvalue => 0,
    );
    $cb->g_pack(
        -anchor=>'w',
        -side=>'top',
        -fill => 'x'
    );
 }

 my $ok = $mw->new_button(
    -text => "OK",
    -command => sub {       
        print "Selected Values";
        Tkx::after(500, sub { $mw->g_destroy });
    },
);

$ok->g_pack(
   -anchor=>'c',
   -side=>'bottom',
);

Tkx::MainLoop();

1 Ответ

0 голосов
/ 04 декабря 2011

Если вы просто хотите узнать, какие флажки установлены:

my $settings;
for my $list (@list) {
    my $cb = $mw->new_ttk__checkbutton(
        -text => $list,
        -onvalue => 1,
        -offvalue => 0,
        -variable => \$settings->{checkbuttons}->{$list},
    );
    $cb->g_pack(
        -anchor=>'w',
        -side=>'top',
        -fill => 'x'
    );
 }

 my $ok = $mw->new_button(
    -text => "OK",
    -command => sub {       
        print "Selected Values: [";

        print join( ", ", grep { $settings->{checkbuttons}->{$_} } @list ), "]\n";
        Tkx::after(500, sub { $mw->g_destroy });
    },
);
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...