内置Tkx图标

时间:2013-04-14 00:06:59

标签: perl tkx

在Perl Tkx中,我创建了自己的弹出窗口,效果很好。

但我想嵌入那些内置图标,例如信息,问题。

有谁知道我如何在自己的小工具上做到这一点以及如何做到这一点?

sub PopDialog {
    my ($TITLE, $NOTE, @buttons) = @_;

    my (@butt, $ret);
    my $wait  = 1;
    my $xwm   = Tkx::widget->new(".");
    my $popwm = $xwm->new_toplevel();

    $popwm->g_wm_title("$TITLE");
    $popwm->g_wm_minsize(200, 10);
    $popwm->g_wm_resizable(0, 0);

    my $back = $popwm->new_ttk__frame(-padding => "5 5 5 5");
    $back->g_grid(-column => 0, -row => 0, -sticky => "n");

    $popwm->g_grid_columnconfigure(0, -weight => 1);
    $popwm->g_grid_rowconfigure(0, -weight => 1);

    if ($NOTE !~ /^$/) {
        my $frm0 = $back->new_ttk__frame(-padding => 5);
        my $label = $frm0->new_ttk__label(-text => "$NOTE", -font => 'logo_font')->
                g_grid(-column => 0, -row => 0);
        $frm0->g_pack();
    }

    my $frm1 = $back->new_ttk__frame(-padding => 5);

    for my $x (0 .. $#buttons) {
        $butt[$x] = $frm1->new_ttk__button(
            -text      => "$buttons[$x]",
            -underline => 0,
            -command   => sub { $ret = "$buttons[$x]"; $wait = 0; }
        )->g_grid(-column => $x, -row => 0);
    }

    $frm1->g_pack();
    $popwm->g_wm_protocol(WM_DELETE_WINDOW => sub { $ret = "Exit"; $wait = 0; });    # Close Button returns "Exit"
    $popwm->g_bind('<Unmap>', sub { $popwm->g_wm_deiconify; $xwm->g_focus; });    # No minimizing to Icon Allowed

    while ($wait) {
        Tkx::update();
        $popwm->g_focus;
    }

    $popwm->g_destroy;

    return $ret;
}

0 个答案:

没有答案
相关问题