Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl use warnings; use strict; use Tk; use Tk::NoteBook; use Tk::Pane; use Tk::DialogBox; my $mw = new MainWindow; $mw->geometry("600x350"); 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=> +20); my $selected = 'No Selection'; $topframe1->Label( -width => 30, -textvariable => \$selected, -background=>'white')->pack(-side =>'top'); my $nb = $mw->NoteBook( -font => "Arial 24", -background=>'lightgreen', -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; } MainLoop; 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>) { chomp; 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, ); $labels{$file}{$n}->bind("<Enter>", sub {$labels{$file}{$n}->configure( -bg => 'white'); $selected = $n; }); $labels{$file}{$n}->bind("<Leave>", sub {$labels{$file}{$n}->configure( -bg => 'lightgrey'); $selected = $n; }); $labels{$file}{$n}->bind('<1>', sub { &copaste($file,$n) } ); $c++; if ($c == 20) { $r++; $c = 0; } } $page{$file}{'loaded'} = 1; } sub copaste { my($file,$name) = @_; my $data; open my $fh, "ICONS/$file" or die $!; while (<$fh>) { chomp; my ($n, $d) = (split /:/)[0, 4]; next unless $n eq $name; $data = "\'".$d."\'"; last; } close $fh; my $string = "my \$$name = \$mw->Photo(-data => $data);"; my $top = $mw->Toplevel(-title => 'Cut-&-Paste'); my $text = $top->Text( -bg=>'white'); $text->insert('end',$string); $text->pack; $top->Button( -text => 'Exit', -command => sub{$top->destroy}, )->pack; $top->transient($mw); }

In reply to zicons-Tk-Icon-Selector by zentara

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others pondering the Monastery: (5)
    As of 2020-10-20 00:51 GMT
    Find Nodes?
      Voting Booth?
      My favourite web site is:

      Results (208 votes). Check out past polls.