in reply to Icon generation on the fly

Does this look interesting? Use a here doc to define an XPM, then convert to icon. 
#!/usr/bin/perl
use warnings;
use strict;
use Tk;

# by Ch Lambrecht

my $logo = <<'logo_end';
/* XPM */
static char * logo_xpm[] = {
"32 32 5 1",
"     c None",
".    c #FD000A",
"+    c #FD6463",
"@    c #FEBEBE",
"#    c #FEFFFC",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"########........##.....@########",
"#########@....+####@.###########",
"##########+....@###.@###########",
"###########.....##++############",
"###########@....+@.#############",
"############+.....@#############",
"#############.....##############",
"#############@....@#############",
"#############@.....#############",
"#############.+....+############",
"############++#+....@###########",
"###########@.###.....###########",
"###########.@###@....+##########",
"##########++#####+....@#########",
"########+....###........########",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################",
"################################"};
logo_end
;
package Tk::Toplevel;

sub InitObject{
     my ($self,$args) = @_;
     $self->SUPER::InitObject($args);
     my $mw = $self;
     while ($mw->parent){$mw = $mw->parent}
     if ($mw->cget('-appicon')){
         $self->afterIdle(sub{$self->iconimage($mw->cget('-appicon'))}
+) ;
     }
}

package MainWindow;
sub Populate{
     my ($self,$args) = @_;

     $self->SUPER::Populate($args);
     $self->ConfigSpecs(-appicondata => ['METHOD'],
                        -appiconfile => ['METHOD'],
                        -appicon     => ['PASSIVE']
                    );
     $self->configure(%$args);
     }

sub appicondata{
     my $self = shift;
     $self->configure(-appicon => $self->Pixmap(-data=>$_[0]));

}
sub appiconfile{
     my $self = shift;
     $self->configure('-appicon' => $self->Pixmap(-file=>$_[0]));
}



package main;

#my $mw = MainWindow->new(-appiconfile => 'logo.xpm');
my $mw = MainWindow->new(-appicondata => $logo);
$mw->Toplevel();
my $tp = $mw->Toplevel();


MainLoop;

[download]
I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Replies are listed 'Best First'.
Re^2: Icon generation on the fly
by chessgui (Scribe) on Jan 31, 2012 at 17:55 UTC
    This app seems to override some Tk methods. Is it possible in your view to create a windowless Toplevel ( I mean with no edges, title bar etc. just a plain widget: say a canvas )?
[reply]
      mean with no edges, title bar etc. just a plain widget: say a canvas

      Something like this? 

      #!/usr/bin/perl -w
use warnings;
use strict;
use Tk;
use Tk::LabEntry;

my $mw = MainWindow->new;
my $vh = $mw->vrootheight;
my $vw = $mw->vrootwidth;

# this is what grabs all virtual desktops
$mw->overrideredirect(1);

# Note that the 'virtual window' height and width are $vh and $vw
# respectively, so we use those dimensions for our Canvas height 
# and width, and let the Canvas expand and fill in both x and y
# directions.
#
my $canvas = $mw->Canvas(
   -width => $vw, 
   -height => $vh, 
   -background =>'blue',
   -takefocus =>0
   ); # so canvas dosn't take focus on tab press

$canvas->pack(-expand => 1, -fill => 'both');

#just for fun instead of an image
$canvas->createRectangle(100, 100, 150, 150, -fill => 'orange'); 

my $window = 
    $canvas->Button(-text=> 'Ok',
               -command=> sub{ exit;}
    );

$canvas->createWindow($vw/2, $vh/2,
          -window=> $window );

MainLoop;

      [download]
      I'm not really a human, but I play one on earth.
      Old Perl Programmer Haiku ................... flash japh
[reply]
[d/l]
        Boy, this is cool. It has gray edges (where does this gray come from? the color for window edges and title bars generated for toplevel windows by Win32 is blue on my system) but other than that it is a plain canvas as a Toplevel.
[reply]

In Section Seekers of Perl Wisdom