here is a small addon: Load once and get the Icon for every Toplevel.
package Tk::ToplevelIcon;
use strict;
use warnings;
my $img_data = <<'img_data';
/* XPM */
static char * kologo_xpm[] = {
"32 32 51 1",
" c None",
". c #F32828",
"+ c #000000",
"@ c #FFFFFF",
"# c #F3F3F3",
"$ c #C2C2C2",
"% c #4C4C4C",
"& c #636363",
"* c #464646",
"= c #4E4E4E",
"- c #F4F4F4",
"; c #AAAAAA",
"> c #161616",
", c #A3A3A3",
"' c #C8C8C8",
") c #A2A2A2",
"! c #FEFEFE",
"~ c #222222",
"{ c #141414",
"] c #F9F9F9",
"^ c #A1A1A1",
"/ c #121212",
"( c #F6F6F6",
"_ c #424242",
": c #818181",
"< c #717171",
"[ c #414141",
"} c #111111",
"| c #010101",
"1 c #E1E1E1",
"2 c #DFDFDF",
"3 c #D4D4D4",
"4 c #E0E0E0",
"5 c #151515",
"6 c #A0A0A0",
"7 c #838383",
"8 c #404040",
"9 c #393939",
"0 c #828282",
"a c #4F4F4F",
"b c #242424",
"c c #9D9D9D",
"d c #232323",
"e c #C3C3C3",
"f c #C4C4C4",
"g c #F32C2C",
"h c #646464",
"i c #F32E2E",
"j c #0E0E0E",
"k c #F5F5F5",
"l c #0D0D0D",
"................................",
"................................",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++@@@@#$%++++@@@&++++*@@@+++..",
"..++@@@@@@@=+++@@-$++++;-@@+++..",
"..++@@++>,@'+++@@)!~++{]^@@+++..",
"..++@@+++/@(+++@@_@:++<@[@@+++..",
"..++@@+++}@(+++@@|12|+34|@@+++..",
"..++@@++56@'+++@@+7@89@0+@@+++..",
"..++@@@@@@@a+++@@+b@6c@d+@@+++..",
"..++@@@@-e%++++@@++f-#e++@@+++g.",
"..++@@+++++++++@@++h@@&++@@+++i.",
"..++@@+++++++++@@++jkkl++@@+++g.",
"..++@@+++++++++@@++++++++@@+++..",
"..++@@+++++++++@@++++++++@@+++..",
"..++@@+++++++++@@++++++++@@+++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"..++++++++++++++++++++++++++++..",
"................................",
"................................"};
img_data
;
use Tk::Toplevel;
package Tk::Toplevel;
my $icon;
sub InitObject{
my ($cw,$args) = @_;
$cw->SUPER::InitObject($args);
$icon = $cw->Pixmap(-data=>$img_data)unless $icon;
# $cw->iconimage($icon);# this causes the window to flicker
# during creation
# let InitObject return first:
$cw->afterIdle(sub{$cw->iconimage($icon)});
}
1;