PerlTkx
で、うまく機能する独自のポップアップを作成しました。
しかし、情報、質問などの組み込みのアイコンを埋め込みたいと思います。
自分のウィジェットでそれを行う方法と方法を知っている人はいますか?
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;
}