Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"


by zentara (Archbishop)
on Oct 07, 2004 at 20:13 UTC ( #397432=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info
Description: Qumsieh's response in Button graphics for Tk prompted me to make a little programmer's helper, for selecting icons and cut-&-pasting them into your code. Please read the LICENSE since these are TCL ICONS from ICONS

I have just put them into a convenient form for selecting and pasting into your code. This file has over 600K of icons. It is available at zicons


use warnings;
use strict;
use Tk;
use Tk::NoteBook;
use Tk::Pane;
use Tk::DialogBox;

my $mw = new MainWindow;

my @files  = qw/standard crystal ikons kde klassic sat slick /;
my %page;

my $topframe = $mw->Frame(-background => 'lightsteelblue')
                   ->pack( -fill =>'x');

my $topframe1 = $mw->Frame(-background => 'skyblue')
                   ->pack( -fill =>'x');

$topframe->Label(-text=>'Left Click - copy&paste',
                        -background=> 'lightsteelblue')
                       ->pack(-side =>'left',-padx=>20);

$topframe->Button(-text    => 'Exit',
            -command => sub{Tk::exit}  )->pack(-side =>'right',-padx=>

my $selected = 'No Selection';
    $topframe1->Label( -width => 30,
                       -textvariable => \$selected,
                       -background=>'white')->pack(-side =>'top');

my $nb = $mw->NoteBook( -font => "Arial 24",
                        -inactivebackground => "grey",
                        -tabpadx => 5,
                        -tabpady => 5,
                        )->pack( -expand => 1, -fill => 'both' );

### add  tabs to notebook  
foreach my $file (@files){
  my $title = $file;
  $page{$file}{'tab'} = $nb->add( $file,
                        -label => $title,
                        -raisecmd =>[\&load_frame,$file],

  $page{$file}{'pane'} =  $page{$file}{'tab'}->Scrolled('Pane',
                            -scrollbars=>'osoe', sticky=>'nwse')
                        ->pack(-expand => 1 , -fill => 'both');

  $page{$file}{'loaded'} = 0;


sub load_frame{
   my $file = shift;
   if($page{$file}{'loaded'} == 1){return}; #only load icons once 

  open my $fh, "ICONS/$file" or die $!;
  my %icons;

    while (<$fh>) {
      my ($n, $d) = (split /:/)[0, 4];
      $icons{$n} = $mw->Photo(-data => $d);
    close $fh;

    my $f = $page{$file}{'pane'};

    my $r = my $c = 0;
    my %labels;

    for my $n (sort keys %icons) {
        $labels{$file}{$n} = $page{$file}{'pane'}->Label(
                        -image  => $icons{$n},
                        )->grid(-column => $c,
                                -row    => $r,

          sub {$labels{$file}{$n}->configure( -bg => 'white');
               $selected = $n;
          sub {$labels{$file}{$n}->configure( -bg => 'lightgrey');
              $selected = $n;

             sub { &copaste($file,$n) }

      if ($c == 20) {
        $c = 0;

$page{$file}{'loaded'} = 1;


sub copaste {
    my($file,$name) = @_;
    my $data;

    open my $fh, "ICONS/$file" or die $!;
    while (<$fh>) {
      my ($n, $d) = (split /:/)[0, 4];
      next unless $n eq $name;
      $data = "\'".$d."\'";
    close $fh;

my $string = "my \$$name = \$mw->Photo(-data => $data);";

my $top = $mw->Toplevel(-title => 'Cut-&-Paste');

my $text = $top->Text( -bg=>'white');

  -text => 'Exit',
  -command => sub{$top->destroy},


Replies are listed 'Best First'.
Re: zicons-Tk-Icon-Selector
by NateTut (Deacon) on Nov 03, 2004 at 23:49 UTC
    What a cool tool. Thanks! Ever think about a version that works with .ico files instead? You could then generate the tabs from subdirectory names... It's a thought. Doug
      Sounds neat, but I don't use windows except to check for cross-platform compatibility. Why don't you give it a shot?

      I'm not really a human, but I play one on earth. flash japh
        I might just do that after I clear off a couple of projects that are on my agenda.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://397432]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (6)
As of 2021-01-24 01:04 GMT
Find Nodes?
    Voting Booth?